PROGRAM window_dressing;
                 { demonstration of screen addressing and window scrolling }
CONST
  up = TRUE;
  down = FALSE;  { refer to movement of text NOT apparent movement of window }

TYPE
  frame = RECORD
            toprow,bottomrow,leftcol,rightcol: INTEGER  END;

VAR
  code: ARRAY[1..66] OF CHAR;
  movecode: ARRAY[1..52] OF CHAR;
  upcode,downcode: ARRAY[1..14] OF CHAR;
  picture: frame;
  i,j: INTEGER;
  screen_start: ^INTEGER;
  chars_per_row: ^CHAR;



PROCEDURE load_code;
    { sets up machine code in ARRAYs movecode, upcode & downcode }

BEGIN  { PROCEDURE load_code }
                                { get parameters into correct registers }
  movecode[1] := CHR(043H);            { LD   B,E        last address }
  movecode[2] := CHR(04AH);            { LD   C,D        note byte switch }
  movecode[3] := CHR(05FH);            { LD   E,A        length of line }
  movecode[4] := CHR(016H);
  movecode[5] := CHR(0);               { LD   D,0 }
  movecode[6] := CHR(0E5H);            { PUSH HL         keep  for write }
  movecode[7] := CHR(0D5H);            { PUSH DE  }
  movecode[8] := CHR(0C5H);            { PUSH BC  }
                                { read line into buffer backwards }
  movecode[9] := CHR(03EH);     { rloop:      }
  movecode[10] := CHR(0FFH);           { LD   A,0FFH     address stop }
  movecode[11] := CHR(0EDH);    { read:       }
  movecode[12] := CHR(0A2H);           { INI             get char. }
  movecode[13] := CHR(01DH);           { DEC  E }
  movecode[14] := CHR(028H);
  movecode[15] := CHR(020H);           { JR   Z,dest     ? end of line }
  movecode[16] := CHR(0B8H);           { CP   B          stop at B=0FFH }
  movecode[17] := CHR(020H);
  movecode[18] := CHR(0F8H);           { JR   NZ,read    next char }
  movecode[19] := CHR(0DH);            { DEC  C          end of page }
  movecode[20] := CHR(079H);           { LD   A,C        next port }
  movecode[21] := CHR(0FEH);
  movecode[22] := CHR(040H);           { CP   40H        ? hit start of VRAM }
  movecode[23] := CHR(030H);
  movecode[24] := CHR(0F0H);           { JR   NC,rloop }
  movecode[25] := CHR(0EH);
  movecode[26] := CHR(047H);           { LD   C,47H      go to end of VRAM }
  movecode[27] := CHR(018H);
  movecode[28] := CHR(0ECH);           { JR   rloop }
                                { write out from buffer backwards }
  movecode[29] := CHR(0D1H);    { load:  POP  DE         get parameters back }
  movecode[30] := CHR(0E1H);           { POP  HL }
  movecode[31] := CHR(04H);            { INC  B          !!!!! but essential }
  movecode[32] := CHR(0EDH);    { write:         }
  movecode[33] := CHR(0A3H);           { OUTI            write char. }
  movecode[34] := CHR(020H);
  movecode[35] := CHR(08H);            { JR   NZ,wloop   stop at B=0 }
  movecode[36] := CHR(0DH);            { DEC  C          new port }
  movecode[37] := CHR(079H);           { LD   A,C }
  movecode[38] := CHR(0FEH);
  movecode[39] := CHR(040H);           { CP   40H        ? start of VRAM   }
  movecode[40] := CHR(030H);
  movecode[41] := CHR(02H);            { JR   NC,wloop }
  movecode[42] := CHR(0EH);
  movecode[43] := CHR(047H);           { LD   C,47H      go to end of VRAM }
  movecode[44] := CHR(01DH);    { wloop: DEC  E }
  movecode[45] := CHR(020H);
  movecode[46] := CHR(0F1H);           { JR   NZ,write   ? any chars left }
  movecode[47] := CHR(0C9H);           { RET             all written }
                                { set up address for writing }
  movecode[48] := CHR(021H);    { dest:       }
  movecode[49] := CHR(04FH);
  movecode[50] := CHR(0FBH);           { LD   HL,0FB4FH  chars_per_row addr. }
  movecode[51] := CHR(0C1H);           { POP  BC }
  movecode[52] := CHR(078H);           { LD   A,B        source line addr. }

                    { subtract chars_per_row from address of source line end }
  upcode[1] := CHR(096H);              { SUB  (HL)       addr. for next line }
  upcode[2] := CHR(047H);              { LD   B,A        replace addr. }
  upcode[3] := CHR(030H);
  upcode[4] := CHR(0E4H);              { JR   NC,load    use same port }
  upcode[5] := CHR(0DH);               { DEC  C          next  port }
  upcode[6] := CHR(079H);              { LD   A,C  }
  upcode[7] := CHR(0FEH);
  upcode[8] := CHR(040H);              { CP   40H        ? start of VRAM }
  upcode[9] := CHR(030H);
  upcode[10] := CHR(0DEH);             { JR   NC,load }
  upcode[11] := CHR(0EH);
  upcode[12] := CHR(047H);             { LD   C,47H      go to end of VRAM }
  upcode[13] := CHR(018H);
  upcode[14] := CHR(0DAH);             { JR   load }

                           { add chars_per_row to address of source line end }
  downcode[1] := CHR(086H);            { ADD  (HL)       addr. for next line }
  downcode[2] := CHR(047H);            { LD   B,A        replace addr. }
  downcode[3] := CHR(030H);
  downcode[4] := CHR(0E4H);            { JR   NC,load    use same port }
  downcode[5] := CHR(0CH);             { INC  C          next port }
  downcode[6] := CHR(079H);            { LD   A,C  }
  downcode[7] := CHR(0FEH);
  downcode[8] := CHR(048H);            { CP   48H        ? end of VRAM }
  downcode[9] := CHR(038H);
  downcode[10] := CHR(0DEH);           { JR   C,load }
  downcode[11] := CHR(0EH);
  downcode[12] := CHR(040H);           { LD   C,40H      go to start of VRAM }
  downcode[13] := CHR(018H);
  downcode[14] := CHR(0DAH);           { JR   load  }
  END;  { PROCEDURE load_code }



