!****************************************************************
!*                                                              *
!*      IFFDISP:    Program displays JHB-modded IFF files       *
!*                                                              *
!*                  Version 1.17  30 Nov 1987                   *
!*                                                              *
!****************************************************************

%include "inc:util.imp"
{%include "src:util.imp"} {FS-D}
%include "iff:iffinc.imp"
{%include "demo:iff:iffinc.imp} {FS-D}

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

!v1.10 allows non-square zooming
!v1.17 displays 16-bit and real images but not 32-bit integers

!! mouse functions("","Box","Keybd")
!! mouse functions("Restart", "Corner", "Restart")
!! mouse functions("Restart", "Write", "Zoom")
!! mouse functions("Restart", "+ Zoom *", "- Zoom *")
%begin
%include "level1:graphinc.imp"

%constinteger maxwins=5
%integerarray xbase, ybase, iwid, iht, xsize, ysize(0:maxwins-1)
%string (255) param, infile, outfile
%integer xsam, ysam, imageno, max

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

%routine getfile(%string (255) %name file, %string (255) ext)
   !Hook
   prompt("file:"); readline(file) %until file#""
%end

%routine clanprint(%record (iffhdr fm) %name iffhdr, %integer a,
%integer x0,y0,x1,y1, %string (255) file)
%integer scaleX, scaleY, wid, ht
%constinteger MAXD=16
%constinteger MAXDSQR=256
%bytearray dither(0:MAXDSQR-1)
%constintegerarray random(0:15) = %c
   0, 8, 2,10,  12, 4,14, 6,   3,11, 1, 9,  15, 7,13, 5

! designed to clump dots
%constintegerarray dithfont(0:15) = %c
   0, 1, 4, 9,   2, 3, 5,10,   6, 7, 8,11,  12,13,14,15

! DITHER MATRIX PRODUCTION
%routine make dith;             ! writen for clarity rather than speed 
  %integer r,c,row,col
  %for r=0,1,3 %cycle;    %for c=0,1,3 %cycle
  %for row=0,1,3 %cycle;  %for col=0,1,3 %cycle
     dither(4*(c+r*MAXD)+col+row*MAXD) = 16*dithfont(row*4+col)+random(r*4+c)
  %repeat;  %repeat
  %repeat;  %repeat
%end


%routine send header(%integer x,y)
  printline("$g1")
  printline("X(".itos(x,-1).""")")
  printline("Y(".itos(y,-1).""")")
  printline("B(".itos(wid*scaleX,-1).",".itos(ht*scaleY,-1).")")
%end

%routine send trailer
   newline; ! end of last line 
   printline("$e*")
%end

  %routine dot line(%integer dp, %bytearrayname bufp)
      %integer d1p, d count, b count, bptr, dot pattern,bufsize
      bufsize = wid * scaleX
      d1p=dp; d count=0
      dot pattern=0; bcount=0
      %for bptr=0,1,bufsize-1 %cycle
        dot pattern=dot pattern<<1
        dot pattern = dot pattern ! 1 %if bufp(bptr) >{=} dither(dp) & 16_FF
        
        %if dcount<MAXD-1 %then dp=dp+1 %and dcount=dcount+1 %else %c
        d count=0 %and dp=d1p 
        bcount=bcount+1
        %if bcount=6 %start
           printsymbol(dotpattern+'0'); bcount=0; dot pattern=0
        %finish
      %repeat
      %if bcount#0 %start
         bcount=bcount+1 %and dot pattern = dot pattern<<1 %while b count#6
         printsymbol(dotpattern+'0')
      %finish
      newline
%end

%routine getbuf(%integer ad, %bytearrayname buf)
   %integer i,j,p
   p=scaleX*wid-1
   %for i=0, 1, wid-1 %cycle
      %for j=0, 1, scaleX-1 %cycle
         buf(p) = 255-byteinteger(ad+i); p=p-1
         !The "255-" inverts for white-paper printing
      %repeat
   %repeat
%end

%integer ad,d count,dp,j,s
%bytearray buf(0:2047)

ad = a + y0 * iffhdr_wid + x0
wid=x1-x0+1; ht=y1-y0+1
make dith
prompt("X_Scale:"); read(scaleX)
prompt("Y_Scale:"); read(scaleY)
scaleX=1 %if scaleX<1; scaleY=1 %if scaleY<1
scaleX=2048//wid %if scaleX>2048//wid; scaleY=2048//ht %if scaleY>2048//ht
open output(2, file); selectoutput(2)
send header(0,0)
d count=0; dp=0

%for j=y0,1,y1 %cycle
  getbuf(ad, buf); ad=ad+iffhdr_wid
  %for s=0,1,scaleY-1 %cycle
    dot line(dp,buf)
    %if d count<MAXD-1 %then d count=d count+1 %and dp=dp+MAXD %else %c
    d count=0 %and dp=0
  %repeat
%repeat

send trailer
close output

%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

%constinteger iff op stream = 1
%routine select region(%record (iffhdr fm) %name iffhdr, %integer xoff,yoff,aa)

%integer i,j,k,p,x0,y0,x1,y1,x2,y2,q,x,y,ox,oy,z,mb,tx,ty,rc,rcx,rcy,wid,ht
%record (iffhdr fm) iffout, tempiffh
%bytearrayname a(0:*)
%bytearray tempa(0:256*256)

%routine swap(%integername a, b)
   %integer t
   t=a; a=b; b=t
%end

%routine dohline(%integer xb, xt, y)
   %integer i,j,m,n
   %bytearray b(0:wid-1)
   xb=xoff %if xb<xoff; y=yoff %if y<yoff
   xt=tx   %if xt>tx;   y=ty   %if y>ty
   swap(xb, xt) %if xt<xb
!!   colour(line col)
!!   hline(xb, xt, y)
   m = xb-xoff + (y-yoff)*wid
   n = m+xt-xb
   j = 0

   %for i=m, 1, n %cycle
      b(j)=255-a(i); j=j+1
   %repeat
   col fill(xb, y, xt, y, b(0))
%end

%routine dovline(%integer x, yb, yt)
   %integer i,j,m,n
   %bytearray b(0:ht-1)
   x=xoff %if x<xoff; yb=yoff %if yb<yoff
   x=tx   %if x>tx;   yt=ty   %if yt>ty
   swap(yb, yt) %if yt<yb
!!   colour(line col)
!!   vline(x, yb, yt)
   m = x-xoff + (yb-yoff)*wid
   n = x-xoff + (yt-yoff)*wid
   j = 0

!t!write(m, 3); write(n, 3); newline
   %for i=m, wid, n %cycle
      b(j)=255-a(i); j=j+1
   %repeat
   col fill(x, yb, x, yt, b(0))
%end

%routine drawbox(%integer x0,y0,x1,y1)
   dohline(x0,x1,y0)
   dovline(x0,y0,y1)
   dohline(x0,x1,y1)
   dovline(x1,y0,y1)
%end

%routine unhline(%integer xb, xt, y)
   %integer m
   xb=xoff %if xb<xoff; y=yoff %if y<yoff
   xt=tx   %if xt>tx;   y=ty   %if y>ty
   swap(xb, xt) %if xt<xb
   m = xb-xoff + (y-yoff)*wid
   col fill(xb, y, xt, y, a(m))
%end

%routine unvline(%integer x, yb, yt)
   %integer i,j,m,n
   %bytearray b(0:ht-1)
   x=xoff %if x<xoff; yb=yoff %if yb<yoff
   x=tx   %if x>tx;   yt=ty   %if yt>ty
   swap(yb, yt) %if yt<yb
   m = x-xoff + (yb-yoff)*wid
   n = x-xoff + (yt-yoff)*wid
   j = 0

   %for i=m, wid, n %cycle
      b(j)=a(i); j=j+1
   %repeat
   col fill(x, yb, x, yt, b(0))
%end

%routine undrawbox(%integer x0,y0,x1,y1)
   unhline(x0,x1,y0)
   unvline(x0,y0,y1)
   unhline(x0,x1,y1)
   unvline(x1,y0,y1)
%end

%constinteger area col=0, text col=123, line col=237
%constinteger menul=580, menub=400

%routine mouse functions(%string(10) left,middle,right)

 colour(area col)
 fill(menul,menub-3,686,511)
 colour(line col)
 hline(menul-3,671, 511); hline(menul-3,671, menub-3)
 vline(menul-3,menub-1,511); vline(671, menub-1, 511)
 colour(text col)
 textat(menul,496);  showstring("L+M+R: Quit")
 textat(menul,480);  showstring("L: ".left)
 textat(menul,464);  showstring("M: ".middle)
 textat(menul,448);  showstring("R: ".right)
 textat(menul,432);  showstring("X:")
 textat(menul,416);  showstring("Y:")
 textat(menul,400);  showstring("Z:")

%end

%integer oldx, oldy, oldz

%routine monitor
  %integer m
  m = x1-xoff + (y1-yoff)*wid
  %if x1#oldx %start
   colour(area col);   fill(menul+24, 432, menul+64, 447)
   colour(text col);   textat(menul+24, 432); show i(x1-xoff, 3)
  %finish
  %if y1#oldy %start
   colour(area col);   fill(menul+24, 416, menul+64, 431)
   colour(text col);   textat(menul+24, 416); show i(y1-yoff, 3)
  %finish
  %if a(m)#oldz %start
   colour(area col);   fill(menul+24, 400, menul+64, 415)
   colour(text col);   textat(menul+24, 400); show i(a(m), 3)
  %finish
  oldx=x1; oldy=y1; oldz=a(m)
%end


%routine get x1 y1
    x=mouse x;    y=mouse y
    x1=x-ox+xoff; y1=y-oy+yoff

    !Normalise x,y to be within bounds and relative to bottom LH of screen
    %if x1<xoff %start
      x1=xoff
      ox=x
    %else %if x1>tx
      x1=tx
      ox=x-wid
      %if ox<-2048 %then ox=ox+4096
    %finish

    %if y1<yoff %start
      y1=yoff
      oy=y
    %else %if y1>ty
      y1=ty
      oy=y-ht
      %if oy<-2048 %then oy=oy+4096
    %finish

    !Now xoff<=x1<=tx and yoff<=y1<=ty
%end

wid=iffhdr_wid; ht=iffhdr_ht
a == array(aa)
tx = xoff+wid-1; ty = yoff + ht-1
try again:
clear
col fill(xoff, yoff, tx, ty,a(0))
 %cycle; %repeatuntil mouse buttons=0
 oldx=-1; oldy=-1; oldz=-1

 mouse functions("","Box","Keybd")

 x2=xoff;      y2=yoff
 ox=mouse x;   oy=mouse y

 %cycle ;! ----- Loop, displaying [X,Y,Z] coords till user presses button -----
    Get x1 y1
    !Write new cursor
    dohline(x1-5,x1+5,y1)
    dovline(x1  ,y1-5,y1+5)

    %if x2#x1 %or y2#y1 %start
       !Delete old cursor
       unhline(x2-5,x2+5,y2)
       unvline(x2  ,y2-5,y2+5)
       x2=x1;    y2=y1
    %finish

    monitor
    mb = mouse buttons

 %repeatuntil mb#0
 !----- User has hit a button -----

 !----- all 3 = quit
 %return %if mb=7

 !----- Middle = "anchor corner and generate a box" -----
 %if mb=mouse middle %start
    ! delete cursor
    unhline(x2-5,x2+5,y2)
    unvline(x2  ,y2-5,y2+5)

    !Wait for him to get his fingers off the buttons
    %cycle; %repeatuntil mouse buttons=0

    mouse functions("Restart", "Corner", "Restart")

    x0=x1;   y0=y1
    x2=x0;   y2=y0

    %cycle ;!----- Now loop with a rubber-banded box till user hits a button -----
       Get x1 y1
!!       x=mouse x;       y=mouse y
!!       x1=x-ox+xoff;    y1=y-oy+yoff
!!
!!       %if x1<xoff %start
!!         x1=xoff
!!         ox=x
!!       %else %if x1>tx
!!         x1=tx
!!         ox=x-wid
!!         %if ox<-2048 %then ox=ox+4096
!!       %finish
!!
!!       %if y1<yoff %start
!!         y1=yoff
!!         oy=y
!!       %else %if y1>ty
!!         y1=ty
!!         oy=y-ht
!!         %if oy<-2048 %then oy=oy+4096
!!       %finish

       drawbox(x0,y0,x1,y1)
 
       %if x2#x1 %or y2#y1 %start
          undrawbox(x0,y0,x2,y2)
          x2=x1; y2=y1
       %finish
       monitor
       mb = mouse buttons

    %repeatuntil mb#0 %and x0#x1 %and y0#y1
    undrawbox(x0,y0,x1,y1) %and -> try again %if mb=mouse right %or mb=mouse left
    %return %if mb=7

 %elseif mb=mouse right ;!Get coords from the keyboard
    q=0
    %cycle
       prompt("Xl:"); read(x0); x0=x0+xoff
       prompt("yl:"); read(y0); y0=y0+yoff
       prompt("Xr:"); read(x1); x1=x1+xoff
       prompt("Yt:"); read(y1); y1=y1+yoff
       undrawbox(x,y,x2,y2) %if q#0
       x=x0; y=y0; x2=x1; y2=y1
       drawbox(x0, y0, x1, y1)
       prompt("OK?")
       %cycle; readsymbol(q); q=q&16_5F; %repeatuntil q='Y' %or q='N'
    %repeatuntil q='Y'
 %finish

 %cycle; %repeatuntil mouse buttons=0
 undrawbox(x0,y0,x2,y2)

 x0=x0-xoff; x1=x1-xoff; y0=y0-yoff; y1=y1-yoff
 swap(y0, y1) %if y0>y1; swap(x0, x1) %if x0>x1
 printstring("Coords (pixels) are: [")
 write(x0,-1); printsymbol(','); write(y0,-1)
 printstring("] [")
 write(x1,-1); printsymbol(','); write(y1,-1)
 printstring("]"); newline

 %cycle
    %cycle; %repeatuntil mousebuttons=0
    mouse functions("Restart", "Zoom", "Write")
    %cycle; mb=mouse buttons; %repeatuntil mb#0

    %if mb=7 %start
      %return

    %elseif mb=mouse middle
      tempiffh = 0
      tempiffh_ht = y1-y0+1; tempiffh_wid = x1-x0+1
      tempiffh_ht=256 %if tempiffh_ht>256; tempiffh_wid=256 %if tempiffh_wid>256
      k=0
      %for i=0,1,tempiffh_ht-1 %cycle
         p=(y0+i)*iffhdr_wid+x0
         %for j=0,1,tempiffh_wid-1 %cycle
            tempa(k) = a(p); k=k+1; p=p+1
         %repeat
      %repeat
!!    prompt("Zoom factor:"); read(rc)
      mouse functions("Display","+ Zoom *","- Zoom *")
      colour(area col);  fill(menul, 400, menul+64, 447)
      colour(text col);  textat(menul,432);  showstring("Zoom *")
      rcx=1; rcy=1
      %cycle
         colour(area col);   fill(menul+48, 432, menul+80, 447)
         colour(text col);   textat(menul+48, 432); show i(rcx, 1)
         show i(rcy, 1)
         %cycle; mb=mouse buttons; %repeatuntil mb=0
         %cycle; mb=mouse buttons; %repeatuntil mb#0
         %if mb=mouse left %start
            %exit
         %elseif mb=mouse middle ! mouse right %and rcx=3
            rcx=4; rcy=3
         %elseif mb=mouse middle
            rcx=rcx+1; rcy=rcy+1
         %elseif mb=mouse right
            rcx=rcx-1 %if rcx>1; rcy=rcy-1 %if rcy>1
         %elseif mb=7
            %return
         %finish
      %repeat
      textat(menul, 400); showstring("Zooming")
      zoom(tempiffh, tempa, rcx, rcy, 0, 0)

    %elseif mb=mouse right
       %cycle; %repeatuntil mousebuttons=0
       mouse functions("Restart", "IFF", "Lay 2.0")
       %cycle; mb=mousebuttons; %repeatuntil mb#0
       %if mb=mouse left %start
          %return

       %elseif mb=mouse middle
          getfile(outfile,"iff") %if outfile=""
          rc = iff open file(outfile, iffout, iff write)
          iffout_ht = y1-y0+1; iffout_wid=x1-x0+1
          iffout_mapaddr = iffhdr_mapaddr; iffout_maplen = iffhdr_maplen
          rc = iff write header(iffout)
          selectoutput(iffout_context_filptr)
          %for y=y0, 1, y1 %cycle
            q = aa + y*wid + x0
            %for x=x0, 1, x1 %cycle
               printsymbol(byteinteger(q)); q=q+1
            %repeat
          %repeat
          selectoutput(0)
          iff close file(iffout)

       %elseif mb=mouse right
          getfile(outfile,"dot") %if outfile=""
          clanprint(iffhdr, aa, x0,y0, x1,y1, outfile)
       %finish

    %elseif mb=mouse left
       %exit

    %finish
 %repeat
 -> try again
%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, mb
   %integer max xfactor, maxyfactor, xshrink, yshrink
   printline("Cursor keys pan image, <home> zooms, <return> exits, Mouse edits")

   xo=0; yo=0; xoff=0; yoff=0

   %cycle
      %cycle; %repeatuntil mouse buttons=0 %and testsymbol<0
      offset(xo, yo)
      %cycle;c=testsymbol;mb=mouse buttons;%repeatuntil c=27 %or c=10 %or mb#0
      %exit %if mb#0
      %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
      %finish
   %repeat

   %cycle; %repeatuntil mouse buttons=0
   select region(iffhdr,iffhdr_xoff,iffhdr_yoff, a)
%end

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

%routine iff real to 8(%record (iffhdr fm) %name iffh, %integer from, to)
  %integer i, p, q
  %real v, vmin, vmax, s
  %recordformat rf(%real r)
  %record (rf) %name r
  printline("Adjusting 32-bit real image for display: ")
  p=0; vmax=-100000000; vmin=100000000
  %for i=0, 1, iffh_ht*iffh_wid-1 %cycle
     r == record(from+p); p=p+4
     vmax=r_r %if r_r>vmax; vmin=r_r %if r_r<vmin
  %repeat

  v = vmax-vmin
  s = 256/v

  printstring("Min: "); print(vmin, 5,5)
  printstring(" Max:"); print(vmax, 5,5)
  printstring(" Range:"); print(v,5,5)
  printstring(" Scale by  "); print(s, 5,5)
  printstring(" Shift by "); print(vmin, 5,5)
  newline

  p=0; q=0
  %for i=0, 1, iffh_ht*iffh_wid-1 %cycle
     r == record(from+p); p=p+4
     byteinteger(to+q) = int((r_r-vmin)*s); q=q+1
  %repeat
%end

%routine iff 32 to 8(%record (iffhdr fm) %name iffh, %integer from, to)
  printline("Not yet implemented")
%end

%routine iff 16 to 8(%record (iffhdr fm) %name iffh, %integer from, to)
  %integer i, p, q, s, v, vmin, vmax, offset
  printline("Adjusting 16-bit image for display: ")
  p=0; vmax=0; vmin=65535
  %for i=0, 1, iffh_ht*iffh_wid-1 %cycle
     v = halfinteger(from+p); p=p+2
     vmax=v %if v>vmax; vmin=v %if v<vmin
  %repeat

  v = vmax-vmin
  s=0; p=1
  %while p<v %cycle; s=s+1; p=p<<1; %repeat
  s=s-8; s=0 %if s<0

  printstring("Min: ".itos(vmin, -1)." Max:".itos(vmax, -1))
  printstring(" Range:".itos(v,-1))
  %if s#0 %then printstring(" Scale by  ".itos(1<<s, -1))

  p=0; q=0
  %if s=0 %start ;!no range compression required
     %if vmax<256 %then offset=0 %else offset=vmax-255
     %for i=0, 1, iffh_ht*iffh_wid-1 %cycle
        byteinteger(to+q) = halfinteger(from+p)-offset; p=p+2; q=q+1
     %repeat
  %else
     offset=vmin
     %for i=0, 1, iffh_ht*iffh_wid-1 %cycle
        byteinteger(to+q) = (halfinteger(from+p)-offset)>>s; p=p+2; q=q+1
     %repeat
  %finish
  printstring(" Shift by ".itos(offset, -1))
  newline
%end

%routine iff 2 to 8(%record (iffhdr fm) %name iffh, %integer from, to)
   !Expand packed booleans to array of 0's and 255's
   %integer i, max, k, mask
   %label l1,l2,l5,l6
   printline("Adjusting boolean image for display")
   max = (iffh_ht * iffh_wid)>>3

!!   %for i=max-1, -1, 0 %cycle
!!      mask=128
!!      %for k=7,-1,0 %cycle
!!         %if byteinteger(from)&mask=0 %then byteinteger(to)=255 %else byteinteger(to)=0
!!         to=to+1; mask=mask>>1
!!      %repeat
!!      from=from+1
!!   %repeat

      *move.l  from,a0
      *move.l  to,A1
      *move.l  max,d3
      *subq.l  #1,max

l1:   *move.l  #128,d1
      *moveq   #7,d2

l2:   *move.b  0(a0),d0
      *and.l   d1,d0
      *bne     l6
      *move.b  #255,d0
      *bra     l5

l6:   *clr.b   d0

l5:   *move.b  d0,(a1)+
      *lsr.l   #1,d1
      *dbra   d2, l2
      *addq.l  #1,a0
      *dbra   d3, l1

%end

%routine iff sample(%record (iffhdr fm) %name iffh, %integer ad, xsam, ysam)
   %integer i, j, xmax, ymax, from, to
   xmax = iffh_wid//xsam; xmax=xmax+1 %if xmax*xsam # iffh_wid
   ymax = iffh_ht//ysam;  ymax=ymax+1 %if ymax*ysam # iffh_ht
   to = ad
   %for i=0, 1, ymax-1 %cycle
      from = ad+i*iffh_wid*ysam
      %for j=0, 1, xmax-1 %cycle
         byteinteger(to) = byteinteger(from); to=to+1; from=from+xsam
      %repeat
   %repeat
%end


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

%integer bbase, wbase, 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
!This array defines windows on the screen (across the table)
!for simultaneous display of 1.. 2.. etc. images (down the table)
%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)
%if rc=0 %start
   ht = iffhdr_ht; wid=iffhdr_wid
   max=ht*wid  ;!No of bytes in original expanded image
   max=max*2 %if iffhdr_datatype & 7 = 1 ;!16-bit words
   max=max*4 %if iffhdr_datatype & 7 = 4 %or iffhdr_datatype & 7 = 5 ;!32-bit
   max=max//8 %if iffhdr_datatype & 7 = 2 ;!Packed booleans
   iff show header(iffhdr, 0)

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

   a = heapget(images * max)
   %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 + max
      %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

