mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-01 18:26:09 +02:00
48 lines
1.1 KiB
ObjectPascal
48 lines
1.1 KiB
ObjectPascal
program example2;
|
|
|
|
uses video,keyboard;
|
|
|
|
Var
|
|
P,PP,D : Integer;
|
|
K: TKeyEvent;
|
|
|
|
Procedure PutSquare (P : INteger; C : Char);
|
|
|
|
begin
|
|
VideoBuf^[P]:=Ord(C)+($07 shr 8);
|
|
VideoBuf^[P+ScreenWidth]:=Ord(c)+($07 shr 8);
|
|
VideoBuf^[P+1]:=Ord(c)+($07 shr 8);
|
|
VideoBuf^[P+ScreenWidth+1]:=Ord(c)+($07 shr 8);
|
|
end;
|
|
|
|
begin
|
|
InitVideo;
|
|
InitKeyBoard;
|
|
P:=0;
|
|
PP:=-1;
|
|
Repeat
|
|
If PP<>-1 then
|
|
PutSquare(PP,' ');
|
|
PutSquare(P,'#');
|
|
SetCursorPos(P Mod ScreenWidth,P div ScreenWidth);
|
|
UpdateScreen(False);
|
|
PP:=P;
|
|
Repeat
|
|
D:=0;
|
|
K:=TranslateKeyEvent(GetKeyEvent);
|
|
Case GetKeyEventCode(K) of
|
|
kbdLeft : If (P Mod ScreenWidth)<>0 then
|
|
D:=-1;
|
|
kbdUp : If P>=ScreenWidth then
|
|
D:=-ScreenWidth;
|
|
kbdRight : If ((P+2) Mod ScreenWidth)<>0 then
|
|
D:=1;
|
|
kbdDown : if (P<(VideoBufSize div 2)-(ScreenWidth*2)) then
|
|
D:=ScreenWidth;
|
|
end;
|
|
Until (D<>0) or (GetKeyEventChar(K)='q');
|
|
P:=P+D;
|
|
until GetKeyEventChar(K)='q';
|
|
DoneKeyBoard;
|
|
DoneVideo;
|
|
end. |