{**********************************************************************}
{*     APM Teletext page display routines - Use Level 1 graphics      *}
{*                  Andrew Ness  1988  CS4 project                    *}
{*               Modded version - see mod list below                  *}
{*                                                                    *}
{*                    Version 1.3  7 Nov 1988                         *}
{**********************************************************************}

! Original by Martin Gray
! Double height character implementation added               AN  19/11/87
! Graphic characters/modes added by                          AN  16/01/88
! Conceal/reveal added by                                    AN  29/02/88
! Tidied up                                                  JHB 08/07/88
!
!
!--%include "level1:graphinc.imp"
%option "-low-nons"
%dynamic %routine %spec textat %alias "FRED_GRAPHICS_TEXTAT" (%integer x,y)
%dynamic %routine %spec showsymbol %alias "FRED_GRAPHICS_SHOWSYM" (%integer k)
%dynamic %routine %spec colour %alias "FRED_GRAPHICS_COLOUR" (%integer colour)
%dynamic %routine %spec clear %alias "FRED_GRAPHICS_CLEAR"
%dynamic %routine %spec half clear %alias "FRED_GRAPHICS_HCLEAR" (%integer h)
%dynamic %routine %spec readfont %alias "FRED_GRAPHICS_READFONT" %c
                                        (%string(255) file, %integer %name font)
%dynamic %routine %spec font %alias "FRED_GRAPHICS_FONT" (%integer f)

%dynamic %volatile %integer %function %spec font height %alias "FRED_GRAPHICS_FONTHT"
%dynamic %volatile %integer %function %spec max font width %c
                                             %alias "FRED_GRAPHICS_FONTWX"
%constant %integer black=0, red=1, green=2, blue=4
!%constant %integer yellow=red+green, magenta=red+blue, cyan=blue+green
%constant %integer white=red+green+blue
!--- end of level1 stuff
%include "INC:UTIL.IMP"
%begin

%byte true = 1, false = 0

%constbyte  default mode = 0, 
            graphics mode = 1, 
            held mode = 2,
            double height mask = 4, 
            separated graphics mask = 8,
            conceal = 16

%constinteger hold graphics = 30,
              release graphics = 31,
              new background   = 29,
              black background = 28,
              double height    = 13,
              normal height    = 12,
              contiguous graphics = 25,
              separated graphics  = 26

%constinteger text = 0,
              graphics = 1,
              sep graphics = 2,
              double text = 3,
              double graphics = 4,
              double sep graphics = 5

%integer font w, font h

%ownintegerarray font store (0 : 5) = 0(*)
%owninteger current font=text
%ownintegerarray virscreen(0:31, 0:39) = 0(*)

%dynamic %routine %spec fill %alias "FRED_GRAPHICS_FILL" %c
                                                       (%integer x0, y0, x1, y1)
%externalroutine an clear
   %integer i,j
   %for i=0,1,31 %cycle; %for j=0,1,39 %cycle; virscreen(i,j)=0; %repeat; %repeat
   clear
%end

%predicate double trouble (%integer row, %bytearrayname p(0:31,0:39))
   %integer column
   %for column=0,1,39 %cycle
      %true %if p(row,column)&127 = 13
   %repeat
   %false
%end

%predicate alpha colour(%byte ch)
   %trueif 1<= ch&127 <= 7
   %false
%end

%predicate graphics colour(%byte ch)
   %trueif 17 <= ch&127 <= 23
   %false
%end

