!
! Design sub-module
!
%begin

%option "-low-nons"
%include "level1:graphinc.imp"
%include "inc:util.imp"
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%include "inc:vtlib.imp"
%include "APMTEL:ins_pg3.inc"

%constinteger MaxR=23, MaxC=39,
escape     = 27,
keypad     = 79,
cursors    = 91,

uparrow    = 65,
downarrow  = 66,
rightarrow = 67,
leftarrow  = 68,
home       = 72,

enter      = 77,
pf1        = 80,
pf2        = 81,
pf3        = 82,
pf4        = 83,
padcomma   = 108,
padminus   = 109,
paddot     = 110,
pad0       = 112,   pad1=113, pad7=119, pad8=120, pad9=121,
delete     = 127

%externalroutinespec show comments

%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, c height

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

%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, %integer col, %bytearrayname page (0:31,0:MaxC))
%byte ch, background colour, last graphics char, mode, display colour
%integer column, temp font
%on 0 %start; %return; %finish

   %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


%routine print wy row (%byte row, %integer C column, %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
   %bytearray line(0:MaxC)
   %bytename ch

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

   move(MaxC, page(row, 0), line(0))
   vt at(row, 0)
   current mode=normal
   %for column = 0, 1, MaxC %cycle
      ch == line(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
      %if column = C column %start ;!Flip mode over cursor
        %if mode=intense %then mode=normal %else mode=intense
        change mode
        printsymbol(ch)
        %if mode=normal %then mode=intense %else mode=normal
      %else
        change mode {%if mode # current mode}
        printsymbol(ch)
      %finish
   %repeat
%end

%externalpredicate graphics present
   %on 0 %start
      %false
   %finish
   plot(0,0)
   %true
%end


%routine show screen(%integer pg,C row, C column)
   %integer row, column, char pointer, col
   %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 ;!of nib

   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)
 
   row=0
   %cycle
      %if row=C row %then col = C column %else col = -1
      %if double trouble(row,page) %start
         strip double(row,page)
         print wy row (row,col, page); print row(row,col, page)
         row=row+1
      %finish
      print wy row (row,col, page); print row(row,col, page)
      row=row+1
   %repeatuntil row>=24
%end ;!of show screen

%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

%externalroutine design(%integer graphics)

%integer font w, font h,
         m x, m y,
         char x, char y,
         old m x, old m y

%ownbytearray page(0:31,0:39)= ' '(*)

%constinteger  cursor plane = 8,  rest = 7,
               TRUE = 1, FALSE = 0
   
%routine printline(%string (255) s)
   printstring(s); newline
%end ;!of printline in design

%routine setup screens
  set frame(0,24,0,80)
  clear frame
  %if graphics = true %start
    clear
    Offset (0,0)
    enable(rest)
  %finish
  set terminal mode(no page)
%end ;!of setup screens in design

! draw cursor:      draw a box round the character box containing (x,y)
!                   i.e. snap the cursor onto the character grid
%routine draw cursor(%integer x,y)
  %on 0 %start; %return; %finish
  x = (x // font w) * font w
!!  y = (y // font h+1) * font h+ font h//2+1
  y = (y // font h) * font h + font h
  enable(cursor plane)
  colour(32767)
  hline (x,x+font w,y)
  hline (x,x+font w,y+font h)
  vline (x,y,y+font h)
  vline (x+font w,y,y+font h)
  enable(rest)
%end ;!of - in design

! undraw cursor:     erases the cursor from the screen
%routine undraw cursor(%integer x,y)
  %on 0 %start; %return; %finish
  x = (x // font w)* font w
!!  y = (y // font h+1)* font h+ font h//2+1
  y = (y // font h) * font h + font h
  enable(cursor plane)
  colour(0)
  hline(x,x+font w,y)
  hline(x,x+font w,y+font h)
  vline(x,y,y+font h)
  vline(x+font w,y,y+font h)
  enable(rest)
%end ;!of - in design

%integerfn get m position
!
! Repeats a loop polling the m position until a button is pressed
!
%integer temp buttons, x off, y off, t
   set frame(15,5,0,40)
   clear frame
   print string("PLEASE SELECT MENU OPTION :-")
   %cycle
      x off = rel mouse x
      y off = rel mouse y
      m x = m x + x off 
      m y = m y + y off 
      %if mx > 39 * fontw %then mx = 39*fontw %elseif mx < 0 %then mx = 0
      %if my > 23 * fonth %then my = 23*fonth %elseif my < 0 %then my = 0
      %if m x # old m x %or m y#old m y %start
         undraw cursor(old m x, old m y)
         old m x = m x; old m y=m y
         draw cursor(old m x, old m y)
         char x = m x // font w 
         char y = m y // font h 
         !write(23-char y,5);write(char x,5);newline
      %finish
      temp buttons = test symbol - '0'
   %repeatuntil 1<=temp buttons <= 8
   newline
   %return temp buttons
%end ;!of - in design

! setup designer:    intialise the variables and framestore for use by the
!                    designer
%routine setup designer
   setup screens
   m x = 320
   m y = 256
   old m x = 0 ; old m y = 0
   font w = max font width
   font h = font height
%end ;!of - in design


%routine load file(%string (255) name,%bytearrayname p(0:31,0:39))
%label abort
%integer i,j,t
   %on 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
       printline("Sorry cannot load ".name." because ".event_message)
       ->abort
   %finish
   open input(1,name)
   select input(1)
   %for i=0,1,23 %cycle
      %for j=0,1,39 %cycle
         read symbol(t)
         p(i,j) = t                              {NEEDED FOR VTLIB
      %repeat
   %repeat
abort:
   close input
   select input(0)
%end ;!of - in design

%routine save file(%string (255) name)
%label abort
%integer i,j
    %on 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
       printline("Sorry cannot do that because ".event_message)
       -> abort
    %finish
    open output(1,name)
    select output(1)
    %for i=0,1,MaxR %cycle
       %for j=0,1,MaxC %cycle
       printsymbol(page(i,j))
       %repeat
    %repeat
abort:
    close output
    select output(0)
%end ;!of - in design

%integerfn str to int (%string(255) str)
%integer int,i
   int = 0
   %for i=1,1,length(str) %cycle
      int = int * 10 + charno(str,i) - '0' %if '0' <= charno(str,i) <= '9'
   %repeat
   int = int - (int // 32) * 32            ;!take control codes
   %return int
%end ;!of - in design
      
%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.

   %result=(page&16_FFF) ! (channel&16_0F)<<12
%end ;!of - in design

%routine save to db(%integer location, %string(255) comments)
   %integer page id
   page id = pg(5, location)
   !Forget comments   
   write cached page(page id, addr(page(0,0)), 1)
%end ;!of - in design

%routine load from db(%integer channel, location)
   %integer page id, subpages
   page id = pg(channel, location)
   read cached page(page id, addr(page(0,0)), subpages)
   %if subpages#0 %start
      show screen(addr(page(0,0)),-1,-1)
   %else
      printline("Page not present")
   %finish
%end ;!of - in design

%routine v40(%integer row)
  vt at(row, 40)
%end ;!of - in design

%routine print l40(%string (255) s)
   length(s)=40 %if length(s)>40
   printstring(s)
   spaces(40-length(s)) %if length(s)<40
%end ;!of - in design


%routine do design
  %constinteger norm=0
  %integer i,j,mode,control,channel,row,column,c,finished
  %string (255) line

%integerfn C mode(%integer row, col)
  %constinteger normal=0, underline=8, dim=1
  %byte ch, mode
  ch = page(row, col)
      %if row=0 %start
         mode=intense
      %elseif ch<32
         mode=normal
      %elseif 32<=ch<=127
         mode = normal
      %elseif 129<=ch<=135
         mode=normal
      %elseif 156<=ch<=157 ;!New background
         mode=normal
      %elseif 128<=ch<=159
         mode=intense
      %else
         mode=intense
      %finish
  %result = mode
%end ;!of - in design

%routine zap cursor
  set shade(C mode(row, column))
  vt at(row,column); printsymbol(page(row,column))
  undraw cursor(column*font w, (23-row)*font h)
%end ;!of - in design

%routine paint cursor
  %integer mode
  %constinteger normal=0, underline=8, dim=1
  mode = C mode(row, column)
  vt at(row, column)
  %if mode = normal %then set shade(intense) %else set shade(normal)
  print symbol(page(row,column))
  draw cursor(column*font w, (23-row)*font h)
%end ;!of - in design

%routine C right
  zap cursor
  column = column + 1
  %if column > MaxC %start { Wrapround
    column = 0 ; row = row + 1
    %if row > MaxR %then row = 0
  %finish
  paint cursor
%end ;!of - in design

%routine C down
  zap cursor
  row = row + 1
  %if row > MaxR %start { Wrapround
    row = 0
  %finish
  paint cursor
%end ;!of - in design

%routine C up
  zap cursor
  row = row - 1
  %if row < 0 %start { Wrapround
    row = MaxR
  %finish
  paint cursor
%end ;!of - in design

%routine C left
  zap cursor
  column = column - 1
  zap cursor
  %if column < 0 %start { Wrapround
    column = MaxC ; row = row - 1
    %if row < 0 %then row = MaxR
  %finish
  paint cursor
%end ;!of - in design

%routine C home
  zap cursor
  row=0; column=0
  paint cursor
%end ;!of - in design

%routine get(%integername c)
   %cycle; c=testsymbol; %repeatuntil c>=0
   v40(20); write(c,3)
%end

  %routine add(%byte c)
    %constinteger normal=0
    page(row, column) = c
!    %if c height=2 %start
!      page(row+1, column)=c
!      vt at(row+1, column)
!      %if c<=127 %then printsymbol(c) %elsestart
!        set shade(intense); printsymbol(c&127+'A'); set shade(normal)
!      %finish
!    %finish
    vt at(row, column);
    %if c<=127 %then printsymbol(c) %elsestart
      set shade(intense); printsymbol(c&127+'A'); set shade(normal)
    %finish
v40(21); print l40("add ".itos(page(row,column),-1)." ".itos(row,-1)." ".itos(column,-1))
    C right
 %end ;!of add in design

row=0; column=0
finished = false; c height = 1
show screen(addr(page(0,0)),0,0)
C home
%cycle
  get(c)
  %if c = escape %start
    get(c)
    %if c=cursors %start
      get(c)
      %if c = uparrow %start
        C up

      %elseif c = downarrow
        C down

      %elseif c = leftarrow
        C left

      %elseif c = rightarrow
        C right

      %elseif c = home
        C home

      %finish
    %elseif c=keypad
      get(c)
      %if pad1<=c<=pad7 %start
        add(c-pad0+128)
        mode=norm
        print wy row(row, column, page); print row(row,column, page)
        v40(22); write(c,3); write(page(row,column), 3)

      %elseif c=pad0
        get(c)
        %if c=escape %start
          get(c)
          %if c=keypad %start
            get(c)
            %if pad1<=c<=pad7 %start
              add(c-pad0+144)
              print wy row(row, column, page); print row(row, column, page)
            %elseif c=pad8
              add(128+13)
              C down
              add(128+13)
              c height = 2
            %elseif c=pad9
              add(128+12)
              C down
              add(128+12)
              c height = 1
            %finish
          %finish
        %finish

      %elseif c=pf1
        v40(21); print l40("LOAD file:")
        read line(line)
        %if line#"" %then load file(line,page)

      %elseif c=pf2
        v40(21); print l40("SAVE file name:")
        read line(line)
        save file(line)

      %elseif c=pf4
        v40(21)
        prompt("SAVE id:"); read(control)
        prompt("Comment line:"); read line(line)
        line = current user." <-> ".line
        save to db(control, line)

      %elseif c=pf3
        prompt("LOAD channel:"); read(channel)
        prompt("LOAD page id:"); read(control)
        load from db(channel, control)

      %elseif c=padcomma
        %for j=0,1,MaxC %cycle; page(row,j) = ' '; %repeat
        show screen(addr(page(0,0)),row,column)

      %elseif c=padminus
        %for i=0,1,MaxR %cycle
          %for j=0,1,maxC %cycle; page(i,j) = ' '; %repeat
        %repeat
        show screen(addr(page(0,0)),row,column)

      %elseif c=enter
        finished = true
      %finish
    %else
      !Ignore it
    %finish
!  %elseif c=delete
!    C left
!    add(' ')
!    C left
!    print wy row(row, column, page); print row(row,column,page)
  %else
    add(c)
    print wy row(row, column, page); print row(row,column,page)
  %finish
  %repeatuntil finished = true
  clear frame
%end ;!of - in design

%routine show menu
   v40(0); print l40(" 1:alpha red         2:alpha green")
   v40(1); print l40(" 3:alpha yellow      4:alpha blue")
   v40(2); print l40(" 5:alpha magenta     6:alpha cyan")
   ! 8: flash, 9: steady, 10,11,14,15,16: unused 24: conceal, 27: unused
   v40(3); print l40(" 7:alpha white      12:normal height")
   v40(4); print l40("13:double height    17:graphic red")
   v40(5); print l40("18:graphic green    19:graphic yellow")
   v40(6); print l40("20:graphic blue     21:graphic magenta")
   v40(7); print l40("22:graphic cyan     23:graphic white")
   v40(8); print l40("25:contig graphics  26:sep graphic")
   v40(9); print l40("28:black background 29:new background")
   v40(10); print l40("30:hold graphics    31:release graphics|")
   v40(11); print l40("")
   v40(12); print l40("CONTROL CODES")
   v40(13); print l40("pf2: Save page to file")
   v40(14); print l40("pf1: Load page from file")
   v40(15); print l40("pf4: Save page to db")
   v40(16); print l40("pf3: Load page from db")
   v40(17); print l40(" - : Clear page")
   v40(18); print l40(" , : Clear line")
   v40(19); print l40("enter: quit")
   v40(20); print l40("")
   v40(21); print l40("")
   v40(22); print l40("")
   v40(23); print l40("")
%end ;!of - in design

!%integer i
   set video mode(specialpad)            { To initialise the TERMLIB stuff
   setup designer
   show menu
!!%cycle
!i=testsymbol; %if i>=0 %start; write(i, 3); newline; %finish; %repeat
   do design
%end ;!of design

%begin
%if graphics present %start
  printline("Reading fonts")
  load fonts
  design(1)
%finishelse design(0)
%end
%endofprogram