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.
|
