%option "-nons-low"
%include "level1:graphinc.imp"
%include "inc:util.imp"
%include "iff:iffinc.imp"
  %externalrealfnspec log(%real s)
%constinteger hgt = 256, wid = 256, ibyte=0, area=65536
%constinteger frozen=0, live = 1, display = 2
%conststring (1) quotes=""""

%include "ie:terminal.inc"

%begin

%string(255) file
%integer rc,i,j,k,ds
%byte %array image, stretch(0:65535)
%constant %integer boardaddr = 16_7FFC0    ;! Change as appropriate
%recordformat DEVICE FM(%byte bstatus,data,intvec,dstatus,x,mode,y,command)
@boardaddr %record(device fm) device
%record (iffhdr fm) iffhdr

!FIRST - address of first frame buffer
!LAST  - address of last one
!FREE  - frame number of last frame
%integer first,last,free,operation

@16_00f80000 %integer control
@16_00f80000 %byte status

@16_00003ffc %integer end of ram

!-------------------------------------------------------------------------------

%on %event 3 %start
  %if event_sub=3 %then %start
    closeoutput
    selectoutput(0)
    printline("No more filespace.  Quitting.")
    %stop
  %finish
  closeoutput
  selectoutput(0)
  printstring("Event 3,")
  write(sub,2)
  printline(" ".event_message)
  %stop
%finish

!-------------------------------------------------------------------------------

%routine set baud(%integer code)
  %constinteger mode1=16_4e,mode2=16_30,comm=16_37,reset=8

  %on 0 %start
     Printline("**Bus error.") %unless event_sub=1
     %stop
  %Finish

  device_bstatus = reset; device_bstatus = 0
  device_mode = mode1;    device_mode = mode2+code
  device_dstatus = 0;     device_dstatus = 0
  device_dstatus = 0;     device_command = comm
%end

!-------------------------------------------------------------------------------

%routine put(%Integer sym)
   %While device_dstatus&1=0 %cycle; %repeat
   device_data =sym
%End

!-------------------------------------------------------------------------------

%routine putstring(%string (255) s)
   %integer i
   %return %if s=""
   %for i=1,1,length(s) %cycle; put(charno(s,i)); %repeat
%end

!-------------------------------------------------------------------------------

%routine pause(%integer msec)
   msec = msec + cputime
   %cycle; %repeatuntil cputime>=msec
%end

!-------------------------------------------------------------------------------

%routine putline(%string (255) s)
    putstring(s)
    put(13)
    pause(length(s) * 10)
%end

!-------------------------------------------------------------------------------

%routine put program

  printline("Writing program to Seescan board...")
  putline("10 LOPAGE = 0130H : HIPAGE = 012DH")
  putline("20 FOR PASS = 1 TO 2")
  putline("30 ORG 3000H")
  putline("40 CODESTART = $")
  putline("50 LD BC , 8000H")
  putline("60 LD HL , 8000H")
  putline("70 LD DE , 8000H")
  putline("80 CALL LOPAGE")
  putline("90 LDIR")
  putline("100 CALL HIPAGE")
  putline("110 LD HL , 8000H")
  putline("120 LD DE , 8000H")
  putline("130 LD BC , 8000H")
  putline("140 LDIR")
  putline("150 RET")
  putline("160 NEXT PASS")
  putline("162 END")
  putline("165 PLOT 255,255, POINT(255,255)")
  putline("168 FOR T = 1 TO 2")
  putline("170 G CODESTART")
  putline("180 NEXT T")

%end {of put program }

!-------------------------------------------------------------------------------

%routine send escape

%integer c1,msec

  set baud (13)

  !Grab the Seescan board
  !Poll until transmitting a <return> provokes a '>' prompt.

  c1=0
  %cycle
     put(13)
     put(3)  { send cr and ctrl-c }
     msec = cputime + 2000
     %cycle
        %if device_dstatus&2 # 0 %start
           c1 = device_data & 16_7F
        %finish
     %repeatuntil cputime>=msec %or c1 = '>'
     %if c1 # '>' %then printline("Polling for Seescan board")
  %repeatuntil c1 = '>'

%end {of send escape}

!-------------------------------------------------------------------------------

%routine hands on
   %integer c1,ptr,ctrl
   %bytearray buffer(0:63)
   !Transparent terminal.  Note APM switches cr and lf so we switch them back
   !rather than having to fiddle with EXEMPT MASK.  
   !Output to Seescan is buffered.  Output to VDU is not.

   printline("In Hands-on mode - ctrl-Z to exit")
   put(13)

   ptr= 0
   %cycle
      ctrl = device_dstatus
      %if ctrl&2 # 0 %start
         c1 = device_data    { Read from Seescan board }
         printsymbol(c1)
      %finish
      %if ctrl&1 # 0 %and ptr#0 %start
         ptr=ptr-1; device_data=buffer(ptr) { Write to Seescan board }
      %finish

      c1=testsymbol
      %if c1>=0 %start
         %exit %if c1=16_1A ;!Ctrl-Z
         %if c1=13 %or c1=10 %then c1=23-c1 %elsestart
            %if 'a'<=c1<='z' %then c1=c1-'a'+'A'
         %finish
         buffer(ptr)=c1; ptr=ptr+1
      %finish
   %repeat
 clear screen
%end

!-------------------------------------------------------------------------------

%routine home cursor
  cursor(0,0)
%end

!-------------------------------------------------------------------------------

%bytefunction peek(%integer address)
  %return byte(address)
%end

!-------------------------------------------------------------------------------

%routine menu1(%integername key)

  clear screen
  printline("1) Smooth map")
  printline("2) rough map")
  printline("3) reduce grey levels");                            newline
  printline("0) default map")

  %cycle
     key=testsymbol
  %repeatuntil '0'<=key<='3'
%end


%routine menu(%integername key)

  clear screen
  printline("1) Set frame.");                                    newline
  printline("2) Transfer frame.");                               newline
  printline("3) Show frame");                                    newline
  printline("4) Save frame(s).");                                newline
  printline("5) Hands-on Seescan board.  (CTRL-C to escape)");   newline
  printline("6) Print to CLAN laser printer");                   newline
  printline("7) Edit images");                                   newline
  printline("8) Analyse image");                                 newline
  printline("9) Difference");                                    newline
  printline("0) Change map");                                    newline
  printline("Ctrl-Y to quit")

  %cycle
      key=testsymbol
  %repeat %until '0'<=key<='9'

%end {of menu}

!-------------------------------------------------------------------------------

%routine get free frames
  !FIRST, LAST, FREE - significant globals
  first=heapget(1)           { Find address of first free byte }
  %if first&16_0000ffff #0 %then first=first+16_00010000
  first=first&16_ffff0000    { Make it a multiple of 64K }

  last=end of ram-100000     {room for last 64K frame and imp stack}
  last=last&16_ffff0000

  free=(last-first)>>16      {Room for how many frames?}
  printline("RAM problem") %and %stop %if free=0
    
%end { Of free frames }

!-------------------------------------------------------------------------------

%routine set frames(%integername frlo, frhi)
  printline("Bounds 0 to ".itos(free-1,-1))
  %cycle
     prompt("first:"); read(frlo)
     prompt("last:"); read(frhi)

     %if frhi<frlo %start
       printline("Bounds inside-out"); frlo=-1
     %elseif (frlo>=free %or frhi >= free)
       printline("Not enough memory")
       frlo=-1
     %finish
  %repeatuntil frlo>=0

%end {Of set frames}

!-------------------------------------------------------------------------------

%routine clanprint(%integer lo, hi)
%constinteger boardaddr2 = 16_7FFC8 ;!Channel 2
@boardaddr2 %record(device fm) device2

%integer scaleX, scaleY
%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) = %c
                                         16*dithfont(row*4+col)+random(r*4+c)
        %repeat
      %repeat
    %repeat
  %repeat
%end


%routine putc(%Integer sym)
   %While device2_dstatus&1=0 %cycle; %repeat
   device2_data =sym
%End

%routine puts(%string (255) s)
   %integer i
   %return %if s=""
   %for i=1,1,length(s) %cycle; putc(charno(s,i)); %repeat
%end

%routine puti(%integer n)
   %if n>=10 %then puti(n//10)
   putc(rem(n,10)+'0')
%end

%routine send header(%integer x,y)
  puts("$g1"); putc(10)
  puts("X("); puti(x); puts(""")"); putc(10)
  puts("Y("); puti(y); puts(""")"); putc(10)
  puts("B(")
  puti(256*scaleX); putc(','); puti(256*scaleY)
  putc(')'); putc(10)
%end

%routine send trailer
   putc(10); ! end of last line 
   puts("$e*"); putc(10)
%end

  %routine dot line(%integer dp, %bytearrayname bufp)
      %integer d1p, d count, b count, bptr, dot pattern,bufsize
      bufsize = 256 * 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
           putc(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
         putc(dotpattern+'0')
      %finish
      putc(10)
%end

%routine set up chan 2
  %constinteger mode1=16_4e,mode2=16_30,comm=16_37,reset=8

  %on 0 %start
     Printline("**Bus error.") %unless event_sub=1
     %stop
  %Finish

  device2_bstatus = reset; device2_bstatus = 0
  device2_mode = mode1;    device2_mode = mode2+13 ;!9600
  device2_dstatus = 0;     device2_dstatus = 0
  device2_dstatus = 0;     device2_command = comm
%end

%routine getbuf(%integer ad, %bytearrayname buf)
   %integer i,j,p
   p=scaleX*256-1
   %for i=0, 1, 255 %cycle
      %for j=0, 1, scaleX-1 %cycle
         buf(p) = 255-byteinteger(ad+i); p=p-1
      %repeat
   %repeat
%end

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

%if lo=hi %then ad=lo %else prompt("Frame:") %and read(ad)
printstring("printing frame ".itos(ad,-1)." from 16_")
ad = first+ad*256*256
phex(ad); newline
make dith
set up chan 2
prompt("X_Scale:"); read(scaleX)
prompt("Y_Scale:"); read(scaleY)
scaleX=1 %if scaleX<1; scaleY=1 %if scaleY<1
scaleX=8 %if scaleX>8; scaleY=6 %if scaleY>6
send header(3,5)
  d count=0; dp=0
  %for j=0,1,255 %cycle
    getbuf(ad, buf); ad=ad+256
    %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

%end

%routine flip(%integer fradd)
   !Reflect image about a central horizontal axis.
   %integer from,to
   from=fradd+256 ;to=fradd+256*256
%label l1,l2
    *move.l  #256,d3     ;!d3 = wid
    *move.l  #127,d2     ;!d2 = ht>>1-1
    *MOVEA.L to,a2
L1:
    *move.l  #255,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 show(%integer loframe,hiframe)
   %constinteger xl=8,xr=28,yb=8,yt=20
   %integer fradd
   %if loframe=hiframe %start
      fradd = first+loframe*area
      offset(0,0)
      colour(128)
      fill(0,0,687,511)
      col fill(216,{ds+}128,216+255,{ds+}128+255,byteinteger(fradd))
      colour(yellow)
      hline(xl,xr,yb);vline(xr,yb,yt);hline(xr,xl,yt);vline(xl,yt,yb)
      textat(xl+2,yb+2); show i(loframe,-1)
   %finish
%end

%routine transfer(%integer {ctrl,} loframe, hiframe)
  !Uses globals FREE
  %integer freak,frame, firstlsb, firstmsb,fradd, i

%routine fill(%integer bytes, %name from, %byte filler)
   !Fill BYTES bytes from FROM with FILLER
   %return %if bytes = 0
   *subq.l #1, d0
f loop:
   *move.b d1, (a0)+
   *dbra   d0, f loop
%end

%integerfn do transfer(%integer fradd)
   %integer assem
   %predicate suspect
      %integer i,ad
      ad = fradd
      %for i=0,1,65535 %cycle
         %false %if byteinteger(ad)#128; ad=ad+1
      %repeat
      %true
   %end

      assem = 16_01ff0000 ! freak
      {%if ctrl & live # 0 %then} putline("FREEZE")
      pause(100)

      putline("GOTO 165")
      control = assem
      pause(100)

      {%if ctrl&live # 0 %then} putline("LIVE")

      flip(fradd)
      %if status&16_01 = 1 %then %start 
        printline(" failed")
        !unrecoverable
      %elseif suspect
        printstring("."); %result=1 ;! "OK" but nothing written. retry
      %else
        printline(" OK")
        show(frame,frame){ %if ctrl&display # 0}
      %finish
      %result=0
%end {of do transfer}

  %on 0 %start
     printstring(" board failure ")
     newline     
     %return
  %finish

  %if hiframe>=free %then %start
    printline("No more free ram.  Use Set frame or Save options")
    pause(500)
  %else
    %if loframe=-1 %then %start
      printline("No frame numbers supplied - 0 assumed.")
      loframe=0; hiframe=0
    %finish

    clear screen
    %for frame=loframe, 1, hiframe %cycle
      fradd = frame*area+first
      firstmsb=(fradd>>24)& 16_FF
      firstlsb=(fradd&16_00ff0000)>>16
      freak=firstlsb<<8!firstmsb
     
      { set start bit and add frame address }

      fill(65536, byteinteger(fradd), 128)
      printstring("Transfer ") ; write(frame,4)
      printstring(": to address 16_")
      phex2(firstmsb); phex2(firstlsb) ; printstring("XXXX")

      i=0
      %cycle; i=i+1; %repeatuntil do transfer(fradd)=0 %or i=6
    %repeat
  %finish

%end { Of transfer }

!-------------------------------------------------------------------------------

%routine save frames 
%string(1) over
%integer frame,frlo,frhi,i,address
%string(255) filename,fname, title

over="Y"
  
  printline("Save frame(s) to IFF file(s)")
  newlines(3)

  prompt("first:");  read (frlo)
  prompt("last:"); read(frhi)

  prompt("Image(s) title? ")
  read (title)
  newline

  prompt("File rootname (MAX 7 CHARACTERS).")
  read (filename)

  %for frame=frlo,1,frhi %cycle
  fname=filename.itos(frame,0).".iff"
  %if exists(fname) %then %start
    printline("File ".fname." exists.  Overwrite? (Y/N)")
    read(over)
    to upper(over)
  %finish
  %if over="Y" %then %start
      file = filename.itos(frame,0)
      printline("Writing ".file)

      iffhdr_id    = 002436 ;!Serial no. of Seescan camera
      iffhdr_fstop = 140    ;!f/1.4
      iffhdr_focus = 16     ;!16mm
      iffhdr_aspect= 16_0403;!rectangular pixels x=4 y=3
      iffhdr_title = "Seescan image - ".title

      address = first+65536*frame
      flip(address)
      rc=iff writeout(file, iffhdr, address)
      printline(iff error(rc)) %if rc#0
      flip(address)

  %finish
  %repeat
%end

!==============================================================================
!IFF:DISP stuff
%constinteger maxwins=5
%integerarray xbase, ybase, xsize, ysize(0:maxwins-1)
%string (255) param, infile, outfile
%integer imageno

%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,wid,ht,zx,zy
%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 ")
      zx=1; zy=1
      %cycle
         colour(area col);   fill(menul+40, 432, menul+92, 447)
         colour(text col);   textat(menul+40, 432)
         show string(itos(zx, -1)."/".itos(zy,-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
            zx = (4*zy)//3
         %elseif mb=mouse middle
            zx=zx+1; zy=zy+1
         %elseif mb=mouse right
            zx=zx-1 %if zx>1; zy=zy-1 %if zy>1
         %elseif mb=7
            %return
         %finish
      %repeat
      textat(menul, 400); showstring("Zooming")
      zoom(tempiffh, tempa, zx, zy, 0, 0)

    %elseif mb=mouse right
       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
         %for x=x0, 1, x1 %cycle
            printsymbol(byteinteger(q)); q=q+1
         %repeat
       %repeat
       selectoutput(0)
       iff close file(iffout)

    %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 disp(%string (255) outfile, %integer a,imageno)
!modified

%integer base, images
%integer i,j,c,rc,xoff,yoff,ht,wid

%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 

images=1
wid=256; ht=256

j=0; base=imageno*ht*wid
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))
   %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
%end

!==============================================================================
%routine analyse(%integer lo,hi)

%constinteger panelsize=24
%routine display map
   %integer i,j,c,x,y,textcol
   textcol = 255

   clear

   %for x=0,1,15 %cycle
     %for y=0,1,15 %cycle
         i=x*32
         j=y*32+4
         colour (x*16+y)
         fill(i,j,i+panelsize,j+panelsize)
         colour(255-(x*16+y)); textat(i+2, j+2); shex2(x*16+y)
         colour (textcol)
         hline (i,i+panelsize,j)
         hline (i,i+panelsize,j+panelsize)
         vline (i,j,j+panelsize)
         vline (i+panelsize,j,j+panelsize)
     %repeat
   %repeat

   %for y=0,1,255 %cycle
     colour(y)
     fill(608,y*2,683,y*2+2)
   %repeat

   colour(textcol)
   %for y=0,1,15 %cycle
     hline(684,687,y*32)
   %repeat
   vline(687,0,511)
%end
%integerarray tot(0:255)

%routine countfile(%integer from)
   %integer q,p
   %for p=0,1,255 %cycle; tot(p)=0; %repeat
   %for q=from,1,from+256*256-1 %cycle
      tot(byteinteger(q)) = tot(byteinteger(q))+1
   %repeat
%end

%integer max,i,k,textcol

  textcol=255
  %if lo=hi %then i=lo %else prompt("Frame no:") %and read(i)
  countfile(first+i*256*256)
   %if graphics present %start
      display map
      colour(textcol)
      !Grey level histogram.  Bars for values 0 and 255 may be 512
      !pixels long, rest may be 64.
!      !Scale the values so we actually see something
!      %for i=0,1,255 %cycle
!         %if tot(i)#0 %then tot(i) = int(log(tot(i))*1024)
!      %repeat
      max=-1
      max=tot(0)//8 %if tot(0)//8>max
      %for i=1,1,254 %cycle; max=tot(i) %if tot(i)>max; %repeat
      max=tot(255)//8 %if tot(255)//8>max

      %for i=0,1,255 %cycle
         k=604-(tot(i)*64//max)
         fill(k,i*2, 604, i*2+1)
      %repeat

   %finish
%end

%routine edit(%integer lo,hi)
   printline("No graphics") %and %return %unless graphics present
   %if lo=hi %then i=lo %else prompt("Frame no") %and read(i)
   iff disp("junk", first, i)
%end

%routine difference
   %integer i,b,fr1,fr2,fr3
   %bytearrayname fra,frb,frc(0:*)
   %cycle
      prompt("First:"); read(fr 1)
      prompt("Second:"); read(fr 2)
      prompt("destination:"); read(fr 3)
   %repeatuntil 0<=fr1<free %and 0<=fr2<free %and 0<=fr3<free

   write(fr3,-1); printstring(" = ")
   write(fr2,-1); printstring(" - ")
   write(fr1,-1); newline
   fra == array( first + fr1*area )
   frb == array( first + fr2*area )
   frc == array( first + fr3*area )
   %for i=0,1,area-1 %cycle
      b=frb(i)-fra(i)
      %if -8<=b<8 %then frc(i)=0 %else frc(i)=frb(i)      
   %repeat
  
%end

%routine set greys(%integer n)
   %integer i,j,w,step,max
   %halfarray cm(0:255)
   !No colour map - construct grey scale
   step=1; max=32
   n=32 %if n>32
   n=2 %if n<2
   step = max//n; max=step*n
   w=0
   %for i=0,step,max-step %cycle
      %for j=1,1,256//n %cycle; CM(w) = (i<<5 + i)<<5 + i; w=w+1; %repeat
   %repeat
   update colour map(cm(0))
   printline("Using grey map")
%end

%routine set smooth map
%halfarray cm(0:255)

%routine Mix Colour (%byte Col, %integer Red, Green, Blue)
   red=31 %if red>31; green=31 %if green>31; blue=31 %if blue>31
   cm(Col)=Red+Green<<5+Blue<<10
%end

%routine makemap
   %integer r, g, b, c
   r=0; g=0; b=19; c=1
   %routine build(%integer ct, dr, dg, db)
      %integer i
      %for i=0,1,ct-1 %cycle
         mix colour(c, r, g, b); c=c+1
         r=r+dr; g=g+dg; b=b+db
      %repeat
   %end

   mix colour(0,0,0,19)
   build(19,0,1,0);     build(19,0,0,-1)
   build(19,1,0,0);     build(19,0,-1,0)
   build(19,0,0,1);     build(19,-1,0,0)
   build(13,1,1,1);     build(19,0,1,0)
   build(19,0,0,-1);     build(19,1,0,0)
   build(19,0,-1,0);     build(19,0,0,1)
   build(19,-1,0,0);     build(13,-1,-1,-1)
   mix colour(255,0,0,19)
%end

make map
update colour map(cm(0))
printline("using colour map")
%end

%integer maptog

%routine set rough map
   %halfarray cm(0:255)
   %integer i,j,k
   %routine Mix Colour (%integer Col, Red, Green, Blue)
      CM(Col)=Red+Green<<5+Blue<<10
   %end
   %for i = 1,1,7 %cycle
      k = 32*i
      Mix Colour (k+j, (i&1)*j, (i&2)>>1*j, (i&4)>>2*j) %for j = 0,1,31
   %repeat
   mix colour (9,6,5,11)
   update colour map(cm(0))
%end

%routine change map
   %integer mapop,greys
   menu1(mapop)
   %if mapop='1' %then set smooth map
   %if mapop='2' %then set rough map
   %if mapop='0' %then set greys(32)
   %if mapop='3' %start
      prompt("Grey levels:"); read(greys)
      set greys(greys)
   %finish
%end

!-------------------------------------------------------------------------------
!Main program
%integer lo,hi
!LO    - currently selected lower frame number
!HI    - currently selected upper frame number

iffhdr = 0
iffhdr_ht    = hgt
iffhdr_wid   = wid

terminal model = default terminal
set terminal characteristics
set terminal mode(nopage)
insert off
offset(0,512); clear
offset(0,0); clear
colour(white)
maptog=0
set greys(32)

send escape

put program
putline("RUN")  ;! Assemble the program ready to call the m/c

ds=512; offset(0,0); lo=0; hi=0
get free frames

clear screen

%cycle

  menu(operation)
  clear screen
  %if operation='1' %then set frames(lo,hi)
  %if operation='2' %start
    clear; transfer(lo,hi)
  %finish
  %if operation='3' %then show(lo,hi)
  %if operation='4' %then save frames
  %if operation='5' %then hands on
  %if operation='6' %then clanprint(lo,hi)
  %if operation='7' %then edit(lo,hi)
  %if operation='8' %then analyse(lo,hi)
  %if operation='9' %then difference
  %if operation='0' %then change map 

%repeat

%endofprogram