%if iffhdr_datatype & 7 # 0 %start ;!Non-byte images.  Reformat to bytes.
   wbase=a
   %if iffhdr_datatype & 7 = 2 %start ;!Packed booleans
      !This EXPANDS the image so we can't do it in-place.
      bbase = heapget(images * iffhdr_wid * iffhdr_ht); base = bbase
   %else
      bbase=a
   %finish

   %for i=0, 1, images-1 %cycle
      %if iffhdr_datatype & 7 = 1 %start ;!16-bit image
         iff 16 to 8(iffhdr, wbase, bbase)
      %elseif iffhdr_datatype & 7 = 2 ;!Packed booleans
         iff 2 to 8(iffhdr, wbase, bbase)
      %elseif iffhdr_datatype & 7 = 4
         iff 32 to 8(iffhdr, wbase, bbase)
      %elseif iffhdr_datatype & 7 = 5
         iff real to 8(iffhdr, wbase, bbase)
      %finish
      wbase=wbase+max; bbase=bbase+iffhdr_wid*iffhdr_ht
   %repeat
   %if iffhdr_datatype & 7 = 2 %then heapput(a) %and a=base
   iffhdr_datatype = 0 ;!Bytes
%finish

base=a

%for i=0, 1, images-1 %cycle
   iff flip(iffhdr, base); base=base+iffhdr_ht*iffhdr_wid
