!****************************************************************
!*                                                              *
!*      GALLERY:    Program displays JHB-modded IFF files       *
!*                  as a sequence.  Taken from DISP             *
!*                                                              *
!*                  Version 1.4    1 May 1987                   *
!*                                                              *
!****************************************************************

%external%routine%spec   CLEAR FRAME %alias "vtcframe"
%include "inc:util.imp"
{%include "src:util.imp"} {FS-D}
%include "iffinc.imp"
{%include "demo:iff:iffinc.imp} {FS-D}

%begin
%include "level1:graphinc.imp"

%routine iff doc(%string (255) infile)
   %integer c,xl,xr,yb,yt,x,y,i,nls
   %string (255) s
   %on 3,9 %start
      close input
      %return
   %finish

   %routine nextword(%string (*) %name s, %integername flag)
      %integer c
      !Read the next word and flag a few end conditions..
      !Flag=-1: EOF.  '@': Box coordinates follow  0: Normal  1: Blank line

      %on 3,9 %start; Flag=-1; %return; %finish
      s=""; flag=0
      %cycle
         readsymbol(c)
         flag=c %and %return %if c='@'
         s=s.tostring(c) %if c>32
         %if c<=13 %and nextsymbol<=13 %then readsymbol(c) %and Flag=1
      %repeatuntil c<=32
   %end

   %routine close box
      yb = y - 16; yb=0 %if yb<0
      hline(xl,xr,yt); hline(xl,xr,yb)
      vline(xr,yb,yt); vline(xl,yb,yt)
   %end

   xl=-1
   %if exists(infile) %start
      openinput(1, infile); selectinput(1); selectoutput(0)
      %if nextsymbol='@' %start
         !Characters are 12 pixels high * 8 wide approx
         xl=-1
         %cycle
            nextword(s, nls)
   
            %if nls='@' %start
               close box %if xl>=0
               read(xl); read(xr); read(yt); read(c)
               colour(c)
               skipsymbol %while nextsymbol<=' '
               x=xl+4; y=yt-16
            %finish
   
            %if s#"" %start
               %if x+8*length(s)>=xr %then x=xl+4 %and y=y-12
               textat(x, y)
               showstring(s)
               x=x+8*length(s)
               %if x+8<xr %start; textat(x,y); showsymbol(' '); x=x+8; %finish
            %finish
            %if nls=1 %then x=xl+4 %and y=y-24
            %exit %if nls<0
         %repeat
         close box
      %else ;!Print it on the green screen
         clear frame
         %cycle; readsymbol(c); printsymbol(c); %repeat
      %finish
   %finish
%end

%owninteger tim = 0

%routine pause till(%integer secs)
   %integer t
   %while cputime < tim+secs*1000 %cycle
      %if cputime & 1023 = 0 %start
         t=cputime; printsymbol('.'); %cycle; %repeatuntil t#cputime
      %finish
   %repeat
   newline
%end

!----- Start of bit taken from DISP ----- cut here -----------------------------

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

!v1.10 allows non-square zooming

%constinteger maxwins=5
%integerarray xbase, ybase, xsize, ysize(0:maxwins-1)
%string (255) param, infile, docfile
%integer imageno

%routine Set Up
  Offset (0,0)
  enable(16_FF)
  Colour (White)
  Set Terminal Mode (Nopage)
%end

%routine shrink(%record (iffhdr fm) %name iffh, %c
   %bytearrayname a(0:*), %integer xfactor, yfactor, xoff, yoff)
   %begin
      %integer i, j, xl, yl, xn, yn, ix
      %bytearray b(0:iffh_wid*iffh_ht-1)
      xn = iffh_wid//xfactor; yn = iffh_ht//yfactor  
      xl = xn*xfactor; yl=yn*yfactor
      %if xl>0 %and yl>0 %start
         ix=0
         %for i=0, yfactor, yl-yfactor %cycle
            %for j=0, xfactor, xl-xfactor %cycle
               b(ix) = a(i*iffh_wid+j); ix=ix+1
            %repeat
         %repeat
      %finish

      col fill(xoff,yoff, xoff+xn-1, yoff+yn-1, b(0))
   %end
%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:xfactor*yfactor*iffh_ht*iffh_wid-1)
!!
!!      fac = xfactor * iffh_wid
!!      facfac = fac * yfactor
!!      iw=0; ifw=facfac
!!      %for i=iffh_ht-1, -1, 0 %cycle
!!         ix = ifw
!!         %for j=yfactor-1, -1, 0 %cycle
!!            %for k=iffh_wid-1,-1,0 %cycle
!!               ix=ix-xfactor
!!               %for l=xfactor-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*xfactor-1, yoff+iffh_ht*yfactor-1, b(0))
!!   %end


    %integer i, j, k, l, ix, ifw, iw, fac, facfac
 
    %begin
       %label l1, l2, l3, l4, l5, 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  yfactor,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 - xfactor
    *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(%record (iffhdr fm) iffhdr, %integer a,low,high, seq)
   %string (255) s1, s2, factor
   %integer xo, yo, c, xfactor, yfactor, i, j, xoff, yoff, base
   %integer max xfactor, maxyfactor, xshrink, yshrink
   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>=0 %then xshrink=0 %else xfactor=-xfactor %and xshrink=1
      %if yfactor>=0 %then yshrink=0 %else yfactor=-yfactor %and yshrink=1
      %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
         printstring("Image "); write(i, 2)
         printstring(": Zoom factor = "); write(max xfactor, -1)
         %if max yfactor#max xfactor %then printstring("/".itos(max yfactor,-1))
         newline
         %if xshrink=0 %and yshrink=0 %start
            xoff=xbase(i)+(xsize(i)-iffhdr_wid*max xfactor)>>1
            yoff=ybase(i)+(ysize(i)-iffhdr_ht*max yfactor)>>1
            zoom(iffhdr, array(a+base), max xfactor, max yfactor, xoff, yoff)
         %elseif xshrink#0 %and yshrink#0
            xoff=xbase(i)+(xsize(i)-iffhdr_wid//xfactor)>>1
            yoff=ybase(i)+(ysize(i)-iffhdr_ht//yfactor)>>1
            shrink(iffhdr, array(a+base), xfactor, yfactor, xoff, yoff)
         %finish
         base=base+iffhdr_wid*iffhdr_ht
      %repeat
      %finish
      %while testsymbol>=0 %cycle; %repeat
   %else
      %exit
   %finish
%repeat
%end

%predicate graphics present
   %on 0 %start
      %false
   %finish
   plot(0,0)
   %true
%end

%routine iff disp(%string (255) infile, docfile, %integer imageno)

%integer base, images, a
%integer i,j,c,rc,xoff,yoff,ht,wid
%ownrecord (iffhdr fm) iffhdr
%half %array CM (0:255)

%constinteger w=688, h=512, h2=h//2, w2=w//2, w3=w//3
!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 

printline("Graphics system inaccessible") %and %return %unless graphics present
rc = iff open file(infile, iffhdr, iff read)
printline("Not a valid IFF file -".iff error(rc)) %and %return %if rc#0

iffhdr_mapaddr = addr(cm(0))
rc = iff read header(iffhdr)
ht = iffhdr_ht; wid=iffhdr_wid
%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 *ht*wid)
   %if imageno=0 %start ;!He wanted the lot
      %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 + wid * ht
      %repeat
   %else
      images=1
      %cycle
         rc = iff read image(iffhdr, a)
         imageno=imageno-1
      %repeatuntil imageno=0
   %finish
%finishelse printline("Invalid IFF header")
iff close file(iffhdr) ;!finished with file

%return %if rc#0

base=0
%for i=0, 1, images-1 %cycle
   iff flip(iffhdr, a+base); base=base+wid * 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
{}pause till(20)

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 wid > xsize(i) %or 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 wid<=w %and ht<=h %start
         !If it's displayable set limits = screen to preserve centring
         xsize(i)=w; ysize(i)=h
      %elseif wid<=1024 %and ht<=1024
         !If it's less than the full framestore plot at bottom LH
         xsize(i)=wid; ysize(i)=ht
      %else
         !hope for the best
         xsize(i)=1024; ysize(i)=1024
      %finish
   %repeat
%finish

%for i=0, 1, images-1 %cycle
   xoff=xbase(i)+(xsize(i)-wid)>>1; yoff=ybase(i)+(ysize(i)-ht)>>1

   printstring("Image"); write(i, 2); printstring(" at [")
   write(xoff, 3); printsymbol(','); write(yoff, 3)
   printstring("] in "); write(xsize(i), 3); printstring(" * "); write(ysize(i), 3)
   printstring(" window at [")
   write(xbase(i), 3); printsymbol(','); write(ybase(i), 3); printsymbol(']')
   newline

   col fill(xoff, yoff, xoff+wid-1, yoff+ht-1, byteinteger(a+base))
   iff doc(docfile) ;!************ MOD for GALLERY **********
{} tim = cputime
!!   %if j#0 %start
!!      moveit(iffhdr,a,i,i,j)
!!      clear
!!      newline
!!   %finish
   base=base + wid*ht
%repeat

!!moveit(iffhdr,a,0,images-1,j) %if j=0
heapput(a)
%end

!----- end of bit taken from DISP ----- cut here -------------------------
!Note one-line mod about 15 lines up plus "!!" and "{}" lines

%integer rc
%on 3, 9 %start; ->end; %finish
set terminal mode(8)
param=cli param; param = "gallery.seq" %if param=""
openinput(3, param)
%cycle
   selectinput(3); readline(infile)
   docfile=infile.".txt" %unless infile -> infile.(" ").docfile

!! %cycle; rc=testsymbol; %exit %if rc='*' %or rc=-1; %repeat
!! %exit %if rc='*'

   iff disp(infile, docfile, 0)
%repeat

end:
selectoutput(0); printline("End of sequence")
%endofprogram