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 }