%option "-nons-low"
%include "inc:util.imp"
%include "iff:iffinc.imp"
%constinteger hgt = 256, wid = 256, ibyte=0, area=65536
%conststring (1) quotes=""""

%include "ie:terminal.inc"

%begin

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

%byte red
%integer loop
%integer assem,fradd
%integer first,last,frame,free,operation
%integer firstlo, firsthi, freak,address

@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 menu(%integername key)

  clear screen
  %if frame >0 %then %start
    printstring("Current frame: ") ; write(frame,4) ; newline
  %finish
  newlines(10)
  printline("1) Set frame.")
  newline
  printline("2) Transfer live frame.")
  newline
  printline("3) Transfer frozen frame.")
  newline
  printline("4) Save frame(s).")
  newline
  printline("5) Hands-on Seescan board.  (CTRL-C does escape)")
  newline
  printline("6) Quit.")

  %cycle
    %cycle
      key=testsymbol
    %repeat %until key#-1
  %repeat %until (key > '0') %and (key <'7')

%end {of menu}

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

%routine get free frames

  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?}
    
%end { Of free frames }

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

%routine set frame
%string(1) char
  char="S"
  %if (frame > free) %then %start
    printline("No more free memory.  Return to menu or set a frame?")
    prompt("Menu/Set:")
    read(char)
    prompt(":")
    to upper(char)
  %finish
  %if char = "S" %then %start
    %if (frame<=free) %and (frame # -1) %then %start
      printstring("Last frame :")
      write(frame,4)
    newline
    %finish
    printstring("Enter a frame number from 1 to ")
    write(free,4)
    read(frame)
  %finish

%end {Of set frame }

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

%routine transfer
  %on 0 %start
    printline(" Board failure")
    %return
  %finish

  %if frame>free %then %start
    printline("No more free ram.  Use Set frame or Save options")
    pause(500)
  %finish %else %start
    %if frame=-1 %then %start
      printline("Use set frame first to define a frame.")
    %finish %else %start

      fradd = (frame-1)*area+first
      firsthi=fradd>>24
      firstlo=(fradd&16_00ff0000)>>16
      freak=firstlo<<8!firsthi
       
      assem = 16_01ff0000 ! freak
      { set start bit and add frame address }
  
      clear screen
      printstring("Frame ") ; write(frame,4)
      printstring(": Capturing at address $")
      phex2(firsthi); phex2(firstlo) ; printstring("XXXX")
      newline
  
      %if live = 1 %then putline("FREEZE")
      pause(1)

      putline("GOTO 165")

      control = assem
  
      %if live = 1 %then putline("LIVE")

      newline
  
      %if status&16_01 = 1 %then %start 
        printline("Error in transfer.")
        printsymbol(7)
      %finish %else %start
        printline("Transfer successful.")
        frame=frame+1
        printstring("Next frame:")
        write(frame,4) ; newline
      %finish
    %finish
  %finish

%end { Of transfer }

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

%routine save frames 
%string(1) over
%integer numframes,start frame,bytes,i
%string(255) filename,fname, title

over="Y"
  
  printline("Save frame(s).    IFF files are saved.")
  newlines(3)
  printstring("Latest frame: ") ; write(frame-1,4) ; newlines(2)

  printstring("Save how many frames? ")
  read (numframes)
  newline

  printstring("Start frame number? ")
  read(start frame)
  newline

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

  printline("Enter filename (MAX 7 CHARACTERS).")
  read (filename)

  fname=filename.itos(startframe,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
    %for loop=start frame,1,startframe+numframes-1 %cycle
        
      file = filename.itos(loop,0).".iff"
      printline("Writing ".file)

      iffhdr = 0
      rc = iff open file(file, iffhdr, iff write)
   
      iffhdr_ht    = hgt
      iffhdr_wid   = wid
      iffhdr_id    = 002436 ;!Serial no. of Seescan camera
      iffhdr_fstop = 140    ;!f/1.4
      iffhdr_focus = 16     ;!16mm
      iffhdr_title = "Seescan image - ".title
      iffhdr_aspect= 16_0403;!rectangular pixels x=4 y=3

      rc=iff write header(iffhdr)

      address = first+65536*(loop-1)
      selectoutput(1)
      %for bytes = 0,1,65535 %cycle
        printsymbol(peek(address+bytes))
      %repeat

!     iff write image(iffhdr,address)
! Doesn't work.  Not enough parameters or something.

      closeoutput
      selectoutput(0)

      iff close file(iffhdr)

    %repeat
  %finish
%end

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

%routine quit
%string(255) quityesno

  clear screen
  newlines(5)
  printline("                                Q    U    I    T    ")
  printsymbol(7)
  newlines(5)
  printstring("                     Are you sure you want to quit? (Y/N) ")
  read(quityesno)
  to upper(quityesno)
  ! control=2
  %if quityesno="Y" %then %stop
%end

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

terminal model = default terminal
set terminal characteristics
set terminal mode(nopage)
insert off

send escape

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

frame = -1
get free frames

clear screen

live = 0    { Set to zero to do a transfer of currently stored picture }
            { Set to one to go "live" before and after transfer.       }

%cycle

  menu(operation)
  clear screen
  %if operation='1' %then set frame
  %if operation='2' %then live=1 %and transfer
  %if operation='3' %then live=0 %and transfer
  %if operation='4' %then save frames
  %if operation='5' %then hands on
  %if operation='6' %then quit

%repeat

%endofprogram