!****************************************************************
!*                                                              *
!*      IFFDISP:    Program displays JHB-modded IFF files       *
!*                                                              *
!*                  Version 1.5   19 Jan 1987                   *
!*                                                              *
!****************************************************************

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

!Takes a run-length encoded IFF' file, expands it, rearranges it and displays it.
!Expects correct header length (words not bytes)

!J. Butler Dec 86

%begin
%include "level1:graphinc.imp"
%integer xo, yo, factor, max factor {!}, base, images, wwd, wht, wxo, wyo
%string (255) param,infile,outfile
%bytearray a(0:688*688-1)
%owninteger i,j,c
%ownrecord (iffhdr fm) iffhdr
%half %array CM (0:255)
%integer XOff,YOff,x,y,rc

%constinteger w=688, h=512, h2=h//2, w2=w//2, w3=w//3, maxwins=5
!Entries are origin and window size
%constintegerarray 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,w,h2,    0,h2 , w, h2,    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 move(%integer bytes, %bytename from, to)
   !Move BYTES bytes from FROM to TO. Pinched from IE.
   !If addr(FROM) < addr(TO) do the move from the top down to allow overlap
   %return %if Bytes = 0 %or  From == To

   %if Addr (To) < Addr (From) %start
      *Subq.l #1, d0
   f loop:
      *move.b (a0)+, (a1)+
      *dbra   d0, f loop
   %else
      *add.l  d0, a0
      *add.l  d0, a1
      *subq.l #1, d0
   b loop:
      *move.b -(a0), -(a1)
      *dbra   d0, b loop
   %finish
%end
   
%routine imp zoom(%record (iffhdr fm) %name iffh, %c
%bytearrayname a(0:*), %integer factor, 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
%end

%routine zoom(%record (iffhdr fm) %name iffh, %c
 %bytearrayname a(0:*), %integer factor, xoff, yoff)
    %integer i, j, k, l, ix, ifw, iw, fac, facfac
 
    %begin
       %label l1, l2, l3, l4, l5, l6, l7
       %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
! 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  factor,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  factor,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+factor)

    *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*factor-1, yoff+iffh_ht*factor-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
%return
   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
    *subq.l  #1,d2         ;!so dbra does it right
    *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

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

   %for i=0, 1, images-1 %cycle
      rc = iff read image(iffhdr, addr(a(base)))
      printline("Invalid IFF image") %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, addr(a(base))); base=base+iffhdr_wid * iffhdr_ht
%repeat

!t!->nnnnn
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

base=0
offset(0,0)
XOff = 0; YOff = 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)
   printstring("Image"); write(i, 2); printstring(" at [")
   write(xbase(i), 3); printsymbol(','); write(ybase(i), 3); printsymbol(']')
   %if iffhdr_wid <= xsize(i) %and iffhdr_ht <= ysize(i) %start
      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, a(base))
   %else
      printstring(" too big for window")
   %finish
   base=base + iffhdr_wid*iffhdr_ht
   newline
%repeat
nnnnn:
printline("Hit cursor keys to pan image, <home> to zoom, <return> to exit")

xo=0; yo=0
%cycle
!t!c=72; -> mmmmm
   offset(xo, yo)
mmmmm:
   %cycle; c=testsymbol; %repeatuntil c=27 %or c=10
   %exit %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:"); read(factor)

      %if factor<1 %then clear %elsestart
      base=0
      %for i=0, 1, images-1 %cycle
         c = xsize(i)//iffhdr_wid; j = ysize(i)//iffhdr_ht
         %if c<j %then max factor=c %else max factor=j
         %if factor<=max factor %then max factor = factor
         xoff=xbase(i)+(xsize(i)-iffhdr_wid*max factor)>>1
         yoff=ybase(i)+(ysize(i)-iffhdr_ht*max factor)>>1
         printstring("Image "); write(i, 2)
         printstring(": Zoom factor = "); write(max factor, -1); newline
         zoom(iffhdr, array(addr(a(base))), max factor, xoff, yoff)
         base=base+iffhdr_wid*iffhdr_ht
      %repeat
      %finish
      %while testsymbol>=0 %cycle; %repeat
   %else
      %exit
   %finish
%repeat
%endofprogram