%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

%elseif iffhdr_datatype & 7 = 2 ;!Booleans - use 0 (black) and 255 (white)
   cm(0) = 0; cm(255) = 16_7FFF
%finish

Update Colour Map (cm(0))
   
Clear

j=0
offset(0,0)
%for i=0, 1, images-1 %cycle
   wid=iffhdr_wid; ht=iffhdr_ht
   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)
   iwid(i)=wid; iht(i)=ht
   %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 ;!Can't put them all on the screen at once, so...
   printline("Images will be displayed sequentially")
   %for i=0, 1, images-1 %cycle
      xbase(i)=0; ybase(i)=0; wid=iffhdr_wid; ht=iffhdr_ht
      %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; iwid(i)=wid; iht(i)=ht

      %elseif wid<=1024 %and ht<=1024
         !If it's less than the full framestore plot at bottom LH
         !and let him pan round it.
         xsize(i)=wid; ysize(i)=ht; iwid(i)=wid; iht(i)=ht

      %else
         !Sample it down so it fits.
         xsam = (iffhdr_wid-1)//1024+1
         ysam = (iffhdr_ht-1)//1024+1
         printstring("Image larger than frame buffer.  Sampling ")
         write(xsam,-1); printstring(" * "); write(ysam, -1); newline
         iff sample(iffhdr, a, xsam, ysam)
         !Correct sizes.  Adjust for "fence-post" condition.
         iwid(i) = iffhdr_wid//xsam; iwid(i)=iwid(i)+1 %if iwid(i)*xsam # iffhdr_wid
         iht(i) = iffhdr_ht//ysam; iht(i)=iht(i)+1 %if iht(i)*ysam # iffhdr_ht
         %if iwid(i)<=688 %then xsize(i)=688 %else xsize(i)=iwid(i)
         %if iht(i)<=512 %then ysize(i)=512 %else ysize(i)=iht(i)
      %finish
   %repeat
%finish

base=a
%for i=0, 1, images-1 %cycle
   xoff=xbase(i)+(xsize(i)-iwid(i))>>1; yoff=ybase(i)+(ysize(i)-iht(i))>>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+iwid(i)-1, yoff+iht(i)-1, byteinteger(base))

   %if j#0 %start
      iffhdr_xoff = xoff; iffhdr_yoff=yoff
      moveit(iffhdr,a,i,i,j)
      clear
      newline
   %finish
   base=base + wid*ht
%repeat

%if j=0 %start
   iffhdr_xoff = xoff; iffhdr_yoff=yoff
   moveit(iffhdr,a,0,images-1,j)
%finish
heapput(a)
%end

param="" %and infile=cli param %unless cli param -> infile.("-").param
outfile="" %unless infile -> infile.("/").outfile
%if param="" %then imageno=0 %else imageno=stoi(param)
iff disp(infile, outfile, imageno)
%endofprogram