!****************************************************************
!*                                                              *
!*      UNKNDISP:   Program displays images of unknown size.    *
!*                                                              *
!*                  Version 1.1   24 Jun 1987                   *
!*                                                              *
!****************************************************************

%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"
%integer i,ad,len,wid,ht,c,a
%string (255) infile, outfile
%record (iffhdr fm) iffh

%routine Set Up
  Offset (0,0)
  enable(16_FF)
  Colour (White)
  Set Terminal Mode (Nopage)
%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

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

%routine invert
   %integer i, a
   a=ad
   %for i=0, 1, len-1 %cycle
      byteinteger(a)=255-byteinteger(a); a=a+1
   %repeat
%end

%routine flip
   !Reflect image about a central horizontal axis.
   %integer from,to
   from=ad+wid ;to=ad+ht*wid
%label l1,l2
    *move.l  wid,d3     ;!d3 = wid
    *move.l  ht,d2
    *LSR.L   #1,d2
    *SUBQ.L  #1,d2         ;!d2 = ht>>1-1
    *MOVEA.L to,a2
L1:
    *move.l  d3,d1
    *sub.l   #1,d1         ;!d1 = 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 wid times
    *ADD.L   d3,from
    *dbra    d2, l1
%end

%routine swap(%integer m, n)
   %integer i
   i=byteinteger(m); byteinteger(m)=byteinteger(n); byteinteger(n)=i
%end

%routine byteorder(%integer n)
   %integer i,j,k,x,a

   a=ad
   %if n&1=0 %then x=1 %else x=2
   %for i=0, 1, ht-1 %cycle
       a = ad+i*wid
       %for j=0, 1, wid//n-1 %cycle
          %for k=0, 1, n//2-x %cycle
             swap(a+k,a+n-k-1)
          %repeat
          a=a+n
       %repeat
   %repeat
%end

%routine overlay(%integer n)
   %integer i,j,k,a
   %bytearray t(0:255)

   a=ad
   %for i=0, 1, ht-1 %cycle
      a = ad+i*wid
      %for j=0, 1, wid//(n+n)-1 %cycle
         %for k=0, 1, n-1 %cycle
            t(k) = byteinteger(a+k+n)
         %repeat
         %for k=n-1, -1, 0 %cycle
            byteinteger(a+k+k) = byteinteger(a+k)
            byteinteger(a+k+k+1)=t(k)
         %repeat
         a=a+n+n
      %repeat
   %repeat
%end


%routine bitorder
   %integer i, a, a0,a1,a2,a3,a4,a5,a6,a7
   %bytearray map(0:255)
   %for i=0, 1, 255 %cycle
      a0=i&1; a1=(i&2)>>1; a2=(i&4)>>2; a3=(i&8)>>3
      a4=(i&16)>>4; a5=(i&32)>>5; a6=(i&64)>>6; a7=(i&128)>>7
      map(i)=((((((a0<<1+a1)<<1+a2)<<1+a3)<<1+a4)<<1+a5)<<1+a6)<<1+a7
   %repeat
   a=ad
   %for i=0, 1, len-1 %cycle
      byteinteger(a)=map(byteinteger(a)); a=a+1
   %repeat
%end

%routine draw(%integer wid)
   %integer xoff, yoff, a, i
   xoff=16; yoff=511-16
   a=ad
   clear
   %for i=0,1,ht-1 %cycle
      col fill(xoff, yoff, xoff+wid-1, yoff+1, byteinteger(a))
      a=a+wid
      yoff=yoff-1
   %repeat
   hline(0, wid+32, 511); hline(0, wid+32, 511-ht-32)
   vline(0, 511-ht-32, 511); vline(wid+32, 511-ht-32, 511)
%end

%routine shift(%integer n)
   ad=ad+n
%end

%routine move(%integer n)
   %integer a, i, j, k
   %for i=0, 1, ht-1 %cycle
      a=ad+i*wid
      %for j=0, 1, wid//(n+n)-1 %cycle
         %for k=0, 1, n-1 %cycle
            swap(a, a+n); a=a+1
         %repeat
         a=a+n
      %repeat
   %repeat
%end

%routine correlate(%integername wid)
  %realfn corr(%integer w, h)
     %integer h2, b1, b0, i, i1, i0, sum
     h2 = h>>1 ;!a line about the middle of the picture
     b0 = ad + h2 * w ;!the address of the first pixel
     b1 = b0 + w      ;!the address of the first pixel in the next line
     sum = 0
     %for i=0, 1, w-1 %cycle
        i1 = byteinteger(b1); i0 = byteinteger(b0)
        sum = sum + (i1-i0) * (i1-i0)
     %repeat
     %result = sum/w
  %end

  %integer c0, w, h, i
  %real val, min
  prompt("Start wid:"); read(c0)
  min = 2147483646
  c0=c0>>1
  %for i=0, 1, c0-7 %cycle
     w = c0+c0+i
     h = len//w
     val = corr(w, h); min=val %and wid=w %if val<min
write(w, 3); write(h, 3); print(val, 5, 2)
     w = c0+c0-i
     h = len//w
     val = corr(w, h); min=val %and wid=w %if val<min
spaces(8)
write(w, 3); write(h, 3); print(val, 5, 2)
newline
   %repeat
%end

%half %array CM (0:255)

printline("Graphics system inaccessible") %and %return %unless graphics present
ad=heapget(512000)

outfile="" %and infile=cli param %unless cli param -> infile.("/").outfile
connect file(infile, 0, ad, len)

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

Update Colour Map (cm(0))

wid=0
%cycle
   prompt("Wid:")
   skipsymbol %while nextsymbol=' '
   %exit %if nextsymbol<=13 %and wid#0
   %if nextsymbol='?' %then skipsymbol %and correlate(c) %else read(c)
   wid=c
   ht = len//wid
   ht=512 %if ht>512
   draw(wid)
%repeat

%cycle
   prompt("Cmd:")
   %cycle; readsymbol(a) ; %repeatuntil 'A'<=a<='z'
   a=a&16_5f
   %exit %if a='Q'
   invert %if a='I'
   bitorder %if a='B'
   %if a='O' %start
      read(c); byteorder(c)
   %finish
   flip %if a='F'
   %if a='M' %start
      read(c); move(c)
   %finish
   %if a='S' %start
      read(c); shift(c)
   %finish
   %if a='H' %start
      read(c); overlay(c)
   %finish
   draw(wid)
%repeat

%if outfile#"" %start
   iffh=0
   iffh_wid=wid; iffh_ht = ht
   i = iff writeout(outfile, iffh, ad)
%finish
%endofprogram