!****************************************************************
!*                                                              *
!*      IFFDISP:    Program displays JHB-modded IFF files       *
!*                                                              *
!*                  Version 1.10   3 Feb 1987                   *
!*                                                              *
!****************************************************************

%include "inc:util.imp"
%include "iffinc.imp"

!Takes a run-length encoded IFF' file, expands it, rearranges it and displays it.

!v1.10 allows non-square zooming

%begin
%include "level1:graphinc.imp"
%integer base, images, a
%string (255) param,infile,outfile
%integer i,j,c,rc,xoff,yoff
%ownrecord (iffhdr fm) iffhdr
%half %array CM (0:255)

%constinteger w=688, h=512, h2=h//2, w2=w//2, w3=w//3, maxwins=5
!Entries are origin and window size
%ownintegerarray win(0:4*maxwins*maxwins-1) = %c
0,0, w,h,     0,0,  0,0,     0,0,  0,0,     0,0,   0,0,     0,0,     0,0,
0,0, w2,h,    w2,0, w2,h,    0,0,  0,0,     0,0,   0,0,     0,0,     0,0,
0,0, w2,h2,   w2,0, w2,h2,   0,h2, w,h2,    0,0,   0,0,     0,0,     0,0,
0,0, w2,h2,   w2,0, w2,h2,   0,h2, w2,h2,   w2,h2, w2,h2,   0,0,     0,0,
0,0, w2,h2,   w2,0, w2,h2,   0,h2, w3,h2,   w3,h2, w3,h2,   2*w3,h2, w3,h2 
%integerarray xbase, ybase, xsize, ysize(0:maxwins-1)


%routine Set Up
  %on 0 %start
    Print String ("Software requires a graphics system")
    Newlines (2)
    %stop
  %finish
  Offset (0,0)
  enable(16_FF)
  Colour (White)
  Set Terminal Mode (Nopage)
%end

%routine zoom(%record (iffhdr fm) %name iffh, %c
 %bytearrayname a(0:*), %integer xfactor, yfactor, xoff, yoff)
!!   %integer i, j, k, l, ix, ifw, iw, fac, facfac
!!
!!   %begin
!!      %bytearray b(0:factor*factor*iffh_ht*iffh_wid-1)
!!
!!      fac = factor * iffh_wid
!!      facfac = fac * factor
!!      iw=0; ifw=facfac
!!      %for i=iffh_ht-1, -1, 0 %cycle
!!         ix = ifw
!!         %for j=factor-1, -1, 0 %cycle
!!            %for k=iffh_wid-1,-1,0 %cycle
!!               ix=ix-factor
!!               %for l=factor-1, -1, 0 %cycle
!!                  b(ix+l) = a(iw+k)
!!               %repeat
!!            %repeat
!!         %repeat
!!         iw=iw + iffh_wid; ifw=ifw+facfac
!!      %repeat
!!      col fill(xoff,yoff, xoff+iffh_wid*factor-1, yoff+iffh_ht*factor-1, b(0))
!!   %end

    %integer i, j, k, l, ix, ifw, iw, fac, facfac
 
    %begin
       %label l1, l2, l3, l4, l5, l6, l7
       %bytearray b(0:xfactor*yfactor*iffh_ht*iffh_wid-1)
       fac = xfactor * iffh_wid
       facfac = fac * yfactor
! Slightly bizarre code - took IMP -code and hacked grossest bits.
    *CLR.L   iw
    *MOVE.L  D0,ifw
    *MOVE.L  8(A0),i
L1:
    *MOVE.L  i,D0
    *BEQ     L2
    *SUBQ.L  #1,i
    *MOVE.L  ifw,d3
    *MOVE.L  xfactor,j
L3:
    *MOVE.L  j,D0
    *BEQ     L4
    *SUBQ.L  #1,j
    *MOVEA.L iffh,A0
    *MOVE.L  12(A0),d2   ;
    *subq.l  #1,d2       ;!d2 = k = iffhdr_wid-1
L5:
    *move.l  xfactor,d0
    *sub.l   d0,d3       ;!ix = ix - factor
    *MOVEA.L b,A1
    *adda.l  d3,a1
    *adda.l  d0,a1       ;!a1 points at b(ix+xfactor)

    *MOVEA.L a,A0
    *MOVE.L  iw,d1
    *ADD.L   d2,d1       ;!d2 = k
    *adda.l  d1,a0       ;!a0 points at a(iw+k)
L7:
    *MOVE.B  (A0),-(A1)  ;!copy across
    *dbra    d0, l7

    *dbra    d2, l5
    *Bra     l3
L4:
    *MOVEA.L iffh,A0
    *MOVE.L  12(A0),D1
    *ADD.L   D1,iw
    *MOVE.L  facfac,D2
    *ADD.L   D2,ifw
    *BRA     L1
L2:
  
       col fill(xoff,yoff, xoff+iffh_wid*xfactor-1, yoff+iffh_ht*yfactor-1, b(0))
    %end
%end

%routine iff flip(%record (iffhdr fm) %name iffhdr, %integer ad)
   !Reflect image about a central horizontal axis.
   %integer from,to
   from=ad+iffhdr_wid ;to=ad+iffhdr_ht*iffhdr_wid
%label l1,l2
    *MOVEA.L iffhdr,A0
    *move.l  12(a0),d3     ;!d3 = iffhdr_wid
    *move.l  8(a0),d2
    *LSR.L   #1,d2
    *SUBQ.L  #1,d2         ;!d2 = iffhdr_ht>>1-1
    *MOVEA.L to,a2
L1:
    *move.l  d3,d1
    *sub.l   #1,d1         ;!d1 = iffhdr_wid-1
    *MOVEA.L from,a1
