File: mycrt.pas

package info (click to toggle)
el-ixir 3.0-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 104 kB
  • sloc: pascal: 112; makefile: 19
file content (130 lines) | stat: -rw-r--r-- 2,154 bytes parent folder | download
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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
unit mycrt;
interface

procedure gotoxy(x,y:integer);
procedure cursorin;
procedure cursorout;
procedure delay(ms:integer);
procedure crtwrite(txt:string);
function keypressed:boolean;
function readkey:char;
procedure waitkey;
procedure clrscr;
procedure InitCrt;
procedure DoneCrt;

var
  TextAttr:byte;
  ScreenWidth,ScreenHeight:integer;

implementation
uses termio, unix, baseunix;

var
  RealAttr:byte;

procedure gotoxy(x,y:integer);
begin
  write(#27'[',y-1,';',x-1,'f');
end;

procedure cursorout;
begin
  write(#27'[?25l')
end;

procedure cursorin;
begin
  write(#27'[?25h')
end;

procedure delay(ms:integer);
var
  tv:timeval;
begin
  tv.tv_sec:=ms div 1000;
  tv.tv_usec:=(ms mod 1000)*1000;
  fpSelect(input, @tv);
end;

procedure SetAttr;
const
  cols:array[0..7] of integer=(0,4,2,6,1,5,3,7);
begin
  if RealAttr<>TextAttr
    then begin
           RealAttr:=TextAttr;
           write(#27'[0;',(TextAttr shr 3) and 1,
               ';3',cols[TextAttr and 7],
               ';4',cols[(TextAttr shr 4) and 7],
               'm');
         end;
end;

procedure crtwrite(txt:string);
begin
  SetAttr;
  write(txt);
end;

function keypressed:boolean;
begin
  keypressed:=fpSelect(input, 0)<>0;
end;

function readkey:char;
var
  r:char;
begin
  FpRead(0, r, 1);
  readkey:=r;
end;

procedure waitkey;
begin
  fpSelect(input, $7fffffff); { ~24 days, workaround a bug in fpc }
end;

procedure clrscr;
begin
  SetAttr;
  write(#27'[2J'#27'[0;0f');
end;

var
  oldta, curta: TermIOS;
  WinInfo : TWinSize;

procedure InitCrt;
begin
  TextAttr:=7;
  RealAttr:=255;
  TCGetAttr(0, oldta);
  curta:=oldta;
  CFMakeRaw(curta);
  TCSetAttr(0, TCSANOW, curta);
  if fpIOCtl(1,TIOCGWINSZ,@Wininfo)>=0
    then begin
           ScreenWidth:=WinInfo.ws_col;
           ScreenHeight:=WinInfo.ws_row;
           if ScreenWidth<=0
             then ScreenWidth:=80;
           if ScreenHeight<=0
             then ScreenHeight:=25;
         end
    else begin
           ScreenWidth:=80;    
           ScreenHeight:=25;
         end;
end;

procedure DoneCrt;
begin
  TCSetAttr(0, TCSANOW, oldta);
end;

initialization
  InitCrt
finalization
  DoneCrt
end.