← DL-Pascal collectioncov07.pas
DOWNLOAD ORIGINAL FILE
{ DL-Pascal Coverage Section 7: CRT Unit }
{ Exercises Write/WriteLn formatting, GotoXY, }
{ WhereX/Y, Window, WindMin/Max, ClrScr, ClrEol, }
{ DelLine, InsLine, Cursor, KeyPressed, ReadKey, }
{ NextKey, Sound, TimerStart/Out, Plot, Line, Point, }
{ Display, TextDisplay, UpdateRegion. }
{ NOTE: interactive tests (Read/ReadKey) are skipped }
{ to allow unattended profiling run. }
{ Expected: runs without error, displays results. }
{$D-C-R-}
PROGRAM Section7;
USES
crt;
VAR
i, j : Integer;
x, y : Byte;
w : Word;
b : Boolean;
c : Char;
s : STRING[40];
log : Text;
PROCEDURE Check(msg : STRING; passed : Boolean);
BEGIN
IF passed THEN
WriteLn(log,'OK ', msg)
ELSE
WriteLn(log,'FAIL ', msg);
END;
{ ---- Write / WriteLn formatting ---- }
PROCEDURE TestWrite;
BEGIN
{ Basic WriteLn }
WriteLn(log,'TestWrite start');
{ Write without newline then WriteLn }
Write(log,'ABC'); Write(log,'DEF'); WriteLn(log);
WriteLn(log,' above should be ABCDEF');
{ Integer formats }
WriteLn(log,'Dec: ', 42);
WriteLn(log,'Neg: ', -7);
WriteLn(log,'Wid: ', 42:6); { right-justified width 6 }
WriteLn(log,'Zero:', 0:4);
{ Real formats }
WriteLn(log,'Real: ', 3.14159:8:4); { width 8, 4 decimal places }
WriteLn(log,'Real: ', -2.5:7:2);
WriteLn(log,'Sci: ', 12345.678:12:3);
{ String formats }
WriteLn(log,'Str: ', 'Hello':10); { right-justified }
WriteLn(log,'Str: ', 'Hi');
{ Char }
WriteLn(log,'Char: ', 'A');
WriteLn(log,'Char: ', Chr(66)); { 'B' }
{ Boolean }
WriteLn(log,'Bool: ', True);
WriteLn(log,'Bool: ', False);
{ Multiple items on one line }
WriteLn(log,'x=', 3, ' y=', 4, ' sum=', 3+4);
WriteLn(log,'TestWrite done');
END;
{ ---- GotoXY and WhereX/Y ---- }
PROCEDURE TestGotoXY;
BEGIN
ClrScr;
{ Go to known position and check }
GotoXY(1, 1);
x := WhereX; y := WhereY;
Check('GotoXY 1,1 X', x = 1);
Check('GotoXY 1,1 Y', y = 1);
GotoXY(5, 2);
x := WhereX; y := WhereY;
Check('GotoXY 5,2 X', x = 5);
Check('GotoXY 5,2 Y', y = 2);
GotoXY(1, 1);
Write(log,'A'); { cursor moves to col 2 }
x := WhereX;
Check('WhereX after write', x = 2);
{ GotoXY out of range â should be ignored }
GotoXY(5, 2);
GotoXY(0, 0); { invalid â no change }
x := WhereX; y := WhereY;
Check('GotoXY invalid X', x = 5);
Check('GotoXY invalid Y', y = 2);
ClrScr;
GotoXY(1, 1);
END;
{ ---- Window and WindMin/Max ---- }
PROCEDURE TestWindow;
VAR wx1, wy1, wx2, wy2 : Byte;
BEGIN
{ Full screen window }
Window(1, 1, 32, 4);
wx1 := WindMinX; wy1 := WindMinY;
wx2 := WindMaxX; wy2 := WindMaxY;
Check('Full win MinX', wx1 = 1);
Check('Full win MinY', wy1 = 1);
Check('Full win MaxX', wx2 = 32);
Check('Full win MaxY', wy2 = 4);
{ Sub-window }
Window(5, 2, 20, 3);
wx1 := WindMinX; wy1 := WindMinY;
wx2 := WindMaxX; wy2 := WindMaxY;
Check('Sub win MinX', wx1 = 5);
Check('Sub win MinY', wy1 = 2);
Check('Sub win MaxX', wx2 = 20);
Check('Sub win MaxY', wy2 = 3);
{ Cursor in sub-window starts at 1,1 }
GotoXY(1, 1);
x := WhereX; y := WhereY;
Check('Win cursor X', x = 1);
Check('Win cursor Y', y = 1);
{ Restore full window }
Window(1, 1, 32, 4);
ClrScr;
GotoXY(1, 1);
END;
{ ---- ClrScr / ClrEol ---- }
PROCEDURE TestClr;
BEGIN
ClrScr;
GotoXY(1, 1);
WriteLn(log,'Line one');
WriteLn(log,'Line two');
Write(log,'Line thr');
{ ClrEol clears from cursor to end of line }
GotoXY(5, 3);
ClrEol;
{ After ClrEol cursor should stay at same position }
x := WhereX; y := WhereY;
Check('ClrEol X', x = 5);
Check('ClrEol Y', y = 3);
ClrScr;
{ After ClrScr cursor at 1,1 }
x := WhereX; y := WhereY;
Check('ClrScr X', x = 1);
Check('ClrScr Y', y = 1);
GotoXY(1, 1);
END;
{ ---- DelLine / InsLine ---- }
PROCEDURE TestDelInsLine;
BEGIN
ClrScr;
GotoXY(1, 1); WriteLn(log,'Row 1');
GotoXY(1, 2); WriteLn(log,'Row 2');
GotoXY(1, 3); WriteLn(log,'Row 3');
GotoXY(1, 4); Write(log,'Row 4');
{ Delete line 1 â rows 2,3,4 move up }
GotoXY(1, 1);
DelLine;
x := WhereX; y := WhereY;
Check('DelLine Y', y = 1);
{ InsLine insert blank line at cursor, rows below move down }
GotoXY(1, 2);
InsLine;
x := WhereX; y := WhereY;
Check('InsLine Y', y = 2);
ClrScr;
GotoXY(1, 1);
END;
{ ---- Cursor ---- }
PROCEDURE TestCursor;
BEGIN
{ Turn cursor off }
Cursor(False);
{ Write while cursor off should work normally }
GotoXY(1, 1);
Write(log,'Cursor off test ');
{ Turn cursor back on }
Cursor(True);
Write(log,'Cursor on ');
WriteLn(log);
Check('Cursor on/off', True); { just exercises the code path }
Cursor(False); { turn off for rest of tests }
END;
{ ---- Sound ---- }
PROCEDURE TestSound;
BEGIN
{ Play a few tones â exercises sound ROM routines }
Sound(440, 50); { A4 }
Sound(523, 50); { C5 }
Sound(659, 50); { E5 }
Sound(880, 50); { A5 }
Check('Sound A4', True);
Check('Sound C5', True);
Check('Sound E5', True);
Check('Sound A5', True);
{ Very low frequency }
Sound(100, 30);
Check('Sound low', True);
{ Scale }
FOR i := 1 TO 8 DO BEGIN
Sound(200 * i, 40);
END;
Check('Sound scale', True);
END;
{ ---- TimerStart / TimerOut ---- }
PROCEDURE TestTimer;
VAR counter : Word;
BEGIN
{ Timer 0: 1 second (10 ticks at 10Hz) }
counter := 0;
TimerStart(0, 10);
WHILE NOT TimerOut(0) DO BEGIN
Inc(counter);
END;
Check('Timer0 fired', TimerOut(0));
Check('Timer0 counted', counter > 0);
{ Timer 1: very short (1 tick) }
TimerStart(1, 1);
REPEAT UNTIL TimerOut(1);
Check('Timer1 fired', True);
{ Timer 2: check it doesn't fire before started }
TimerStart(2, 100); { long timer }
b := TimerOut(2);
Check('Timer2 not yet', NOT b);
{ Two timers independent }
TimerStart(0, 2);
TimerStart(1, 5);
REPEAT UNTIL TimerOut(0);
b := TimerOut(1);
Check('Timers independent', NOT b); { timer1 still running }
REPEAT UNTIL TimerOut(1);
Check('Timer1 done', True);
END;
{ ---- KeyPressed / NextKey ---- }
PROCEDURE TestKeyboard;
BEGIN
{ No key pressed initially }
b := KeyPressed;
Check('No key initially', NOT b);
{ NextKey with no key should return 0 }
w := NextKey;
Check('NextKey empty', w = 0);
{ KeyPressed still false after NextKey peek }
Check('Still no key', NOT KeyPressed);
{ Note: ReadKey not tested unattended }
WriteLn(log,' (ReadKey/Read skipped - interactive)');
END;
{ ---- Graphics: Plot, Line, Point, Display ---- }
PROCEDURE TestGraphics;
VAR px : Byte;
BEGIN
{ Plot a pixel and read it back }
Plot(0, 0, 1); { set pixel at 0,0 }
px := Point(0, 0);
Check('Plot/Point set', px = 1);
Plot(0, 0, 0); { clear pixel }
px := Point(0, 0);
Check('Plot/Point clr', px = 0);
Plot(0, 0, 2); { invert (was 0, becomes 1) }
px := Point(0, 0);
Check('Plot invert', px = 1);
Plot(0, 0, 2); { invert again (becomes 0) }
px := Point(0, 0);
Check('Plot re-invert', px = 0);
{ Point outside display returns 0 }
px := Point(-1, 0);
Check('Point outside', px = 0);
{ Draw a line }
Line(0, 0, 10, 0, 1); { horizontal line }
px := Point(5, 0);
Check('Line pixel mid', px = 1);
px := Point(0, 0);
Check('Line pixel start',px = 1);
px := Point(10, 0);
Check('Line pixel end', px = 1);
{ Clear with col=0 }
Line(0, 0, 10, 0, 0);
px := Point(5, 0);
Check('Line cleared', px = 0);
{ UpdateRegion and Display }
Plot(15, 15, 1);
UpdateRegion(0, 0, 191, 63);
Display;
Check('Display done', True);
{ TextDisplay â converts text buffer to graphics }
GotoXY(1, 1);
ClrScr;
Write(log,'Graphics!');
TextDisplay;
Check('TextDisplay done',True);
{ Clean up }
Line(0, 0, 191, 63, 0);
Display;
ClrScr;
GotoXY(1, 1);
END;
{ ---- Write format edge cases ---- }
PROCEDURE TestWriteFormats;
BEGIN
{ Max integer }
WriteLn(log,'MaxInt: ', 32767);
WriteLn(log,'MinInt: ', -32768);
{ Zero padding via Str }
Str(7:4, s);
Check('Str width', Length(s) = 4);
{ Real edge cases }
WriteLn(log,'Zero real: ', 0.0:8:4);
WriteLn(log,'Small: ', 0.001:10:6);
WriteLn(log,'Large: ', 99999.9:10:1);
{ Negative real display }
WriteLn(log,'NegReal: ', -3.14:8:4);
{ Write Char vs String }
Write(log,'C'); Write(log,'h'); Write(log,'a'); Write(log,'r'); WriteLn(log);
WriteLn(log,' above: Char');
END;
{ ---- Main ---- }
BEGIN
Assign(log, '0:cov07.log');
Rewrite(log);
WriteLn(log,'=== Section 7: CRT Unit ===');
WriteLn(log);
WriteLn(log,'-- Write/WriteLn --');
TestWrite; WriteLn(log);
WriteLn(log,'-- GotoXY/WhereXY --');
TestGotoXY; WriteLn(log);
WriteLn(log,'-- Window --');
TestWindow; WriteLn(log);
WriteLn(log,'-- ClrScr/ClrEol --');
TestClr; WriteLn(log);
WriteLn(log,'-- DelLine/InsLine --');
TestDelInsLine; WriteLn(log);
WriteLn(log,'-- Cursor --');
TestCursor; WriteLn(log);
WriteLn(log,'-- Sound --');
TestSound; WriteLn(log);
WriteLn(log,'-- Timer --');
TestTimer; WriteLn(log);
WriteLn(log,'-- Keyboard --');
TestKeyboard; WriteLn(log);
WriteLn(log,'-- Graphics --');
TestGraphics; WriteLn(log);
WriteLn(log,'-- Write Formats --');
TestWriteFormats; WriteLn(log);
WriteLn(log,'=== Section 7 complete ===');
Close(log);
END.