{**********************************************************************}
{*                          APMTEL Client                             *}
{*                  Andrew Ness  1988  CS4 project                    *}
{*               Modded version - see mod list below                  *}
{*                                                                    *}
{*                    Version 1.2 20 Jun 1988                         *}
{**********************************************************************}

! Control sub-module
!
!
!        USER INTERFACE TO THE APMTEL SERVER ON FILESTORE D
!
! History:
!
! 20/2/88      Initial naive unfriendly version written to test SERVER
! 22/2/88      Re-write and re-structure of the code for ease of maintainance
!  3/3/88      Inclusion of REGION untility to allow access to caching mechanism
!  3/3/88      Addition of cache structure access thru insert page to place a
!              file into a cache database 
!              So far this cache is write-only, but I am working on the code to
!              allow reading the cache
!  8/3/88      The cache is now read-write
! 10/5/88      Inclusion of Channel 5 - EUCSD pages
! 16/5/88      cache only indication if server is not running
! 17/5/88      Addition of design module 
! 17/5/88      Addition of termlib control for user interface
!

%include "APMTEL:ins_pg3.inc"
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%include "inc:util.imp"
%include "inc:vtlib.imp"
%conststring (255) database file = "db.dat"


%externalpredicatespec graphics present

%externalroutinespec load fonts
%externalroutinespec show screen(%integer p)
%externalroutinespec an clear
%externalroutinespec design

%begin

