← DL-Pascal collectioncov11.pas
DOWNLOAD ORIGINAL FILE
{ DL-Pascal Coverage Section 11: CRT Deep Cover }
{ Direct buffer access, graphics, timers, sound, }
{ windows, cursor, text display modes. }
{ Maximizes ROM code path coverage for CRT unit. }
{ Casio PB-2000C / DL-Pascal 1.2 }
{$D-C-R-}
PROGRAM Section11;
USES Crt;
TYPE
TTextBuf = ARRAY[0..3, 0..31, 0..1] OF Char;
TGfxBuf = ARRAY[0..767] OF Byte;
VAR
tbuf : TTextBuf ABSOLUTE $0100;
gbuf : TGfxBuf ABSOLUTE $0200;
i, j : Integer;
b : Boolean;
c : Char;
w : Word;
log : Text;
PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
IF passed THEN WriteLn(log,'OK ', msg)
ELSE WriteLn(log,'FAIL ', msg);
END;
PROCEDURE ClearGfx;
BEGIN
FOR i := 0 TO 767 DO gbuf[i] := 0;
UpdateRegion(0, 0, 191, 31);
Display;
END;
PROCEDURE Pause(ticks : Word);
BEGIN
TimerStart(0, ticks);
REPEAT UNTIL TimerOut(0);
END;
{ ---- Text buffer direct access ---- }
PROCEDURE TestTextBuf;
VAR r, col : Byte;
BEGIN
WriteLn(log,'-- Text Buffer --');
FOR r := 0 TO 3 DO
FOR col := 0 TO 31 DO BEGIN
tbuf[r, col, 0] := Char(Ord('A') + (r * 8 + col) MOD 26);
tbuf[r, col, 1] := Char(128);
END;
TextDisplay; Pause(15);
Check('TBuf char', tbuf[0, 0, 0] = 'A');
Check('TBuf attr', tbuf[0, 0, 1] = Char(128));
FOR col := 0 TO 31 DO tbuf[0, col, 1] := Char(132); { reverse }
TextDisplay; Pause(10);
FOR col := 0 TO 31 DO tbuf[1, col, 1] := Char(130); { dim }
TextDisplay; Pause(10);
FOR col := 0 TO 31 DO tbuf[2, col, 1] := Char(128); { normal }
TextDisplay; Pause(10);
Check('TBuf attrs', True);
ClrScr;
END;
{ ---- Graphics buffer direct access ---- }
PROCEDURE TestGfxBuf;
BEGIN
WriteLn(log,'-- Gfx Buffer --');
FOR i := 0 TO 767 DO
IF (i AND 1) = 0 THEN gbuf[i] := $55 ELSE gbuf[i] := Byte($AA);
UpdateRegion(0, 0, 191, 31); Display; Pause(15);
Check('GfxBuf even', gbuf[0] = $55);
Check('GfxBuf odd', gbuf[1] = Byte($AA));
FOR i := 0 TO 767 DO
IF (i DIV 24) AND 1 = 0 THEN gbuf[i] := $FF ELSE gbuf[i] := 0;
UpdateRegion(0, 0, 191, 31); Display; Pause(15);
Check('GfxBuf stripes', True);
FOR i := 0 TO 767 DO gbuf[i] := $F0;
UpdateRegion(0, 0, 191, 31); Display; Pause(10);
Check('GfxBuf nibble', gbuf[0] = Byte($F0));
ClearGfx;
END;
{ ---- Plot and Point ---- }
PROCEDURE TestPlotPoint;
BEGIN
WriteLn(log,'-- Plot/Point --');
Plot(0, 0, 1); Check('Plot 0,0', Point(0, 0) = 1);
Plot(191, 0, 1); Check('Plot 191,0', Point(191, 0) = 1);
Plot(0, 31, 1); Check('Plot 0,31', Point(0, 31) = 1);
Plot(191, 31, 1); Check('Plot 191,31', Point(191, 31) = 1);
Plot(96, 15, 1); Check('Plot centre', Point(96, 15) = 1);
Plot(0, 0, 0); Check('Plot clr', Point(0, 0) = 0);
Plot(10, 10, 0);
Plot(10, 10, 2); Check('Plot inv set', Point(10, 10) = 1);
Plot(10, 10, 2); Check('Plot inv clr', Point(10, 10) = 0);
Plot(-1, 0, 1); Plot(192, 0, 1);
Check('Plot OOB', True);
UpdateRegion(0, 0, 191, 31); Display; Pause(10);
ClearGfx;
END;
{ ---- Line drawing ---- }
PROCEDURE TestLine;
BEGIN
WriteLn(log,'-- Line --');
Line(0, 0, 191, 0, 1);
Check('Line horiz', Point(0, 0) = 1);
Check('Line horiz mid', Point(96, 0) = 1);
Check('Line horiz end', Point(191, 0) = 1);
UpdateRegion(0, 0, 191, 31); Display; Pause(8);
Line(0, 0, 0, 31, 1);
Check('Line vert', Point(0, 15) = 1);
UpdateRegion(0, 0, 191, 31); Display; Pause(8);
Line(0, 0, 191, 31, 1);
Check('Line diag', Point(96, 15) = 1);
UpdateRegion(0, 0, 191, 31); Display; Pause(8);
Line(191, 0, 0, 31, 1);
Check('Line diag2', True);
UpdateRegion(0, 0, 191, 31); Display; Pause(8);
Line(0, 0, 191, 31, 0);
Check('Line clr', Point(0, 0) = 0);
UpdateRegion(0, 0, 191, 31); Display; Pause(8);
ClearGfx;
END;
{ ---- UpdateRegion variations ---- }
PROCEDURE TestUpdateRegion;
BEGIN
WriteLn(log,'-- UpdateRegion --');
FOR i := 0 TO 767 DO gbuf[i] := $FF;
UpdateRegion(0, 0, 95, 15); Display; Pause(8);
Check('UReg quadrant 1', True);
UpdateRegion(96, 0, 191, 15); Display; Pause(8);
Check('UReg quadrant 2', True);
UpdateRegion(0, 16, 95, 31); Display; Pause(8);
Check('UReg quadrant 3', True);
UpdateRegion(96, 16, 191, 31); Display; Pause(8);
Check('UReg quadrant 4', True);
UpdateRegion(0, 0, 191, 31); Display; Pause(8);
Check('UReg full', True);
ClearGfx;
END;
{ ---- TextDisplay ---- }
PROCEDURE TestTextDisplay;
BEGIN
WriteLn(log,'-- TextDisplay --');
ClrScr;
GotoXY(1, 1); Write('TextDisplay test');
GotoXY(1, 2); Write('Line 2 content');
GotoXY(1, 3); Write('Line 3 here');
GotoXY(1, 4); Write('Line 4 bottom');
TextDisplay;
Pause(20);
Check('TextDisplay', True);
ClrScr;
END;
{ ---- GotoXY / WhereX / WhereY ---- }
PROCEDURE TestGotoXY;
BEGIN
WriteLn(log,'-- GotoXY --');
GotoXY(1, 1); Check('GotoXY 1,1 X', WhereX = 1);
GotoXY(1, 1); Check('GotoXY 1,1 Y', WhereY = 1);
GotoXY(16, 2); Check('GotoXY 16,2 X', WhereX = 16);
GotoXY(16, 2); Check('GotoXY 16,2 Y', WhereY = 2);
GotoXY(32, 4); Check('GotoXY 32,4 X', WhereX = 32);
GotoXY(32, 4); Check('GotoXY 32,4 Y', WhereY = 4);
Write('X');
Check('After write X', WhereX = 2);
GotoXY(1, 1);
END;
{ ---- Window ---- }
PROCEDURE TestWindow;
BEGIN
WriteLn(log,'-- Window --');
Window(1, 1, 32, 4);
Check('Full win MinX', WindMinX = 1);
Check('Full win MaxX', WindMaxX = 32);
Check('Full win MinY', WindMinY = 1);
Check('Full win MaxY', WindMaxY = 4);
Window(5, 2, 20, 3);
Check('Sub win MinX', WindMinX = 5);
Check('Sub win MaxX', WindMaxX = 20);
Check('Sub win MinY', WindMinY = 2);
Check('Sub win MaxY', WindMaxY = 3);
ClrScr;
GotoXY(1, 1);
Check('Win ClrScr X', WhereX = 1);
Check('Win ClrScr Y', WhereY = 1);
Window(1, 1, 32, 4);
END;
{ ---- ClrScr / ClrEol ---- }
PROCEDURE TestClr;
BEGIN
WriteLn(log,'-- ClrScr/ClrEol --');
GotoXY(1, 1); Write('Hello World');
GotoXY(6, 1); ClrEol;
Check('ClrEol X', WhereX = 6);
Check('ClrEol Y', WhereY = 1);
ClrScr;
Check('ClrScr X', WhereX = 1);
Check('ClrScr Y', WhereY = 1);
END;
{ ---- DelLine / InsLine ---- }
PROCEDURE TestDelIns;
BEGIN
WriteLn(log,'-- DelLine/InsLine --');
ClrScr;
GotoXY(1,1); Write('Row 1');
GotoXY(1,2); Write('Row 2');
GotoXY(1,3); Write('Row 3');
GotoXY(1,1); DelLine;
Check('DelLine pos Y', WhereY = 1);
GotoXY(1,2); InsLine;
Check('InsLine pos Y', WhereY = 2);
ClrScr;
END;
{ ---- Cursor ---- }
PROCEDURE TestCursor;
BEGIN
WriteLn(log,'-- Cursor --');
Cursor(False); Pause(5);
GotoXY(1,1); Write('Cursor off');
Pause(10);
Cursor(True); Pause(5);
Write(' on');
Check('Cursor toggle', True);
Cursor(False);
END;
{ ---- Sound ---- }
PROCEDURE TestSound;
BEGIN
WriteLn(log,'-- Sound --');
Sound(440, 30); Check('Sound 440Hz', True);
Sound(880, 30); Check('Sound 880Hz', True);
Sound(1760, 30); Check('Sound 1760Hz', True);
Sound(220, 30); Check('Sound 220Hz', True);
Sound(110, 20); Check('Sound 110Hz', True);
Sound(4000, 20); Check('Sound 4kHz', True);
{ Musical scale }
Sound(262, 20); { C4 }
Sound(294, 20); { D4 }
Sound(330, 20); { E4 }
Sound(349, 20); { F4 }
Sound(392, 20); { G4 }
Sound(440, 20); { A4 }
Sound(494, 20); { B4 }
Sound(523, 30); { C5 }
Check('Sound scale', True);
END;
{ ---- Timers ---- }
PROCEDURE TestTimers;
VAR cnt : Word;
BEGIN
WriteLn(log,'-- Timers --');
{ Timer 0 }
cnt := 0;
TimerStart(0, 8);
WHILE NOT TimerOut(0) DO Inc(cnt);
Check('Timer0 fired', TimerOut(0));
Check('Timer0 counted', cnt > 0);
{ Timer 1 }
TimerStart(1, 3);
REPEAT UNTIL TimerOut(1);
Check('Timer1 fired', True);
{ Timer 2 }
TimerStart(2, 50);
Check('Timer2 not yet', NOT TimerOut(2));
REPEAT UNTIL TimerOut(2);
Check('Timer2 done', True);
{ Two timers independent }
TimerStart(0, 3);
TimerStart(1, 20);
REPEAT UNTIL TimerOut(0);
Check('Timers indep', NOT TimerOut(1));
REPEAT UNTIL TimerOut(1);
Check('Timer1 later', True);
{ Short timer }
TimerStart(0, 1);
REPEAT UNTIL TimerOut(0);
Check('Timer min', True);
END;
{ ---- Keyboard ---- }
PROCEDURE TestKeyboard;
BEGIN
WriteLn(log,'-- Keyboard --');
Check('No key init', NOT KeyPressed);
w := NextKey;
Check('NextKey empty', w = 0);
Check('Still no key', NOT KeyPressed);
WriteLn(log,' (ReadKey skipped - interactive)');
END;
{ ---- Graphics patterns ---- }
PROCEDURE TestGfxPatterns;
BEGIN
WriteLn(log,'-- Gfx Patterns --');
{ Concentric rectangles }
ClearGfx;
Line(0, 0, 191, 0, 1);
Line(0, 31, 191, 31, 1);
Line(0, 0, 0, 31, 1);
Line(191, 0, 191, 31, 1);
Line(20, 4, 171, 4, 1);
Line(20, 27, 171, 27, 1);
Line(20, 4, 20, 27, 1);
Line(171, 4, 171, 27, 1);
UpdateRegion(0, 0, 191, 31); Display; Pause(20);
Check('Gfx rectangles', True);
{ Diagonal cross }
ClearGfx;
Line(0, 0, 191, 31, 1);
Line(0, 31, 191, 0, 1);
UpdateRegion(0, 0, 191, 31); Display; Pause(15);
Check('Gfx diag cross', True);
{ Dot grid }
ClearGfx;
FOR i := 0 TO 23 DO
FOR j := 0 TO 7 DO
Plot(i * 8, j * 4, 1);
UpdateRegion(0, 0, 191, 31); Display; Pause(15);
Check('Gfx dot grid', True);
{ Fill then clear }
FOR i := 0 TO 767 DO gbuf[i] := $FF;
UpdateRegion(0, 0, 191, 31); Display; Pause(10);
ClearGfx;
Check('Gfx fill/clear', True);
END;
{ ---- Write format coverage ---- }
PROCEDURE TestWriteFormats;
BEGIN
WriteLn(log,'-- Write Formats --');
ClrScr;
WriteLn(log,'Int: ', 32767);
WriteLn(log,'Int: ', -32768);
WriteLn(log,'Int: ', 0);
WriteLn(log,'Wid: ', 42:8);
WriteLn(log,'Real: ', 3.14159:10:5);
Pause(15); ClrScr;
WriteLn(log,'Real: ', -2.71828:10:5);
WriteLn(log,'Real: ', 0.0:8:3);
WriteLn(log,'Str: ', 'Hello':12);
WriteLn(log,'Bool: ', True);
WriteLn(log,'Bool: ', False);
Pause(15); ClrScr;
Check('Write formats', True);
END;
{ ---- Main ---- }
BEGIN
Assign(log, '0:cov11.log');
Rewrite(log);
WriteLn(log,'=== Cov11: CRT Deep Cover ===');
Pause(10);
TestTextBuf; ClrScr;
TestGfxBuf; ClrScr;
TestPlotPoint; ClrScr;
TestLine; ClrScr;
TestUpdateRegion;ClrScr;
TestTextDisplay; ClrScr;
TestGotoXY; ClrScr;
TestWindow; ClrScr;
TestClr; ClrScr;
TestDelIns; ClrScr;
TestCursor; ClrScr;
TestSound; ClrScr;
TestTimers; ClrScr;
TestKeyboard; ClrScr;
TestGfxPatterns; ClrScr;
TestWriteFormats;ClrScr;
WriteLn(log,'=== Cov11 complete ===');
Close(log);
END.