%routine strip double (%integer line, %bytearrayname p(0:31,0:39))
   !Remove all the graphics characters in the scope of a double height code
   !We replace the double-graphics control char by itself & 127, and all
   !characters in its scope by itself ! 128.

   !Note we swap the characters onto the bottom of the two lines.  This
   !is because teletext tends to skip the second line, BUT our font requires
   !us to print tall double-height characters from the 2nd of the lines.

   !Note also the statement about double lines:
   !The info sent in row N applies to row N+1. Row N+1 is ignored if sent.
   !It is possible to mix single and double height chars but single height chars
   !can only appear in the top line.
   !From transmitted examples, graphics commands appy to both rows though.

   %integer in double,column
   in double=false
   %for column=0,1,39 %cycle
      %if p(line,column) & 127 =double height %then %start
         in double=true
         p(line,column)=141
         p(line+1,column) = double height
         !Mark the double-height control in the next line as the unmasked one.
      %else
         %if p(line,column) & 127 =normal height %then in double=false
         %if in double=true %start
            p(line+1,column)=p(line,column); p(line,column)=141; 
         %else
            p(line+1,column) = p(line,column) %if p(line,column)&127 <=' '
         %finish
      %finish
   %repeat
%end

%routine print row (%byte row, %bytearrayname page (0:31,0:39))
%byte ch, background colour, last graphics char, mode, display colour
%integer column, temp font

   %routine select font(%integer font no)
      current font = font no
      font(font store(current font))
   %end

   %routine process control(%bytename fch)
      ! set alpha colour
      %byte ch

      ch=fch&127
      %if alpha colour(ch) %start
         %if mode & double height mask # 0 %then select font(double text) %c
         %else select font(text)
         mode = mode & \graphics mode
         display colour = ch
         colour (ch)
         ch = ' '
         last graphics char = ' '

      %elseif graphics colour(ch)
         ! set graphics colour and font
         display colour = ch - 16
         colour(display colour)
         %if mode & held mode # 0 %then ch = last graphics char %else ch=' '

         %if mode & separated graphics mask # 0 %start
            ! select separated graphics
            %if mode & double height mask # 0 %start
               select font(double sep graphics)
            %else
               select font(sep graphics)
            %finish
         %else
            ! select contiguous graphics font
            %if mode & double height mask # 0 %start
               select font(double graphics)
            %else
               select font(graphics)
            %finish
         %finish
         mode = mode! graphics mode

      %elseif ch = contiguous graphics
         mode = mode & \separated graphics mask
         ! change graphics font type to contiguous
         %if mode & double height mask # 0 %start
            select font(double graphics)
         %else
            select font(graphics)
         %finish
         ch = last graphics char

      %elseif ch = separated graphics
         ! change graphics font type to contiguous
         mode = mode! separated graphics mask
         %if mode & double height mask # 0 %start
            select font(double sep graphics)
         %else
            select font(sep graphics)
         %finish
         ch = last graphics char

      %elseif ch = hold graphics
         ! font (graphics font) 
         mode = mode! held mode
         ch = last graphics char

      %elseif ch = release graphics
         mode = mode & \held mode
         ch = last graphics char

      %elseif ch = new background
         background colour = display colour
         ch = last graphics char

      %elseif ch = black background
         background colour = black
         ch = last graphics char

      %elseif ch = double height
         select font(current font+3) %if current font <= 2
         !this is either the double-graphics command or the masked-out characters
         !following it.  
         %if fch=141 %then ch=141 %else ch=last graphics char
         mode = mode! double height mask

      %elseif ch = normal height
         select font(current font-3) %if current font >= 3
         ch = last graphics char
         mode = mode & \double height mask

      %else
         ch = last graphics char
      %finish
      fch=ch
   %end
   
   %routine an show sym(%integer fc)
      %integer desc, char h, c
      c=fc&127
      desc = (((current font<<8)+background colour)<<8+display colour)<<8+fc
      %if desc # virscreen(row,column) %start
         %unless c = 127 %and mode & graphics mode # 1 %start
            char h = font h
            %if fc#141 %start ;  !Not masked-out double height characters
               colour (background colour)
               !Do a big background for double-height fonts.
               %if  current font>2 %then char h=font h<<1 %else char h=font h
               fill(column*font w, 476-row*font h,
               column*font w+(font w-1), 476-row*font h+(char h-1))
               colour(display colour)
            %finish
         %finish

         text at(column*font w, 476-row*font h) %and show symbol(c) %c
         %unless c = ' ' %or c=13
         virscreen(row,column) = desc
      %finish
   %end

   select font(text)
   last graphics char = ' ';
   mode = default mode; display colour = white
   background colour = black
   colour (display colour)
   %for column = 0, 1, 39 %cycle
      ch = page (row, column)
      %if ch & 16_20#0 %and mode&held mode#0 %then last graphics char=ch&127
      %if ch&127 < 32 %then process control(ch) ;!Leaves ch= ' ' or last graphics char
      an show sym (ch)
   %repeat