%constinteger  server station = 16_35, { Filestore D station number
               magic number = 16,      { The magic number of the APMTEL server
               my port= 21,            { The local port used
               buf size = 520,         { Maximum size of the ether packet
               true = 1,
               false = 0

%integer      server port,
              n,
              c,
              graphics flag,
              cache only
%byte         comm
%integer      pagestore,       {100 * bytearray    page(0:31,0:39) }
%integer      i,
              j, 
              command, param,
              channel
%string (255) filename

%constinteger title row=0, menu row=2, menu col=0, error row=15,
   comment row=17, prompt row=menu row+8, com row=20,divider col=39
!spaceline is <divider col> spaces and a bar.
%conststring (40) spaceline = "                                       |"

%routine line(%integer row)
   %if graphics flag=0 %start
     vt at(row,menu col)
     printstring(spaceline)
   %else
     clear line
   %finish
   vt at(row, menu col)
%end

%routine print at line(%integer row, %string (255) text)
  %string (255) thistext
  %while text -> thistext.(snl).text %cycle
     line(row); printstring(thistext)
     row=row+1
  %repeat
  line(row); printstring(text)
%end

%routine title line(%string (255) text)
  line(title row); printstring(text)
%end

%routine flag error(%string (255) text)
  print at line(error row, text)
%end

%routine flag comment 2(%string (255) text)
  print at line(comment row+1, text)
%end

%routine flag comment(%string (255) text)
  print at line(comment row, text)
%end

%routine show prompt(%string (255) text)
  line(prompt row); printstring(text)
%end

%predicate pending read(%integer port)
%integer bit
   bit=1<<port
   %true %if dtx & bit # 0
   %false
%end


%integerfn get ether(%byte port, %bytearrayname buf(0:*), %integer timeout)
%integer t, bytes
   bytes = 0
   t = cputime
   %cycle
      %if pending read(port) %then bytes = ether read(port,buf(0),BUF SIZE)
   %repeatuntil cputime-t > timeout*1000 %or bytes#0
   %return bytes
%end

%integerfn server handshake(%string (255) command, %integer timeout,
%bytearrayname response(0:*), %integername len)
   %integer t
   ether write(my port,charno(command,1),length(command))
   t = cputime
   %cycle
      %if pending read(my port) %then %c
         len = ether read(my port,response(0),BUF SIZE) %and %result=0
      %result=-1 %if cputime-t > timeout*1000
!!      %result=1 %if testsymbol=' '
   %repeat
%end

%predicate start talking
   %integer rc
   %string (255) command
   %bytearray buffer(0:1279)
   ether close(my port)                   {Make sure local port is closed
   ether open(my port, server station<<8) {Open connection to the SERVER
   command = tostring(magic number)
   rc=server handshake(command, 5, buffer, n); !"Hello server"
!
!If the number of bytes rxd is 0, then the filestore is not up or is busy....
!so tell the user to try again later   
!
   clear frame
   %if rc#0 %start
      flag error("Server not responding - cache only".snl. %c
      "Retry by attempting to force a download (menu option 2)")
!      ether close(my port)
      %false
   %finish
!
!Now, if the remote port number is less than 1, then the server is not running
!on the filestore
!
   server port = buffer(0) - '0'
   %if server port <1 %start
      flag error("Server not running - cache only".snl. %c
      "Retry by attempting to force a download (menu option 2)")
!      ether close(my port)
      %false
   %finish
   flag comment("Hi - APMTEL SERVER Connected")
   ether close(my port)
   ether open(my port, server station << 8 ! server port)
   rc=server handshake("A".current user, 5, buffer, n)
   cache only = false
   %true
%end


%bytefn to upper(%byte c)
%if 'a' <= c <= 'z' %thenreturn c-'a'+'A' %elsereturn c
%end


!Routine to take teletext page/subpage from header and convert to integer.
%integerfn txstoi(%integer packet)
   %constinteger hi=0, lo=1
   %integerfn nib(%integer offset,hilo)
      %integer n
      n = byteinteger(packet+offset)
      %if hilo=hi %then n=n>>4
      %result=n&15
   %end
   %result = %c
   (((((nib(5,lo)*10+nib(0,hi))*10+nib(0,lo))*10+nib(1,hi))*10+%c
   nib(1,lo))*10+nib(2,hi))*10+nib(2,lo)
%end

%integerfn pg(%integer channel, %integer page)
   !Takes page specified as an integer channel plus 
   !page number (we hope as a decimal number, 100<=n<=999) and turns it into
   !a 16-bit integer, top 4 bits channel, bottom 12 page number as BCD.
   %integer h,t,d

   h = page//100
   page = page - h*100
   t = page//10
   d = page - t*10
   channel = channel & 16_0F
   %result=((channel<<4+h)<<4+t)<<4+d
%end

%conststring (255) %array getfail(-1:4) = %c
   {-1}"Server <-> Teletext receiver timeout",
   {0} "OK",
   {1} "Request cancelled",
   {2} "Server died while transmitting on ether",
   {3} "Server failed to transmit page to ether",
   {4} "Software error"

%routine move(%integer bytes, %bytename from, to)
   !Move BYTES bytes from FROM to TO. Pinched from IE.
   !If addr(FROM) < addr(TO) do the move from the top down to allow overlap
   %return %if Bytes = 0 %or  From == To

   %if Addr (To) < Addr (From) %start
      *Subq.l #1, d0
   f loop:
      *move.b (a0)+, (a1)+
      *dbra   d0, f loop
   %else
      *add.l  d0, a0
      *add.l  d0, a1
      *subq.l #1, d0
   b loop:
      *move.b -(a0), -(a1)
      *dbra   d0, b loop
   %finish
%end

%ownstring(40) spaces40 = "                                        "

%integerfn get subpage from server(%integer param, to, %integername status)
   %string (255) command
   %bytearray buffer(0:1279), coda(0:511)
   %integer rc,rc2,n,i

   %routine unpack teletext(%bytearrayname buffer, to(0:1279))
      %integer row, p, mag,i
      %bytearray check(0:31)

      !Note:  Rows 26, 28 and 29 are not transmitted.   There may be up to 4
      !row 27s.  I put the first row 27 in row 27 and any others in rows
      !26 then 28 and 29.
      !Unused rows have MAG and ROW set to 0.

      p=0
      %for i=0,1,31 %cycle; check(i)=0; %repeat
      %for i=0,1,23 %cycle ;!Max. of 24 42-byte rows in 1024 chars
         mag=buffer(p); row=buffer(p+1)
         %if mag#0 %start
            %if row=27 %start
               !Clumsy
               !does it in received order without dehamming the subrow no.
               row=26 %if check(27)#0
               row=28 %if check(26)#0
               row=29 %if check(28)#0
            %finish
            move(40, buffer(p+2), to(row*40))
            check(row)=1
         %finish
         p=p+42
      %repeat

      !Fill in empty rows - assumed to contain spaces
      %for row=1,1,31 %cycle
         %if check(row)=0 %start
            move(40, charno(spaces40, 1), to(row*40))
         %finish
      %repeat

      to(5) = buffer(0) ;!Save the magazine in an unused header byte
      status = buffer(5)<<8+(buffer(6)&255)
 
   %end

   command = "B".itos(param,-1)
   rc=server handshake(command, 200, buffer, n)
   %if rc=0 %start ;!Success
      %if n=512 %start
         !Expect the 2nd frame fragment
         n= get ether (my port,array(addr(buffer(512))), 6)
         %if n=512 %start
            !Then the status message
            n=get ether(my port,coda,512)
            !Now unpack the frame
            unpack teletext(buffer, array(to))
         %else
            !Server died between sending blocks 1 and 2.
            %result=2
         %finish
      %else
         %result=3
      %finish
   %else
     %if rc>0 %start
!!     rc2=server handshake("E",5,array(to),n)
       !Note possibility for confusion if the cancel crosses the pages
       !coming back.  Sort this later.
     %finish
   %finish
   %result=rc
%end

%integerfn mod10(%integer no); %result = no - (no//10)*10; %end
%integerfn mod100(%integer no); %result = no - (no//100)*100; %end

%constinteger %c
   erase page       = 16_08, {byte 4}
   newsflash        = 16_10, {byte 4}
   subtitle         = 16_20, {byte 4}
   suppress header  = 16_01, {byte 5}
   update indicator = 16_02, {byte 5}
   out of sequence  = 16_04, {byte 5}
   inhibit display  = 16_08, {byte 5}
   serial magazine  = 16_10  {byte 5}

%string (15) %fn statusbits(%integer status)
   !Returns the frame status bits as a string
   %byte c4,c5
   %string (15) s
   c4 = status>>8; c5 = status & 16_FF
   s=""
   s=s."e" %if c4 & erase page # 0
   s=s."n" %if c4 & newsflash # 0
   s=s."s" %if c4 & subtitle # 0
   s=s."h" %if c5 & suppress header # 0
   s=s."u" %if c5 & update indicator # 0
   s=s."o" %if c5 & out of sequence # 0
   s=s."i" %if c5 & inhibit display # 0
   s=s."m" %if c5 & serial magazine # 0
   s=s."?" %if c4 & (\(erase page ! newsflash ! subtitle)) # 0 %or %c
   c5 & (\(suppress header ! update indicator ! out of sequence ! %c
   inhibit display ! serial magazine)) # 0
   s="[".s."]" %unless s=""
   %result=s
%end

%integerfn get page from server(%integer page, base, %integername subpages)
   %integer rc, full pageno, f, firstf, maxsub, i, latestf, to, status
   firstf=-1; f=0; subpages=-1; maxsub=-1

   !Once the subpages have wrapped round, we know we have a complete page
   !and how big it is.
   subpages=0
   %cycle
      to = base + f * 1280
      rc=get subpage from server(page, to, status)
      %result=rc %if rc#0
      full pageno = txstoi(to)
      show screen(to)
      latestf=f;  f = mod100(full pageno) ;!the subpage number

      %if firstf<0 %start;!start point in subpage cycle
         firstf=f 
         !Page is in subpage-0 slot.  Copy the page to the correct place
         move(1280,byteinteger(to), byteinteger(base+(f-1)*1280)) %if f>1
      %finish

      %if f=0 %start; !Only subpage
         flag comment("   Page ".itos(full pageno,-1)." ".status bits(status))
         subpages=1
         %result=0
      %elseif f=latestf ;!subpages are looping
         flag comment("Subpage ".itos(full pageno,-1)." looping")
         subpages=1
         %result=0
      %else
         flag comment("Subpage ".itos(full pageno,-1)." ".status bits(status)." arrived") 
      %finish

      %if f<latestf %start
         !We've turned the corner: Maxsub is the top subpage number.
         maxsub=latestf
         move(1280, byteinteger(to), byteinteger(base + (f-1)*1280))
         %if firstf=1 %then subpages=maxsub %and %result=0
         !special case where firstf=1: we've just wrapped round
      %finish

      %if f+1=firstf %then subpages=maxsub %and %result=0
      !about to complete the cycle
   %repeat
   %result=4
%end

%routine browse(%integer base, lo, hi)
   %integer c, offset, minbase, maxbase
   %routine r; %cycle; c=testsymbol; %repeatuntil c>=0; %end
   flag comment("Use up and down arrows to scan page.".snl. %c
   "Press <return> to exit")
   minbase=lo*1280; maxbase=hi*1280
   offset=minbase
   %cycle; %repeatuntil testsymbol<0
   %cycle
      show screen(base+offset)
      %cycle
         r
         %if c=27 %start
            r
            %if c=91 %start
               r
               %if c=65 %start ;!Up
                  %if offset>minbase %then offset=offset-1280 %else offset=maxbase
               %elseif c=66 ;!Down
                  %if offset<maxbase %then offset=offset+1280 %else offset=minbase
               %finish
               %exit
            %finish
         %elseif c=10
            %exit
         %finish
      %repeat
      %exit %if c=10
   %repeat
%end

%routine carousel(%integer page)
   %integer rc, full pageno, f, firstf, subpages, maxsub, i
   flag comment("Press a key to exit".snl. %c
   "This may take some time so be patient")

   %cycle; %repeatuntil testsymbol=-1
   %cycle
      %exit %if testsymbol>=0
      rc=get page from server(page, pagestore, subpages)
      %if rc=0 %and subpages#0 %start
!!         %if subpages>1 %start
!!            show prompt("browse?")
!!            vt at(prompt row+1, menu col)
!!            %cycle
!!              f=testsymbol
!!              f='N' %if f=13 %or f=10 %or f='n'
!!              f='Y' %if f='y'
!!            %repeatuntil f='Y' %or f='N'
!!            %if f='Y' %start
!!               browse(pagestore, 0, subpages-1)
!!            %finish
      %else
         flag error("Page request failed - ".getfail(rc).snl. %c
         "Press <space> to continue")
         %cycle; %repeatuntil testsymbol=' '
      %finish
   %repeat
%end

%owninteger subpages=0

%routine act on (%integer comm, param)
   %switch entry('B':'H')
   %bytearray buffer(0:1279)
   %half page
   %integer rc, page id
   -> entry(comm)

entry('B'):  !Read a page from cache if available then broadcast if not
    page id = pg(channel, param)
    open cache(database file)
    read cached page(page id, pagestore, subpages)
    close cache
    %if channel = 5 %start
       flag error("Page not available") %if subpages=0
    %else
       %if subpages=0 %start
          flag error("Page not available")
       %elseif subpages=1
          show screen(pagestore)
       %else
          browse(pagestore, 0, subpages-1)
       %finish
    %finish
    %return

entry('C'):   !Change channel
    channel = param
    rc=server handshake(tostring(command).itos(channel,-1), 60, buffer, n)
    %return

entry('D'):   !Quit
   %if cache only # true %start
      rc=server handshake(tostring(command), 1, buffer, n)
      ether close(my port)
   %finish
   clear frame
   %return

entry('E'):  !Force a page request from server
   page id = pg(channel, param)
   open cache(database file)
   read cached page(page id, pagestore, subpages)
   close cache
   flag comment("Page from cache") %and showscreen(pagestore) %if subpages#0
   %if channel = 5 %start
      flag error("Cannot force a download on channel 5")
   %else
      %if cache only = true %start
          flag error("Trying to reconnect to server")
          %if start talking %start
             flag comment("OK.") 
             cache only = false
          %finish
      %finish

      %if cache only = false %start
          open cache(database file)
          rc=get page from server(param, pagestore, subpages)
          %if rc=0 %start
             %if subpages>1 %then browse(pagestore, 0, subpages-1)
             page id = pg(channel, param)
             flag comment 2("Caching page".snl."")
             write cached page(page id, pagestore, subpages)
          %else
             flag error("Page request failed - ".getfail(rc).snl. %c
             "Press <space> to continue")
             %cycle; %repeatuntil testsymbol=' '
          %finish
          close cache
      %else
          flag error("Cannot force page - server not responding")
      %finish
   %finish
   %return

entry('F'):
   show prompt("SAVE file name:");
   %cycle
      vt at(prompt row+1,menu col)
      read line(filename)
   %repeatuntil filename#""
   open output(1,filename)
   select output(1)
   %for i=0,1,32*40*subpages-1 %cycle
      print symbol(byteinteger(pagestore+i))
   %repeat
   close output
   select output(0)
   %return
   
entry('G'):
   %if graphics flag=0 %start
      flag error("DESIGN not possible without graphics")
   %else
      open cache(database file)
      design
      close cache
      an clear
   %finish
   %return

entry('H'):
   %if channel = 5 %start
      flag error("Cannot carousel on channel 5")
   %else
      open cache(database file)
      carousel(param)
      close cache
   %finish
%end


%routine get command(%integername comm, param)
   !Show menu, get and validate command.
   %ownbytearray table('1':'7') = 'B','E','C','F','H','G','D'
   %integer c
   %on 10 %start
      !Bad integer typed in.
      flag error("Bad integer supplied".snl.%c
      "Press space to continue")
      %cycle; %repeatuntil testsymbol=' '
   %finish

   clear frame %if graphics flag#0
   set shade(reverse+intense+blink+underline)
   title line("APMTEL on channel ".itos(channel,-1).":")
   set shade(0)
   line(1)
   print at line(menu row, %c
   "1:Get page".snl. %c
   "2:Force get".snl. %c
   "3:Channel".snl. %c
   "4:Save to file".snl. %c
   "5:Carousel page".snl. %c
   "6:Design page".snl. %c
   "7:QUIT".snl)
   !The explicitly written rows will put a | in rows 0-10.
   %if graphics flag=0 %start
      %for c=11,1,23 %cycle; vt at(c, divider col); printsymbol('|'); %repeat
   %finish
   flag error("".snl.""); flag comment("".snl."")
   show prompt("?:")
   vt at(prompt row+1, menu col)
   %cycle
      c = test symbol
   %repeatuntil '1' <= c <= '7'

   comm = table(c); param=0
   %if comm='B' %or comm='H' %or comm='E' %start 
      ! 'B': Get page, 'E': Force get from broadcast, 'H': Carousel
      show prompt("Page:") 
      %cycle
         vt at(prompt row+1,menu col)
         read(param)
         %exit %if 100<=param<=999
         flag error("Valid pages 100-999 only")
      %repeat
   
   %elseif comm='C'
      !Select channel
      show prompt("Channel:") 
      %cycle
         vt at(prompt row+1, menu col)
         read(param)
         %exit %if 1<=param<=5
         flag error("Valid channels 1 (BBC1), 2(BBC2), 3(STV), 4(Channel 4), 5(EUCSD) only")
      %repeatuntil 1<=param<=5
   %elseif comm='D'
      !Quit
   %finish
   vt at(comment row,menu col)
%end

   %if graphics present %then graphics flag=1 %else graphics flag=0
   pagestore = heapget(100*1280)
   set video mode(specialpad)
   clear frame
   channel = 1
   %if start talking %then cache only = false %else cache only = true
   %if graphics flag#0 %start
      an clear
      flag comment("Loading fonts ")
      load fonts                 { Load the teletext fonts up
   %finish

   %cycle
      get command(command, param)       { Get a menu choice .....
      act on(command, param)
   %repeatuntil command='D'
  
   %if cache only # true %then etherclose (myport)
   heapput(pagestore)
%endofprogram