%option "-nons-low"
%include "level1:graphinc.imp"
%include "inc:util.imp"
%include "iff:iffinc.imp"
%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,operation
%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
%integer imagebuff


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

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

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

%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

%integerfn get
    %while device_dstatus&2=0 %cycle; %Repeat
    %Result = device_data&16_7F
%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 putline(%string (255) s)
    putstring(s)
    put(13)
%end

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

%routine send escape
  %constinteger b9600 = 13, b19200 = 14
  %integer c1,msec

  set baud (b9600)

  !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

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

%routine menu(%integername key)

  clear screen
  printline("1) Transfer frame.");                               newline
  printline("2) Save frame(s).");                                newline
  printline("3) Hands-on Seescan board.  (CTRL-C to escape)");   newline
  printline("Ctrl-Y to quit")

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

%end {of menu}

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

%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
   %constinteger xl=8,xr=28,yb=8,yt=20
   %integer fradd
   %return %unless graphics present
      fradd = imagebuff
      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)
%end

%integerfn gethex2
   %integer a,b
   a=get; b=get
   a=a-'0'; a=a-7 %if a>9
   b=b-'0'; b=b-7 %if b>9
   %result=a<<4+b
%end

%integerfn gethex4
   %result=gethex2<<8+gethex2
%end


%routine transfer
   %routine bomb(%integer fuse)
      printline("Bomb"); write(fuse, 2); %stop
   %end

   %integer c, p, csum
   putline("SAVE ""JUNK"" S")
   %cycle; %repeatuntil get=27 ;!Discard first line
   %cycle; %repeatuntil get=13
   p=0
   %while p<16_10000 %cycle
      c=get; bomb(1) %unless c=':'
      c=gethex2; bomb(2) %unless c=16_10
      c=gethex4; bomb(3) %unless c=p
      c=gethex2; bomb(4) %unless c=0
      csum=0
      %for i=0,1,15 %cycle
         byteinteger(imagebuff+p) = gethex2; p=p+1
         csum=csum+c
      %repeat
      csum=csum+gethex2
      bomb(5) %unless c&16_FF=0
      c=get
      printsymbol('.') %if p&16_3FF = 0
      c=get
      
   %repeat
   newline
%end

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

%routine save frame
%string(1) over
%string(255) filename,fname, title

over="Y"
  
  printline("Save frame to IFF file")
  newline

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

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

  fname=filename.".iff"
  %if exists(fname) %then %start
    printline("File ".fname." exists.  Overwrite? (Y/N)")
    read(over)
    to upper(over)
  %finish
  %if over="Y" %then %start
      printline("Writing ".filename)

      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

!     flip(imagebuff)
      rc=iff writeout(filename, iffhdr, imagebuff)
      printline(iff error(rc)) %if rc#0
!     flip(imagebuff)

  %finish
%end

%routine attempt to clear
   clear %if graphics present
%end

!==============================================================================
!Main program

iffhdr = 0
iffhdr_ht    = hgt
iffhdr_wid   = wid

terminal model = default terminal
set terminal characteristics
set terminal mode(nopage)
insert off
%if graphics present %start
   offset(0,512); clear
   offset(0,0); clear
   colour(white)
%finish

imagebuff = heapget(65536)
send escape

%if graphics present %start
   ds=512; offset(0,0)
%finish

clear screen

%cycle

  menu(operation)
  clear screen
  %if operation='1' %then attempt to clear %and transfer
  %if operation='2' %then save frame
  %if operation='3' %then hands on

%repeat

%endofprogram
