{**********************************************************************}
{*                      APMTEL Database builder                       *}
{*                  Andrew Ness  1988  CS4 project                    *}
{*               Modded version - see mod list below                  *}
{*                                                                    *}
{*                    Version 1.3  7 Nov 1988                         *}
{**********************************************************************}
%include "APMTEL:ins_pg3.inc"
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%include "inc:util.imp"
%conststring (255) database file = "db.dat"

%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,
%byte         comm
%integer      page0,
%integer      pagestore,       {100 * bytearray    page(0:23,0:39) }
%integer      i,
              j, 
              command, param,
              channel
%string (255) filename

%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:1023)
   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   
!
   %if rc#0 %start
      printline("Server not responding - cache only")
      printline("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
      printline("Server not running - cache only")
      printline("Retry by attempting to force a download (menu option 2)")
!      ether close(my port)
      %false
   %finish
   printline("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)
   %true
%end

!----- USER3 Emulation

%routine flag comment(%string (255) s)
   printline(s)
%end

%routine show screen(%integer junk)
%end

!----- CUT HERE FROM USER3 -----

%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:1023), coda(0:511)
   %integer rc,rc2,n,i

   %routine unpack teletext(%bytearrayname buffer, to(0:1023))
      %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
!!openoutput(1, "Page"); selectoutput(1); 
            unpack teletext(buffer, array(to))
!!%for i=0,1,1023 %cycle; printsymbol(buffer(i)); %repeat
!!%for i=0,1,1279 %cycle; printsymbol(byteinteger(to+i)); %repeat
!!close output
         %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

! ----- END CUT -----

%routine act on (%integer comm, param)
   %switch entry('C':'E')
   %half page
   %bytearray buffer(0:1023)
   %integer rc, subpages, page id
   -> entry(comm)

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

entry('D'):   !Quit
    rc=server handshake(tostring(comm), 1, buffer, n)
    ether close(my port)
   %return

entry('E'):  !Force a page request from server
    page id = pg(channel, param)
    rc=get page from server(param, pagestore, subpages)
    %if rc=0 %start
      write cached page(page id, pagestore, subpages)
    %else
      printline("page request failed ".itos(rc,-1))
    %finish
   %return

%end

%externalroutinespec create db file(%string(255) name, %integer ind, blks)
%integer mag, pag,m

   create db file("db.dat", 5, 40)
   %stop %unless start talking
   pagestore = heapget(100*1280); page0 = heapget(1280)

   open cache(database file)
   %for channel = 1,1,4 %cycle
      act on('C', channel)
      %for mag = 1, 1, 9 %cycle
         !Interleave page requests
         %for pag = 0,1,24 %cycle
            -> end %if testsymbol='#'
            m = mag*100+pag
            act on('E', m)
            act on('E', m+25)
            act on('E', m+50)
            act on('E', m+75)
         %repeat
      %repeat
   %repeat
end:
   close cache
   act on('D', 0)
  
   heapput(pagestore)
%endofprogram