!
! Design sub-module
!
%begin


%option "-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"

%externalroutinespec show screen(%integer page)
%externalroutinespec show comments

%externalroutine design


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

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

%constinteger  cursor plane = 8,  rest = 7,
               TRUE = 1, FALSE = 0
   
%routine setup screens
   clear
   Offset (0,0)
   enable(rest)
   set terminal mode(no page)
%end

! 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)
   x = (x // font w) * font w
   y = (y // font h+1) * font h+ font h//2+1
   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

! undraw cursor:     erases the cursor from the screen
%routine undraw cursor(%integer x,y)
   x = (x // font w)* font w
   y = (y // font h+1)* font h+ font h//2+1
   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

%integerfn get m position
!
! Repeats a loop polling the m position until a button is pressed
!
%integer temp buttons, x off, y off, t
   push frame
   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
   pop frame
   %return temp buttons
%end

! 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


%routine load file(%string (255) name,%bytearrayname p(0:23,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

%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,23 %cycle
       %for j=0,1,39 %cycle
       printsymbol(page(i,j))
       %repeat
    %repeat
abort:
    close output
    select output(0)
%end

%routine insert text(%integer column,row , %string(255) s)
%integer i
   %if column < 0 %then column = 0
   %if row > 23 %then row = 23
   row = 23 - row 
   %for i=1,1,length(s) %cycle
      page(row, column) = charno(s,i)
      column = column + 1
      %if column > 39 %start                    { Wrapround
          column = 0 ; row = row +1
          %if row > 23 %then row = 0
      %finish
   %repeat
   show screen(addr(page(0,0)))
%end

%routine insert control(%integer column,row ,control code)
   %if column < 0 %then column = 0
   %if row > 23 %then row = 23
   page (23-row,column) = control code
   show screen(addr(page(0,0)))
%end
   
%routine show menu
   clear frame
   newline
   print string("-------------------------".snl)
   print string("| 1 Add text            |".snl)
   print string("| 2 Add control         |".snl)
   print string("| 3 Save page to file   |".snl)
   print string("| 4 Load page from file |".snl)
   print string("| 5 Save page to db     |".snl)
   print string("| 6 Load page from db   |".snl)
   print string("| 7 Clear page          !".snl)
   print string("| 8 QUIT                |".snl)
   print string("-------------------------".snl)
%end

%routine show control codes
   push frame
   set frame(1,23,35,45)
   clear frame
   newline
   print string("CONTROL CODES".snl)
   print string("alpha red        = 1   alpha green      = 2".snl)
   print string("alpha yellow     = 3   alpha blue       = 4".snl)
   print string("alpha magenta    = 5   alpha cyan       = 6".snl)
   print string("alpha white      = 7   normal height    = 12".snl)
   print string("double height    = 13  graphic red      = 17".snl)
   print string("graphic green    = 18  graphic yellow   = 19".snl)
   print string("graphic blue     = 20  graphic magenta  = 21".snl)
   print string("graphic cyan     = 22  graphic white    = 23".snl)
   print string("contig graphics  = 25  sep graphics     = 26".snl)
   print string("black background = 28  new background   = 29".snl)
   print string("hold graphics    = 30  release graphics = 31".snl)
   pop frame
%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.

   %result=(page&16_FFF) ! (channel&16_0F)<<12
%end

%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

%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)))
   %else
      printline("Page not present")
   %finish
%end

%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
      


%routine do design
%switch mb(1:8)
%string(255) line
%label round again
%integer finished = FALSE
%integer control,i,j, channel
   %cycle
      show menu
      push frame
      set frame(15,10,0,80)
      clear frame

      -> mb(get m position)

mb(1) :  
         newline
         printstring("Please type in text to fit in -");
         read line(line)
         insert text(char x, char y, line) %if length(line) > 0
         -> round again

mb(2) :  
         show control codes
         newline
         print string("Please type in the control code id -")
         newline
         read line(line)
         control=str to int(line)
         insert control(char x, char y, control)
         -> round again

mb(3) :  
         newline
         print string("SAVE file name:")
         newline
         read line(line)
         save file(line)
         -> round again

mb(4) :  
         newline
         print string("LOAD file name:")
         newline
         read line(line)
         %if line#"" %start
            load file(line,page)
            show screen(addr(page(0,0)))
         %finish
         -> round again

mb(5) :  
         newline
         prompt("SAVE page id:"); read(control)
         prompt("Comment line:"); read line(line)
         line = current user." <-> ".line
         save to db(control, line)
         -> round again

mb(6) :  
         newline
!!         show comments
         prompt("LOAD channel:"); read(channel)
         prompt("LOAD page id:"); read(control)
         load from db(channel, control)
         -> round again

mb(7) :  %for i=0,1,23 %cycle
            page(i,j) = ' ' %for j=0,1,39
         %repeat
         show screen(addr(page(0,0)))
         -> round again
mb(8 ) :  
         print string("goodbye")
         newline
         finished = TRUE
         -> round again

round again :
   clear frame
   pop frame
   %repeatuntil finished = TRUE
%end
                        
   set video mode(specialpad)            { To initialise the TERMLIB stuff
   clear frame
   newline
   setup designer
   show screen(addr(page(0,0)))
   do design
   pop frame
   clear frame
newline
%end
%endofprogram