File: ex2.pp

package info (click to toggle)
fpc 2.6.4%2Bdfsg-4
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 178,760 kB
  • ctags: 83,946
  • sloc: pascal: 2,000,374; xml: 138,807; ansic: 9,617; asm: 7,843; yacc: 3,747; php: 3,271; sh: 2,626; makefile: 2,610; lex: 2,537; sql: 267; cpp: 145; sed: 132; perl: 126; 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.