%end

%routine move(%integer bytes, %bytename from, to)
   %return %if Bytes = 0 %or  From == To
      *Subq.l #1, d0
   f loop:
      *move.b (a0)+, (a1)+
      *dbra   d0, f loop
%end


%include "inc:vtlib.imp"

%routine print wy row (%byte row, %bytearrayname page (0:31,0:39))
   %byte mode, last graphics char, display colour, background colour
   %integer column, c, current mode
   %constinteger normal=0, underline=8, dim=1
   %bytename ch

   %routine change mode
      set shade(mode)
      current mode=mode
   %end

   vt at(row, 0)
   current mode=normal
   %for column = 0, 1, 39 %cycle
      ch == page (row, column) 
      %if row=0 %start
         ch=ch&127; ch=32 %if ch<32
         mode=intense
      %elseif ch<32
         ch=32; mode=normal
      %elseif 32<=ch<=127
         mode = normal
      %elseif 129<=ch<=135
         ch=32; mode=normal
      %elseif 156<=ch<=157 ;!New background
         ch=32; mode=normal
         ch[1]=32
      %elseif 128<=ch<=159
         ch=32; mode=intense
      %else
         ch=ch&127
         mode=intense
      %finish
      change mode {%if mode # current mode}
      printsymbol(ch)
   %repeat
   mode=normal; change mode; printsymbol(' ')
%end

%dynamic %routine %spec plot %alias "FRED_GRAPHICS_PLOT" (%integer x, y)
%externalpredicate graphics present
   %on 0 %start
      %false
   %finish
   plot(0,0)
   %true
%end


%externalroutine show screen(%integer pg)
   %integer row, column, char pointer, graphics flag
   %bytearray page(0:31,0:39)

   %constinteger hi=0, lo=1
   %integerfn nib(%integer offset,hilo)
      %integer n
      n = byteinteger(pg+offset)
      %if hilo=hi %then n=n>>4
      %result=n&15+'0'
   %end

   %if graphics present %then graphics flag=1 %else graphics flag=0
   move(1280, byteinteger(pg), page(0,0))

   page(0,0) = nib(5,lo)
   page(0,1) = nib(0,hi)
   page(0,2) = nib(0,lo)
   page(0,3) = nib(1,hi)
   page(0,4) = nib(1,lo)
   page(0,5) = nib(2,hi)
   page(0,6) = nib(2,lo)
 
   push frame
   set frame(0,23,40,40)
   clear frame
   row=0
   %cycle
      %if double trouble(row,page) %start
         strip double(row,page)
         %if graphics flag=0 %then print wy row (row, page) %else print row(row, page)
         row=row+1
      %finish
      %if graphics flag=0 %then print wy row (row, page) %else print row(row, page)
      row=row+1
   %repeatuntil row>=24
   pop frame
%end

%externalroutine load fonts
   readfont("apmtel:TFONT0.BFT",   font store (text))
   readfont("apmtel:TFONT1.BFT",   font store (graphics))
   readfont("apmtel:TFONT2.BFT",   font store (sep graphics))
   readfont("apmtel:TFONT0DH.BFT", font store (double text))
   readfont("apmtel:TFONT1DH.BFT", font store (double graphics))
   readfont("apmtel:TFONT2DH.BFT", font store (double sep graphics))
   font(font store(text))
   font w = max font width
   font h = font height
%end

%endofprogram
