!
!
!            APM Teletext page shower - Uses Level 1 graphics
!
!
! Original by Martin Gray
! Double height character implementation added               Andie Ness 19/11/87
! Graphic characters/modes added by                          Andie Ness 16/1/88
! Conceal/reveal added by                                    Andie Ness 29/2/88
!
!
!
%include "level1:graphinc.imp"
%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 font number = 0,
              graphics font number = 1,
              separated graphics font number = 2,
              double text font number = 3,
              double graphics font number = 4,
              double separated graphics font number = 5


%integer text font,
         graphics font,
         separated graphics font,
         double text font,
         double graphics font,
         double separated graphics font

%integer font w, font h
%integer done strip

%integerarray font store (0 : 5)

%predicate double trouble (%integer line, %bytearrayname p(0:24,0:39))
%integer yup,i
   yup=false
   %for i=0,1,39 %cycle
      %if p(line,i) = 141  %then yup=true
   %repeat
   %trueif yup = true
   %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

!Remove all the graphics characters in the scope of a double height code
%routine strip double (%integer line, %bytearrayname p(0:24,0:39))
%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
   %else
      %if p(line,column) & 127 =normal height %then in double=false
      %if in double=true %start
         p(line,column)=' ' %unless alpha colour(p(line,column)) %orc
            p(line,column)& 127 = new background %or p(line,column) &127=black background
      %finish
   %finish
   %repeat
%end

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

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

         %if alpha colour(ch) %start
            %if mode & double height mask # 0 %start
               font (double text font)
               current font = double text font number
            %else
               font (text font)
               current font = text font number
            %finish

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

            %if mode & separated graphics mask # 0 %start
! select separated graphics
               %if mode & double height mask # 0 %start
                  font (double separated graphics font)
                  current font = double separated graphics font number
               %else
                  font (separated graphics font)
                  current font = separated graphics font number
               %finish
            %else
! select contiguous graphics font
               %if mode & double height mask # 0 %start
                  font (double graphics font)
                  current font = double graphics font number
               %else
                  font (graphics font)
                  current font = graphics font number
               %finish
            %finish
            mode = mode! graphics mode
         %finishelsec
         %if ch = contiguous graphics %start
            mode = mode & \separated graphics mask
! change graphics font type to contiguous
            %if mode & double height mask # 0 %start
               font (double graphics font)
               current font = double graphics font number
            %else
               font (graphics font)
               current font = graphics font number
            %finish
            ch = last graphics char
         %finishelsec
         %if ch = separated graphics %start
! change graphics font type to contiguous
            mode = mode! separated graphics mask
            %if mode & double height mask # 0 %start
               font (double separated graphics font)
               current font = double separated graphics font number
            %else
               font (separated graphics font)
               current font = separated graphics font number
            %finish
            ch = last graphics char
         %finishelsec
         %if ch = hold graphics %start
! font (graphics font) 
            mode = mode! held mode
            ch = last graphics char
         %finishelsec
         %if ch = release graphics %start
            mode = mode & \held mode
            ch = last graphics char
         %finishelsec
         %if ch = new background %start
            background colour = display colour
            ch = last graphics char
         %finishelsec
         %if ch = black background %start
            background colour = black
            ch = last graphics char
         %finishelsec
         %if ch = double height %start
            current font = current font + 3 %if current font <= 2
            font (font store(current font))
            ch = last graphics char
            mode = mode! double height mask
         %finishelsec
         %if ch = normal height %start
            current font = current font - 3 %if current font >= 3
            font (font store(current font))
            ch = last graphics char
            mode = mode & \double height mask
         %finishelsestart
            ch = last graphics char
         %finish
      %end

   current font = text font number
   font (text font)
   text at (0,512-(row+1)*font h)
   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) & 127                   {Now conforms to TELETEXT specs!!!!!!
      %if ch & 2_00100000 # 0 %and mode&held mode # 0 %start
         last graphics char = ch
      %finish

      %if ch < 32 %then process control(ch)

      %unless ch = 127 %and mode & graphics mode # 1 %start
         colour (background colour)
         font(font store(text font number))
         show symbol (128)
         font(font store(current font))
         text at (column * font w,512 - (row+1) * font h) %unless ch = ' '
         colour(display colour)
      %finish
      show symbol (ch) %unless ch = ' '

   %repeat
%end

%externalroutine show screen (%bytearrayname page(0:24,0:39))
%integer row, column, char pointer
   page(0,0)=' '  ; page(0,1)='A'; page(0,2)='P'; page(0,3)='M'; page(0,4)='T'
   page(0,5)='E'; page(0,6)='L'; page(0,7)=' ';
!!!!   clear;! the graphics screen
   done strip=false
   %for row=0,1,23 %cycle
      %if double trouble(row,page) %start
         %if done strip=true %then done strip=false %elsestart
            strip double(row,page)
            done strip=true
         %finish
      %finish
      print row (row, page)
   %repeat
%end


%externalroutine load fonts
readfont("apmtel:TFONT0.BFT",text font)
readfont("apmtel:TFONT1.BFT",graphics font)
readfont("apmtel:TFONT2.BFT",separated graphics font)
readfont("apmtel:TFONT0DH.BFT",double text font)
readfont("apmtel:TFONT1DH.BFT",double graphics font)
readfont("apmtel:TFONT2DH.BFT",double separated graphics font)
font store (0) = text font
font store (1) = graphics font
font store (2) = separated graphics font
font store (3) = double text font
font store (4) = double graphics font
font store (5) = double separated graphics font
font (text font)
font w = max font width
font h = font height
%end

%endofprogram