File: ex2.pp

package info (click to toggle)
fpc 2.4.0-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 179,708 kB
  • ctags: 311,888
  • sloc: pascal: 1,780,013; makefile: 856,684; xml: 126,079; ansic: 9,172; perl: 7,711; asm: 7,655; yacc: 3,721; lex: 2,539; sh: 2,032; php: 451; sql: 246; sed: 132; cpp: 79; csh: 34; tcl: 7
file content (48 lines) | stat: -rw-r--r-- 1,105 bytes parent folder | download | duplicates (13)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
program example2;

uses video,keyboard;

Var
  P,PP,D : Integer;
  K: TKeyEvent;

  Procedure PutSquare (P : INteger; C : Char);

  begin
    VideoBuf^[P]:=Ord(C)+($07 shl 8);
    VideoBuf^[P+ScreenWidth]:=Ord(c)+($07 shl 8);
    VideoBuf^[P+1]:=Ord(c)+($07 shl 8);
    VideoBuf^[P+ScreenWidth+1]:=Ord(c)+($07 shl 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.