l2:
    *move.b  -(a1),d0      ;!exchange bytes at pointers
    *move.b  -(a2),(a1)
    *move.b  d0,(a2)
    *dbra    d1, l2        ;!decrement counter (d1) and loop iffhdr_wid times
    *ADD.L   d3,from
    *dbra    d2, l1
%end

%routine moveit(%integer low,high, seq)
   %string (255) s1, s2, factor
   %integer xo, yo, c, xfactor, yfactor, i, j, xoff, yoff
   %integer max xfactor, maxyfactor
   printline("Hit cursor keys to pan image, <home> to zoom, <return> to exit")

   xo=0; yo=0; xoff=0; yoff=0
   %cycle
   offset(xo, yo)
   %cycle; c=testsymbol; %repeatuntil c=27 %or c=10
   %return %if c=10

   !V200 and Wyse use same cursor key ASCII values bar a '['
   %cycle
      %cycle; c=testsymbol; %repeatuntil c>0
   %repeatuntil c # '['

   %if c=67 %start
      xo=xo-16
   %elseif c=65
      yo=yo-1
   %elseif c=68
      xo=xo+16
   %elseif c=66
      yo=yo+1
   %elseif c=72 ;!Home
      prompt("Zoom factor(s):"); readline(factor)
      s1=factor %and s2=s1 %unless factor -> s1.("/").s2
      xfactor = stoi(s1); yfactor=stoi(s2)

      %if xfactor<1 %or yfactor<1 %then clear %elsestart
      base=0
      %for i=low, 1, high %cycle
         max xfactor = xsize(i)//iffhdr_wid; max yfactor = ysize(i)//iffhdr_ht
         %if xfactor<=max xfactor %then max xfactor = xfactor
         %if yfactor<=max yfactor %then max yfactor = yfactor
         xoff=xbase(i)+(xsize(i)-iffhdr_wid*max xfactor)>>1
         yoff=ybase(i)+(ysize(i)-iffhdr_ht*max yfactor)>>1
         printstring("Image "); write(i, 2)
         printstring(": Zoom factor = "); write(max xfactor, -1)
         %if max yfactor#max xfactor %then printstring("/".itos(max yfactor,-1))
         newline
         zoom(iffhdr, array(a+base), max xfactor, max yfactor, xoff, yoff)
         base=base+iffhdr_wid*iffhdr_ht
      %repeat
      %finish
      %while testsymbol>=0 %cycle; %repeat
   %else
      %exit
   %finish
%repeat
%end

rc = iff open file(cli param, iffhdr, iff read)
printline("Not a valid IFF file -".iff error(rc)) %and %stop %if rc#0

iffhdr_mapaddr = addr(cm(0))
rc = iff read header(iffhdr)
%if rc=0 %start
   iff show header(iffhdr, 0)

   base=0; images=1
   images=iffhdr_stereo+1 %if 0<=iffhdr_stereo<=maxwins-1

   a = heapget(images *iffhdr_ht*iffhdr_wid)
   %for i=0, 1, images-1 %cycle
      rc = iff read image(iffhdr, a+base)
      printline("Invalid IFF image".itos(rc,2)) %if rc#0
      base = base + iffhdr_wid * iffhdr_ht
   %repeat
%finishelse printline("Invalid IFF header")
iff close file(iffhdr) ;!finished with file

%stop %if rc#0

base=0
%for i=0, 1, images-1 %cycle
   iff flip(iffhdr, a+base); base=base+iffhdr_wid * iffhdr_ht
%repeat

Setup
%if iffhdr_maplen=0 %start
   !No colour map - construct grey scale
   %for i=0,1,255 %cycle; c = i>>3; CM(i) = (c<<5 + c)<<5 + c; %repeat
%finish

Update Colour Map (cm(0))
   
Clear

j=0; base=0
offset(0,0)
%for i=0, 1, images-1 %cycle
   xbase(i)=win(20*images+i*4-20);    ybase(i)=win(20*images+i*4+1-20)
   xsize(i)=win(20*images+i*4+2-20);  ysize(i)=win(20*images+i*4+3-20)
   %if iffhdr_wid > xsize(i) %or iffhdr_ht > ysize(i) %start
      printline("Image ".itos(i,-1)." too big for window.")
      j = 1
   %finish
%repeat

%if j#0 %start
   printline("Images will be displayed sequentially")
   %for i=0, 1, images-1 %cycle
      xbase(i)=0; ybase(i)=0
      %if iffhdr_wid<=w %and iffhdr_ht<=h %start
         !If it's displayable set limits = screen to preserve centring
         xsize(i)=w; ysize(i)=h
      %elseif iffhdr_wid<=1024 %and iffhdr_ht<=1024
         !If it's less than the full framestore plot at bottom LH
         xsize(i)=iffhdr_wid; ysize(i)=iffhdr_ht
      %else
         !hope for the best
         xsize(i)=1024; ysize(i)=1024
      %finish
   %repeat
%finish

%for i=0, 1, images-1 %cycle
   printstring("Image"); write(i, 2); printstring(" at [")
   write(xbase(i), 3); printsymbol(','); write(ybase(i), 3); printsymbol(']')
   newline
   xoff=xbase(i)+(xsize(i)-iffhdr_wid)>>1; yoff=ybase(i)+(ysize(i)-iffhdr_ht)>>1
   col fill(xoff, yoff, xoff+iffhdr_wid-1, yoff+iffhdr_ht-1, byteinteger(a+base))
   %if j#0 %start
      moveit(i,i,j)
      clear
      newline
   %finish
   base=base + iffhdr_wid*iffhdr_ht
%repeat

moveit(0, images-1,j) %if j=0
heapput(a)
%endofprogram