PROCEDURE  time;
    { WARNING  -  if de or hl parameters are altered, and any character after
         the first has a zero last digit in the hex. address, a start of VRAM
         check is needed (as in moveline).  Use 5 separate blocks of menu for
         simplicity }

VAR
  reg16,reg_dump: RECORD
           af,bc,de,hl: INTEGER  END;
  timecode: ARRAY[1..6] OF CHAR;

BEGIN
  timecode := 'm+] {I';      { some compilers accept code in this form }
  timecode[1] := CHR(0EDH);  { write code to reserved ARRAY }
  timecode[2] := CHR(0ABH);            { OUTD            write backwards }
  timecode[3] := CHR(01DH);            { DEC  E          adjust char count }
  timecode[4] := CHR(020H);
  timecode[5] := CHR(0FBH);            { JR   NZ,start   ? end of string }
  timecode[6] := CHR(0C9H);            { RET             finished }
  WITH reg16 DO BEGIN        { initialise registers }
        { screen offset = 24 * 80 + 79 = 1999 = 7CFH }
    bc := screen_start^ + 07CFH;     { locate end of menu line }
    IF bc>=0800H THEN bc := bc - 0800H;   { VRAM offset }
    bc := bc + 4000H;                { last menu address }
    bc := (bc MOD 256)*256 + bc DIV 256;  { inefficient byte switch }
    bc := bc + 256;                  { yes, it does write to the next byte }
                                     { no, you can't add before the switch }
    de := 6;                         { time string length }
    hl := 0FB91H                     { time string end }
    END;  { WITH reg16 }
  CALL (ADDR (timecode),reg16,reg_dump)  { returned values not required }
  END;  { PROCEDURE time }



PROCEDURE  moveline( row: INTEGER; window: frame );
   { sets up parameters for machine code in STRING code and calls code }
   { row specifies screen row containing line in window to be copied }
   { code copies line in window to next line up or down }

VAR
  buffer: ARRAY[1..80] OF CHAR;
  register: RECORD CASE INTEGER OF
              1: ( f,a,c,b,e,d,l,h: CHAR );
              2: ( af,bc,de,hl: INTEGER )  END;

BEGIN  { PROCEDURE moveline }
  WITH register DO BEGIN
    WITH window DO BEGIN
      a := CHR (rightcol-leftcol+1);                { no. of chars }
      de := (row*ORD (chars_per_row^)) + rightcol;  { screen offset }
      de := de + screen_start^                      { VRAM offset }
      END;  { WITH window }
    IF de>=0800H THEN de := de - 0800H;
    de := de + 4000H;                        { initial address }
    hl := ADDR (buffer)  END;  { WITH register }
  CALL (ADDR (code),register,register)       { enter machine code }
  END;  { PROCEDURE moveline }



PROCEDURE  scroll_window( window: frame; up: BOOLEAN );
    { sets up lines to be moved and calls PROCEDURE moveline }

VAR
  i: INTEGER;

BEGIN  { PROCEDURE scroll_window }
  WITH window DO
    IF up THEN  BEGIN
      code := movecode + upcode;
      FOR i := toprow+1 TO bottomrow DO
        moveline (i,window)  END { IF up }
     ELSE BEGIN     { move down }
      code := movecode + downcode;
      FOR i := bottomrow-1 DOWNTO toprow DO
        moveline (i,window)  END { ELSE down }
  END;  { PROCEDURE scroll_window }



BEGIN  { PROGRAM window_dressing }
  MAP (screen_start,0FB4CH);
  MAP (chars_per_row,0FB4FH);
  FOR i := 1 TO 24 DO BEGIN
    WRITELN;
    FOR j := 1 TO 18 DO BEGIN             { fill screen }
      WRITE (CHR (ORD ('@')+i),':');
      WRITE (CHR (ORD ('@')+i),'.')  END  { FOR j }
    END;  { FOR i }
  WITH picture DO BEGIN        { example parameters }
    toprow := 5;
    bottomrow := 15;
    leftcol := 40;
    rightcol := 65;
    load_code;
    time;
    scroll_window (picture,down);
    WRITE (CHR (29),CHR (leftcol),CHR (toprow));    { move cursor }
    FOR j := leftcol TO rightcol DO
      WRITE ('c');
    scroll_window (picture,down);
    WRITE (CHR (29),CHR (leftcol),CHR (toprow));
    FOR j := leftcol TO rightcol DO
      WRITE ('d');
    scroll_window (picture,up);
    WRITE (CHR (29),CHR (leftcol),CHR (bottomrow));
    FOR j := leftcol to rightcol DO
      WRITE ('e')  END;  { WITH picture }
  WRITE (CHR (30));      { home cursor }
  time
  END.  { PROGRAM window_dressing }

