← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/unix/video.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/unix/video.pp
1
1
{
2
 
    $Id: video.pp,v 1.28 2005/02/14 17:13:31 peter Exp $
3
2
    This file is part of the Free Pascal run time library.
4
3
    Copyright (c) 1999-2000 by Florian Klaempfl
5
4
    member of the Free Pascal development team
14
13
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15
14
 
16
15
 **********************************************************************}
17
 
unit Video;
18
 
 
19
 
interface
 
16
unit video;
 
17
 
 
18
{$I-}
 
19
{$GOTO on}
 
20
 
 
21
{*****************************************************************************}
 
22
                                   interface
 
23
{*****************************************************************************}
20
24
 
21
25
{$i videoh.inc}
22
26
 
23
 
implementation
24
 
 
25
 
uses
26
 
  BaseUnix, Strings, TermInfo, termio;
 
27
type  Tencoding=(cp437,         {Codepage 437}
 
28
                 cp850,         {Codepage 850}
 
29
                 cp852,         {Codepage 852}
 
30
                 cp866,         {Codepage 866}
 
31
                 koi8r,         {KOI8-R codepage}
 
32
                 iso01,         {ISO 8859-1}
 
33
                 iso02,         {ISO 8859-2}
 
34
                 iso03,         {ISO 8859-3}
 
35
                 iso04,         {ISO 8859-4}
 
36
                 iso05,         {ISO 8859-5}
 
37
                 iso06,         {ISO 8859-6}
 
38
                 iso07,         {ISO 8859-7}
 
39
                 iso08,         {ISO 8859-8}
 
40
                 iso09,         {ISO 8859-9}
 
41
                 iso10,         {ISO 8859-10}
 
42
                 iso13,         {ISO 8859-13}
 
43
                 iso14,         {ISO 8859-14}
 
44
                 iso15);        {ISO 8859-15}
 
45
 
 
46
const  {Contains all code pages that can be considered a normal vga font.
 
47
        Note: KOI8-R has line drawing characters in wrong place. Support
 
48
              can perhaps be added, for now we'll let it rest.}
 
49
       vga_codepages=[cp437,cp850,cp852,cp866];
 
50
       iso_codepages=[iso01,iso02,iso03,iso04,iso05,iso06,iso07,iso08,
 
51
                      iso09,iso10,iso13,iso14,iso15];
 
52
 
 
53
var internal_codepage,external_codepage:Tencoding;
 
54
 
 
55
 
 
56
{*****************************************************************************}
 
57
                                implementation
 
58
{*****************************************************************************}
 
59
 
 
60
uses  baseunix,termio,strings
 
61
     {$ifdef linux},linuxvcs{$endif};
27
62
 
28
63
{$i video.inc}
29
 
 
30
 
 
31
 
Type TConsoleType = (ttyNetwork,ttyLinux,ttyFreeBSD,ttyNetBSD);
 
64
{$i convert.inc}
 
65
 
 
66
type  Tconsole_type=(ttyNetwork
 
67
                     {$ifdef linux},ttyLinux{$endif}
 
68
                     ,ttyFreeBSD
 
69
                     ,ttyNetBSD);
 
70
 
 
71
      Tconversion=(cv_none,
 
72
                   cv_cp437_to_iso01,
 
73
                   cv_cp850_to_iso01,
 
74
                   cv_linuxlowascii_to_vga);
 
75
 
 
76
      Ttermcode=(
 
77
        enter_alt_charset_mode,
 
78
        exit_alt_charset_mode,
 
79
        clear_screen,
 
80
        cursor_home,
 
81
        cursor_normal,
 
82
        cursor_visible_underline,
 
83
        cursor_visible_block,
 
84
        cursor_invisible,
 
85
        enter_ca_mode,
 
86
        exit_ca_mode,
 
87
        exit_am_mode,
 
88
        ena_acs
 
89
      );
 
90
      Ttermcodes=array[Ttermcode] of Pchar;
 
91
      Ptermcodes=^Ttermcodes;
 
92
 
 
93
const term_codes_ansi:Ttermcodes=
 
94
        (#$1B#$5B#$31#$31#$6D,                              {enter_alt_charset_mode}
 
95
         #$1B#$5B#$31#$30#$6D,                              {exit_alt_charset_mode}
 
96
         #$1B#$5B#$48#$1B#$5B#$4A,                          {clear_screen}
 
97
         #$1B#$5B#$48,                                      {cursor_home}
 
98
         nil,                                               {cursor_normal}
 
99
         nil,                                               {cursor visible, underline}
 
100
         nil,                                               {cursor visible, block}
 
101
         nil,                                               {cursor_invisible}
 
102
         nil,                                               {enter_ca_mode}
 
103
         nil,                                               {exit_ca_mode}
 
104
         nil,                                               {exit_am_mode}
 
105
         nil);                                              {ena_acs}
 
106
 
 
107
      term_codes_freebsd:Ttermcodes=
 
108
        (nil,                                               {enter_alt_charset_mode}
 
109
         nil,                                               {exit_alt_charset_mode}
 
110
         #$1B#$5B#$48#$1B#$5B#$4A,                          {clear_screen}
 
111
         #$1B#$5B#$48,                                      {cursor_home}
 
112
         #$1B#$5B#$3D#$30#$43,                              {cursor_normal}
 
113
         #$1B#$5B#$3D#$31#$43,                              {cursor visible, underline}
 
114
         #$1B#$5B#$3D#$31#$43,                              {cursor visible, block}
 
115
         nil,                                               {cursor_invisible}
 
116
         nil,                                               {enter_ca_mode}
 
117
         nil,                                               {exit_ca_mode}
 
118
         nil,                                               {exit_am_mode}
 
119
         nil);                                              {ena_acs}
 
120
 
 
121
      term_codes_linux:Ttermcodes=
 
122
        (#$1B#$5B#$31#$31#$6D,                              {enter_alt_charset_mode}
 
123
         #$1B#$5B#$31#$30#$6D,                              {exit_alt_charset_mode}
 
124
         #$1B#$5B#$48#$1B#$5B#$4A,                          {clear_screen}
 
125
         #$1B#$5B#$48,                                      {cursor_home}
 
126
         #$1B'[?25h'#$1B'[?0c',                             {cursor_normal}
 
127
         #$1B'[?0c',                                        {cursor visible, underline}
 
128
         #$1B'[?17;0;127c',                                 {cursor visible, block}
 
129
         #$1B'[?1c',                                        {cursor_invisible}
 
130
         nil,                                               {enter_ca_mode}
 
131
         nil,                                               {exit_ca_mode}
 
132
         nil,                                               {exit_am_mode}
 
133
         nil);                                              {ena_acs}
 
134
 
 
135
      term_codes_vt100:Ttermcodes=
 
136
        (#$0E,                                              {enter_alt_charset_mode}
 
137
         #$0F,                                              {exit_alt_charset_mode}
 
138
         #$1B#$5B#$48#$1B#$5B#$4A{#$24#$3C#$35#$30#$3E},    {clear_screen}
 
139
         #$1B#$5B#$48,                                      {cursor_home}
 
140
         nil,                                               {cursor_normal}
 
141
         nil,                                               {cursor visible, underline}
 
142
         nil,                                               {cursor visible, block}
 
143
         nil,                                               {cursor_invisible}
 
144
         nil,                                               {enter_ca_mode}
 
145
         nil,                                               {exit_ca_mode}
 
146
         #$1B#$5B#$3F#$37#$6C,                              {exit_am_mode}
 
147
         #$1B#$28#$42#$1B#$29#$30);                         {ena_acs}
 
148
 
 
149
      term_codes_vt220:Ttermcodes=
 
150
        (#$1B#$28#$30{#$24#$3C#$32#$3E},                    {enter_alt_charset_mode}
 
151
         #$1B#$28#$42{#$24#$3C#$34#$3E},                    {exit_alt_charset_mode}
 
152
         #$1B#$5B#$48#$1B#$5B#$4A,                          {clear_screen}
 
153
         #$1B#$5B#$48,                                      {cursor_home}
 
154
         nil,                                               {cursor_normal}
 
155
         nil,                                               {cursor visible, underline}
 
156
         nil,                                               {cursor visible, block}
 
157
         nil,                                               {cursor_invisible}
 
158
         nil,                                               {enter_ca_mode}
 
159
         nil,                                               {exit_ca_mode}
 
160
         #$1B#$5B#$3F#$37#$6C,                              {exit_am_mode}
 
161
         #$1B#$29#$30);                                     {ena_acs}
 
162
 
 
163
      term_codes_xterm:Ttermcodes=
 
164
        (#$0E,                                              {enter_alt_charset_mode}
 
165
         #$0F,                                              {exit_alt_charset_mode}
 
166
         #$1B#$5B#$48#$1B#$5B#$32#$4A,                      {clear_screen}
 
167
         #$1B#$5B#$48,                                      {cursor_home}
 
168
         #$1B#$5B#$3F#$31#$32#$6C#$1B#$5B#$3F#$32#$35#$68,  {cursor_normal}
 
169
         #$1B#$5B#$3F#$31#$32#$3B#$32#$35#$68,              {cursor visible, underline}
 
170
         #$1B#$5B#$3F#$31#$32#$3B#$32#$35#$68,              {cursor visible, block}
 
171
         #$1B#$5B#$3F#$32#$35#$6C,                          {cursor_invisible}
 
172
         #$1B#$5B#$3F#$31#$30#$34#$39#$68,                  {enter_ca_mode}
 
173
         #$1B#$5B#$3F#$31#$30#$34#$39#$6C,                  {exit_ca_mode}
 
174
         #$1B#$5B#$3F#$37#$6C,                              {exit_am_mode}
 
175
         #$1B#$28#$42#$1B#$29#$30);                         {ena_acs}
 
176
 
 
177
 
 
178
const    terminal_names:array[0..8] of string[7]=(
 
179
                        'ansi',
 
180
                        'cons',
 
181
                        'eterm',
 
182
                        'gnome',
 
183
                        'konsole',
 
184
                        'linux',
 
185
                        'vt100',
 
186
                        'vt220',
 
187
                        'xterm');
 
188
         terminal_data:array[0..8] of Ptermcodes=(
 
189
                        @term_codes_ansi,
 
190
                        @term_codes_freebsd,
 
191
                        @term_codes_xterm,
 
192
                        @term_codes_xterm,
 
193
                        @term_codes_xterm,
 
194
                        @term_codes_linux,
 
195
                        @term_codes_vt100,
 
196
                        @term_codes_vt220,
 
197
                        @term_codes_xterm);
 
198
 
 
199
const convert:Tconversion=cv_none;
32
200
 
33
201
var
34
202
  LastCursorType : byte;
35
203
  TtyFd: Longint;
36
 
  Console: TConsoleType;
 
204
  Console: Tconsole_type;
 
205
  cur_term_strings:Ptermcodes;
37
206
{$ifdef logging}
38
207
  f: file;
39
208
 
49
218
 
50
219
const
51
220
 
52
 
  can_delete_term : boolean = false;
 
221
{  can_delete_term : boolean = false;}
53
222
  ACSIn : string = '';
54
223
  ACSOut : string = '';
55
 
  InACS : boolean =false;
56
 
 
57
 
function IsACS(var ch,ACSchar : char): boolean;
 
224
  in_ACS : boolean =false;
 
225
 
 
226
function convert_vga_to_acs(ch:char):word;
 
227
 
 
228
{Ch contains a character in the VGA character set (i.e. codepage 437).
 
229
 This routine tries to convert some VGA symbols as well as possible to the
 
230
 xterm alternate character set.
 
231
 
 
232
 Return type is word to allow expanding to UCS-2 characters in the
 
233
 future.}
 
234
 
58
235
begin
59
 
  IsACS:=false;
60
236
  case ch of
 
237
    #18:
 
238
      convert_vga_to_acs:=word('|');
61
239
    #24, #30: {}
62
 
      ch:='^';
 
240
      convert_vga_to_acs:=word('^');
63
241
    #25, #31: {}
64
 
      ch:='v';
 
242
      convert_vga_to_acs:=word('v');
65
243
    #26, #16: {Never introduce a ctrl-Z ... }
66
 
      ch:='>';
67
 
    {#27,needed in Escape sequences} #17: {}
68
 
      ch:='<';
 
244
      convert_vga_to_acs:=word('>');
 
245
    {#27,} #17: {}
 
246
      convert_vga_to_acs:=word('<');
69
247
    #176, #177, #178: {���}
70
 
      begin
71
 
        IsACS:=true;
72
 
        ACSChar:='a';
73
 
      end;
 
248
      convert_vga_to_acs:=$f800+word('a');
74
249
    #180, #181, #182, #185: {����}
75
 
      begin
76
 
        IsACS:=true;
77
 
        ACSChar:='u';
78
 
      end;
 
250
      convert_vga_to_acs:=$f800+word('u');
79
251
    #183, #184, #187, #191: {����}
80
 
      begin
81
 
        IsACS:=true;
82
 
        ACSChar:='k';
83
 
      end;
 
252
      convert_vga_to_acs:=$f800+word('k');
84
253
    #188, #189, #190, #217: {����}
85
 
      begin
86
 
        IsACS:=true;
87
 
        ACSChar:='j';
88
 
      end;
 
254
      convert_vga_to_acs:=$f800+word('j');
89
255
    #192, #200, #211, #212: {����}
90
 
      begin
91
 
        IsACS:=true;
92
 
        ACSChar:='m';
93
 
      end;
 
256
      convert_vga_to_acs:=$f800+word('m');
94
257
    #193, #202, #207, #208: {����}
95
 
      begin
96
 
        IsACS:=true;
97
 
        ACSChar:='v';
98
 
      end;
 
258
      convert_vga_to_acs:=$f800+word('v');
99
259
    #194, #203, #209, #210: {����}
100
 
      begin
101
 
        IsACS:=true;
102
 
        ACSChar:='w';
103
 
      end;
 
260
      convert_vga_to_acs:=$f800+word('w');
104
261
    #195, #198, #199, #204: {����}
105
 
      begin
106
 
        IsACS:=true;
107
 
        ACSChar:='t';
108
 
      end;
 
262
      convert_vga_to_acs:=$f800+word('t');
109
263
    #196, #205: {��}
110
 
      begin
111
 
        IsACS:=true;
112
 
        ACSChar:='q';
113
 
      end;
 
264
      convert_vga_to_acs:=$f800+word('q');
114
265
    #179, #186: {��}
115
 
      begin
116
 
        IsACS:=true;
117
 
        ACSChar:='x';
118
 
      end;
 
266
      convert_vga_to_acs:=$f800+word('x');
119
267
    #197, #206, #215, #216: {����}
120
 
      begin
121
 
        IsACS:=true;
122
 
        ACSChar:='n';
123
 
      end;
 
268
      convert_vga_to_acs:=$f800+word('n');
124
269
    #201, #213, #214, #218: {����}
125
 
      begin
126
 
        IsACS:=true;
127
 
        ACSChar:='l';
128
 
      end;
 
270
      convert_vga_to_acs:=$f800+word('l');
129
271
    #254: { � }
130
 
      begin
131
 
        ch:='*';
132
 
      end;
 
272
      convert_vga_to_acs:=word('*');
133
273
    { Shadows for Buttons }
134
 
    #220: { � }
135
 
      begin
136
 
        IsACS:=true;
137
 
        ACSChar:='a';
138
 
      end;
 
274
    #220  { � },
139
275
    #223: { � }
140
 
      begin
141
 
        IsACS:=true;
142
 
        ACSChar:='a';
143
 
      end;
 
276
      convert_vga_to_acs:=$f800+word('a');
 
277
    else
 
278
      convert_vga_to_acs:=word(ch);
144
279
  end;
145
280
end;
146
281
 
147
282
 
148
 
function SendEscapeSeqNdx(Ndx: Word) : boolean;
149
 
var
150
 
  P,pdelay: PChar;
 
283
procedure SendEscapeSeqNdx(ndx:Ttermcode);
 
284
 
 
285
var p:PChar;
 
286
 
151
287
begin
152
 
  SendEscapeSeqNdx:=false;
 
288
{ Always true because of vt100 default.
153
289
  if not assigned(cur_term_Strings) then
154
 
    exit{RunError(219)};
155
 
  P:=cur_term_Strings^[Ndx];
156
 
  if assigned(p) then
157
 
   begin { Do not transmit the delays }
158
 
     pdelay:=strpos(p,'$<');
159
 
     if assigned(pdelay) then
160
 
       pdelay^:=#0;
161
 
     fpWrite(stdoutputhandle, P^, StrLen(P));
162
 
     SendEscapeSeqNdx:=true;
163
 
     if assigned(pdelay) then
164
 
       pdelay^:='$';
165
 
   end;
 
290
    exit}{RunError(219)};
 
291
  p:=cur_term_strings^[ndx];
 
292
  if p<>nil then
 
293
    fpwrite(stdoutputhandle,p^,strlen(p));
166
294
end;
167
295
 
168
296
 
172
300
end;
173
301
 
174
302
 
175
 
Function IntStr(l:longint):string;
176
 
var
177
 
  s : string;
 
303
function IntStr(l:longint):string;
 
304
 
178
305
begin
179
 
  Str(l,s);
180
 
  IntStr:=s;
 
306
  Str(l,intstr);
181
307
end;
182
308
 
183
309
 
189
315
  is (1, 1)), while SetCursorPos parameters and CursorX and CursorY
190
316
  are 0-based (top-left corner of the screen is (0, 0)).
191
317
}
192
 
Begin
 
318
 
 
319
var delta:longint;
 
320
    direction:char;
 
321
    movement:string[32];
 
322
 
 
323
begin
 
324
  if ((x=1) and (oy+1=y)) and (console<>ttyfreebsd) then
 
325
    begin
 
326
      XY2Ansi:=#13#10;
 
327
      exit;
 
328
    end;
 
329
  direction:='H';
193
330
  if y=oy then
194
331
   begin
195
332
     if x=ox then
202
339
        XY2Ansi:=#13;
203
340
        exit;
204
341
      end;
205
 
     if x>ox then
206
 
      begin
207
 
        XY2Ansi:=#27'['+IntStr(x-ox)+'C';
208
 
        exit;
209
 
      end
210
 
     else
211
 
      begin
212
 
        XY2Ansi:=#27'['+IntStr(ox-x)+'D';
213
 
        exit;
214
 
      end;
 
342
     delta:=ox-x;
 
343
     direction:=char(byte('C')+byte(x<=ox));
215
344
   end;
216
345
  if x=ox then
217
346
   begin
218
 
     if y>oy then
219
 
      begin
220
 
        XY2Ansi:=#27'['+IntStr(y-oy)+'B';
221
 
        exit;
222
 
      end
223
 
     else
224
 
      begin
225
 
        XY2Ansi:=#27'['+IntStr(oy-y)+'A';
226
 
        exit;
227
 
      end;
 
347
     delta:=oy-y;
 
348
     direction:=char(byte('A')+byte(y>oy));
228
349
   end;
229
 
  if ((x=1) and (oy+1=y)) and (console<>ttyfreebsd) then
230
 
   XY2Ansi:=#13#10
 
350
 
 
351
  if direction='H' then
 
352
    movement:=intstr(y)+';'+intstr(x)
231
353
  else
232
 
   XY2Ansi:=#27'['+IntStr(y)+';'+IntStr(x)+'H';
233
 
End;
234
 
 
235
 
 
236
 
 
237
 
const
238
 
  AnsiTbl : string[8]='04261537';
239
 
Function Attr2Ansi(Attr,OAttr:longint):string;
 
354
    movement:=intstr(abs(delta));
 
355
 
 
356
  xy2ansi:=#27'['+movement+direction;
 
357
end;
 
358
 
 
359
const  ansitbl:array[0..7] of char='04261537';
 
360
 
 
361
{$ifdef disabled}
 
362
Function Attr2Ansi(Attr,OAttr:byte):string;
240
363
{
241
364
  Convert Attr to an Ansi String, the Optimal code is calculate
242
365
  with use of the old OAttr
243
366
}
244
367
var
245
368
  hstr : string[16];
246
 
  OFg,OBg,Fg,Bg : longint;
 
369
  OFg,OBg,Fg,Bg:byte;
247
370
 
248
371
  procedure AddSep(ch:char);
249
372
  begin
263
386
  Bg:=Attr shr 4;
264
387
  OFg:=OAttr and $f;
265
388
  OBg:=OAttr shr 4;
 
389
{  This resets colours to their defaults, the problem is we don't know what
 
390
  the default is, i.e. it can either be white on black or back on white or
 
391
  even something totally different. This causes undesired colour schemes
 
392
  in the IDE on some terminals.
266
393
  if (OFg<>7) or (Fg=7) or ((OFg>7) and (Fg<8)) or ((OBg>7) and (Bg<8)) then
267
394
   begin
268
395
     hstr:='0';
269
396
     OFg:=7;
270
397
     OBg:=0;
271
 
   end;
 
398
   end;}
272
399
  if (Fg>7) and (OFg<8) then
273
400
   begin
274
401
     AddSep('1');
282
409
  if (Fg<>OFg) then
283
410
   begin
284
411
     AddSep('3');
285
 
     hstr:=hstr+AnsiTbl[(Fg and 7)+1];
 
412
     hstr:=hstr+AnsiTbl[fg and 7];
286
413
   end;
287
414
  if (Bg<>OBg) then
288
415
   begin
289
416
     AddSep('4');
290
 
     hstr:=hstr+AnsiTbl[(Bg and 7)+1];
 
417
     hstr:=hstr+AnsiTbl[bg and 7];
291
418
   end;
292
419
  if hstr='0' then
293
420
   hstr:='';
294
421
  Attr2Ansi:=#27'['+hstr+'m';
295
422
end;
 
423
{$endif}
 
424
 
 
425
function attr2ansi(attr,oattr:byte):string;
 
426
 
 
427
var OFg,OBg,Fg,Bg:byte;
 
428
 
 
429
begin
 
430
  Fg:=Attr and $f;
 
431
  Bg:=Attr shr 4;
 
432
  OFg:=OAttr and $f;
 
433
  OBg:=OAttr shr 4;
 
434
  attr2ansi:=#27'[';
 
435
  if fg and 8<>0 then
 
436
    begin
 
437
      {Enable bold if not yet on.}
 
438
      if ofg and 8=0 then
 
439
        attr2ansi:=attr2ansi+'1;';
 
440
    end
 
441
  else
 
442
    {Disable bold if on.}
 
443
    if ofg and 8<>0 then
 
444
      attr2ansi:=attr2ansi+'22;';
 
445
  if bg and 8<>0 then
 
446
    begin
 
447
      {Enable bold if not yet on.}
 
448
      if obg and 8=0 then
 
449
        attr2ansi:=attr2ansi+'5;';
 
450
    end
 
451
  else
 
452
    {Disable bold if on.}
 
453
    if obg and 8<>0 then
 
454
      attr2ansi:=attr2ansi+'25;';
 
455
 
 
456
  if fg and 7<>ofg and 7 then
 
457
     attr2ansi:=attr2ansi+'3'+ansitbl[fg and 7]+';';
 
458
  if bg and 7<>obg and 7 then
 
459
     attr2ansi:=attr2ansi+'4'+ansitbl[bg and 7]+';';
 
460
 
 
461
  if attr2ansi[length(attr2ansi)]=';' then
 
462
    attr2ansi[length(attr2ansi)]:='m'
 
463
  else
 
464
   attr2ansi:='';
 
465
end;
 
466
 
296
467
 
297
468
procedure UpdateTTY(Force:boolean);
298
469
type
319
490
  p,pold   : pvideocell;
320
491
  LastLineWidth : Longint;
321
492
 
322
 
procedure TransformUsingACS(var st : string);
323
 
var
324
 
  res : string;
325
 
  i : longint;
326
 
  ch,ACSch : char;
327
 
begin
328
 
  res:='';
329
 
  for i:=1 to length(st) do
330
 
    begin
331
 
      ch:=st[i];
332
 
      if IsACS(ch,ACSch) then
333
 
        begin
334
 
          if not InACS then
335
 
            begin
336
 
              res:=res+ACSIn;
337
 
              InACS:=true;
338
 
            end;
339
 
          res:=res+ACSch;
340
 
        end
 
493
  function transform_cp437_to_iso01(const st:string):string;
 
494
 
 
495
  var i:byte;
 
496
      c:char;
 
497
      converted:word;
 
498
 
 
499
  begin
 
500
    transform_cp437_to_iso01:='';
 
501
    for i:=1 to length(st) do
 
502
      begin
 
503
        c:=st[i];
 
504
        case c of
 
505
          #0..#31:
 
506
            converted:=convert_lowascii_to_iso01[c];
 
507
          #128..#255:
 
508
            converted:=convert_cp437_to_iso01[c];
 
509
          else
 
510
            converted:=byte(c);
 
511
        end;
 
512
        if converted and $ff00=$f800 then
 
513
          begin
 
514
            if not in_ACS then
 
515
              begin
 
516
                transform_cp437_to_iso01:=transform_cp437_to_iso01+ACSIn;
 
517
                in_ACS:=true;
 
518
              end;
 
519
            c:=char(converted and $ff);
 
520
          end
 
521
        else
 
522
          if in_ACS then
 
523
            begin
 
524
              transform_cp437_to_iso01:=transform_cp437_to_iso01+ACSOut+
 
525
                                        Attr2Ansi(LastAttr,0);
 
526
              in_ACS:=false;
 
527
            end;
 
528
        transform_cp437_to_iso01:=transform_cp437_to_iso01+c;
 
529
      end;
 
530
  end;
 
531
 
 
532
  function transform_cp850_to_iso01(const st:string):string;
 
533
 
 
534
  var i:byte;
 
535
      c:char;
 
536
      converted:word;
 
537
 
 
538
  begin
 
539
    transform_cp850_to_iso01:='';
 
540
    for i:=1 to length(st) do
 
541
      begin
 
542
        c:=st[i];
 
543
        case c of
 
544
          #0..#31:
 
545
            converted:=convert_lowascii_to_iso01[c];
 
546
          #128..#255:
 
547
            converted:=convert_cp850_to_iso01[c];
 
548
          else
 
549
            converted:=byte(c);
 
550
        end;
 
551
        if converted and $ff00=$f800 then
 
552
          begin
 
553
            if not in_ACS then
 
554
              begin
 
555
                transform_cp850_to_iso01:=transform_cp850_to_iso01+ACSIn;
 
556
                in_ACS:=true;
 
557
              end;
 
558
          end
 
559
        else
 
560
          if in_ACS then
 
561
            begin
 
562
              transform_cp850_to_iso01:=transform_cp850_to_iso01+ACSOut+
 
563
                                        Attr2Ansi(LastAttr,0);
 
564
              in_ACS:=false;
 
565
            end;
 
566
        c:=char(converted and $ff);
 
567
        transform_cp850_to_iso01:=transform_cp850_to_iso01+c;
 
568
      end;
 
569
  end;
 
570
 
 
571
  function transform_linuxlowascii_to_vga(const st:string):string;
 
572
 
 
573
  var i:byte;
 
574
      c:char;
 
575
      converted:word;
 
576
 
 
577
  begin
 
578
    transform_linuxlowascii_to_vga:='';
 
579
    for i:=1 to length(st) do
 
580
      begin
 
581
        c:=st[i];
 
582
        case c of
 
583
          #0..#31:
 
584
            converted:=convert_linuxlowascii_to_vga[c];
 
585
          else
 
586
            converted:=byte(c);
 
587
        end;
 
588
        c:=char(converted and $ff);
 
589
        transform_linuxlowascii_to_vga:=transform_linuxlowascii_to_vga+c;
 
590
      end;
 
591
  end;
 
592
 
 
593
  function transform(const hstr:string):string;
 
594
 
 
595
  begin
 
596
    case convert of
 
597
      cv_linuxlowascii_to_vga:
 
598
        transform:=transform_linuxlowascii_to_vga(hstr);
 
599
      cv_cp437_to_iso01:
 
600
        transform:=transform_cp437_to_iso01(hstr);
 
601
      cv_cp850_to_iso01:
 
602
        transform:=transform_cp850_to_iso01(hstr);
341
603
      else
342
 
        begin
343
 
          if InACS then
344
 
            begin
345
 
              res:=res+ACSOut+Attr2Ansi(LastAttr,0);
346
 
              InACS:=false;
347
 
            end;
348
 
          res:=res+ch;
349
 
        end;
 
604
        transform:=hstr;
350
605
    end;
351
 
  st:=res;
352
 
end;
353
 
 
354
 
 
 
606
  end;
355
607
 
356
608
  procedure outdata(hstr:string);
 
609
 
357
610
  begin
358
611
   If Length(HStr)>0 Then
359
612
   Begin
362
615
       hstr:=#13#10+hstr;
363
616
       dec(eol);
364
617
     end;
365
 
    if NoExtendedFrame and (ACSIn<>'') and (ACSOut<>'') then
366
 
      TransformUsingACS(Hstr);
 
618
{    if (convert=cv_vga_to_acs) and (ACSIn<>'') and (ACSOut<>'') then
 
619
      transform_using_acs(Hstr);}
367
620
    move(hstr[1],outbuf[outptr],length(hstr));
368
621
    inc(outptr,length(hstr));
369
622
    if outptr>=1024 then
401
654
    Spaces:=0;
402
655
  end;
403
656
 
404
 
function GetTermString(ndx:word):String;
 
657
(*
 
658
function GetTermString(ndx:Ttermcode):String;
405
659
var
406
 
   P,pdelay: PChar;
 
660
   P{,pdelay}: PChar;
407
661
begin
408
662
  GetTermString:='';
409
663
  if not assigned(cur_term_Strings) then
411
665
  P:=cur_term_Strings^[Ndx];
412
666
  if assigned(p) then
413
667
   begin { Do not transmit the delays }
414
 
     pdelay:=strpos(p,'$<');
 
668
{     pdelay:=strpos(p,'$<');
415
669
     if assigned(pdelay) then
416
 
       pdelay^:=#0;
 
670
       pdelay^:=#0;}
417
671
     GetTermString:=StrPas(p);
418
 
     if assigned(pdelay) then
419
 
       pdelay^:='$';
 
672
{     if assigned(pdelay) then
 
673
       pdelay^:='$';}
420
674
   end;
421
675
end;
 
676
*)
422
677
 
423
678
begin
424
679
  OutPtr:=0;
427
682
  p:=PVideoCell(VideoBuf);
428
683
  pold:=PVideoCell(OldVideoBuf);
429
684
{ init Attr, X,Y and set autowrap off }
430
 
  SendEscapeSeq(#27'[m'#27'[?7l'{#27'[H'} );
 
685
  SendEscapeSeq(#27'[0;40;37m'#27'[?7l'{#27'[H'} );
431
686
//  1.0.x: SendEscapeSeq(#27'[m'{#27'[H'});
432
687
  LastAttr:=7;
433
688
  LastX:=-1;
457
712
              skipped:=false;
458
713
            end;
459
714
           chattr:=tchattr(p^);
460
 
           if chattr.ch in [#0,#255] then
461
 
            chattr.ch:=' ';
 
715
{           if chattr.ch in [#0,#255] then
 
716
            chattr.ch:=' ';}
462
717
           if chattr.ch=' ' then
463
718
            begin
464
719
              if Spaces=0 then
476
731
            begin
477
732
              if (Spaces>0) then
478
733
               OutSpaces;
479
 
              if ord(chattr.ch)<32 then
 
734
{              if ord(chattr.ch)<32 then
480
735
                begin
481
736
                  Chattr.Attr:= $ff xor Chattr.Attr;
482
 
                  ChAttr.ch:= chr(ord(chattr.ch)+ord('A')-1);
483
 
                end;
 
737
                  ChAttr.ch:=chr(ord(chattr.ch)+ord('A')-1);
 
738
                end;}
484
739
              if LastAttr<>chattr.Attr then
485
740
               OutClr(chattr.Attr);
486
 
              OutData(chattr.ch);
 
741
              OutData(transform(chattr.ch));
487
742
              LastX:=x+1;
488
743
              LastY:=y;
489
744
            end;
501
756
   end;
502
757
  eol:=0;
503
758
 {if am in capabilities? Then}
504
 
  If (Console=ttyFreeBSD) and (Plongint(p)^<>plongint(pold)^) Then
505
 
   Begin
 
759
  if (Console=ttyFreeBSD) and (Plongint(p)^<>plongint(pold)^) Then
 
760
   begin
506
761
    OutData(XY2Ansi(ScreenWidth,ScreenHeight,LastX,LastY));
507
762
    OutData(#8);
508
763
    {Output last char}
509
764
    chattr:=tchattr(p[1]);
510
765
    if LastAttr<>chattr.Attr then
511
766
     OutClr(chattr.Attr);
512
 
    OutData(chattr.ch);
 
767
    OutData(transform(chattr.ch));
513
768
    inc(LastX);
514
769
//    OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY));
515
770
//   OutData(GetTermString(Insert_character));
518
773
    chattr:=tchattr(p^);
519
774
    if LastAttr<>chattr.Attr then
520
775
     OutClr(chattr.Attr);
521
 
    OutData(chattr.ch);
 
776
    OutData(transform(chattr.ch));
522
777
    inc(LastX);
523
778
   end;
524
779
  OutData(XY2Ansi(CursorX+1,CursorY+1,LastX,LastY));
 
780
  if in_ACS then
 
781
    begin
 
782
      {If the program crashes and the ACS is still enabled, the user's
 
783
       keyboard will output strange characters. Therefore we disable the
 
784
       acs after each screen update, so the risk that it happens is greatly
 
785
       reduced.}
 
786
{      SendEscapeSeqNdx(exit_alt_charset_mode);}
 
787
      outdata(acsout);
 
788
      in_acs:=false;
 
789
    end;
525
790
{$ifdef logging}
526
791
  blockwrite(f,logstart[1],length(logstart));
527
792
  blockwrite(f,nl,1);
531
796
  blockwrite(f,nl,1);
532
797
{$endif logging}
533
798
  fpWrite(stdoutputhandle,outbuf,outptr);
534
 
  if InACS then
535
 
    SendEscapeSeqNdx(exit_alt_charset_mode);
536
799
 {turn autowrap on}
537
800
//  SendEscapeSeq(#27'[?7h');
538
801
end;
539
802
 
 
803
{$ifdef linux}
 
804
procedure update_vcsa(force:boolean);
 
805
 
 
806
const max_updates=64;
 
807
 
 
808
label update,update_all,equal_loop,unequal_loop;
 
809
 
 
810
var position,update_count,i:word;
 
811
    update_positions:array[0..max_updates-1] of word;
 
812
    update_lengths:array[0..max_updates-1] of word;
 
813
 
 
814
begin
 
815
  if force then
 
816
    goto update_all;
 
817
 
 
818
  update_count:=0;
 
819
  i:=0;
 
820
 
 
821
equal_loop:
 
822
  repeat
 
823
    if videobuf^[i]<>oldvideobuf^[i] then
 
824
      goto unequal_loop;
 
825
    inc(i);
 
826
  until i>videobufsize div 2;
 
827
  goto update;
 
828
 
 
829
unequal_loop:
 
830
  if update_count>=max_updates then
 
831
    goto update_all;
 
832
  update_positions[update_count]:=i;
 
833
  update_lengths[update_count]:=0;
 
834
  inc(update_count);
 
835
  repeat
 
836
    if videobuf^[i]=oldvideobuf^[i] then
 
837
      goto equal_loop;
 
838
    inc(i);
 
839
    inc(update_lengths[update_count-1]);
 
840
  until i>videobufsize div 2;
 
841
 
 
842
update:
 
843
  for i:=1 to update_count do
 
844
    begin
 
845
      position:=update_positions[i-1];
 
846
      fppwrite(ttyfd,videobuf^[position],update_lengths[i-1]*2,4+position*2);
 
847
    end;
 
848
  exit;
 
849
update_all:
 
850
  fppwrite(ttyfd,videobuf^,videobufsize,4);
 
851
end;
 
852
{$endif}
 
853
 
540
854
var
541
855
  preInitVideoTio, postInitVideoTio: termio.termios;
542
856
  inputRaw, outputRaw: boolean;
543
857
 
544
858
procedure saveRawSettings(const tio: termio.termios);
545
 
Begin
 
859
 
 
860
begin
546
861
  with tio do
547
862
   begin
548
863
     inputRaw :=
578
893
  TCSetAttr(1,TCSANOW,tio);
579
894
end;
580
895
 
 
896
procedure decide_codepages;
 
897
 
 
898
var s:string;
 
899
 
 
900
begin
 
901
  if external_codepage in vga_codepages then
 
902
    begin
 
903
      {Possible override...}
 
904
      s:=upcase(fpgetenv('CONSOLEFONT_CP'));
 
905
      if s='CP437' then
 
906
        external_codepage:=cp437
 
907
      else if s='CP850' then
 
908
        external_codepage:=cp850;
 
909
    end;
 
910
  {A non-vcsa Linux console can display most control characters, but not all.}
 
911
  if {$ifdef linux}(console<>ttyLinux) and{$endif}
 
912
     (cur_term_strings=@term_codes_linux) then
 
913
    convert:=cv_linuxlowascii_to_vga;
 
914
  case external_codepage of
 
915
    iso01:               {West Europe}
 
916
      begin
 
917
        internal_codepage:=cp850;
 
918
        convert:=cv_cp850_to_iso01;
 
919
      end;
 
920
    iso02:               {East Europe}
 
921
      internal_codepage:=cp852;
 
922
    iso05:               {Cyrillic}
 
923
      internal_codepage:=cp866;
 
924
    else
 
925
      if internal_codepage in vga_codepages then
 
926
        internal_codepage:=external_codepage
 
927
      else
 
928
        {We don't know how to convert to the external codepage. Use codepage
 
929
         437 in the hope that the actual font has similarity to codepage 437.}
 
930
        internal_codepage:=cp437;
 
931
  end;
 
932
end;
 
933
 
581
934
 
582
935
procedure prepareInitVideo;
583
936
begin
606
959
end;
607
960
 
608
961
procedure SysInitVideo;
609
 
const
610
 
  fontstr : string[3]=#27'(K';
611
962
var
612
 
  ThisTTY: String[30];
613
963
  FName: String;
614
964
  WS: packed record
615
965
    ws_row, ws_col, ws_xpixel, ws_ypixel: Word;
616
966
  end;
617
 
  Err: Longint;
618
 
  prev_term : TerminalCommon_ptr1;
 
967
{  Err: Longint;}
 
968
{  prev_term : TerminalCommon_ptr1;}
 
969
  term:string;
 
970
  i:word;
 
971
{$ifdef Linux}
 
972
  s:string[15];
 
973
{$endif}
 
974
{$ifdef freebsd}
 
975
  ThisTTY: String[30];
 
976
{$endif}
 
977
 
 
978
const font_vga:array[0..11] of char=#15#27'%@'#27'(U'#27'[3h';
 
979
      font_custom:array[0..2] of char=#27'(K';
 
980
 
619
981
begin
620
 
{$ifndef CPUI386}
621
 
  LowAscii:=false;
622
 
{$endif CPUI386}
623
982
  { check for tty }
624
 
  ThisTTY:=TTYName(stdinputhandle);
625
 
  if (IsATTY(stdinputhandle)<>-1) then
 
983
  if (IsATTY(stdinputhandle)=1) then
626
984
   begin
627
985
     { save current terminal characteristics and remove rawness }
628
986
     prepareInitVideo;
629
 
     { write code to set a correct font }
630
 
     fpWrite(stdoutputhandle,fontstr[1],length(fontstr));
631
987
     { running on a tty, find out whether locally or remotely }
632
988
     TTyfd:=-1;
633
 
     Console:=TTyNetwork;  {Default: Network or other vtxxx tty}
634
 
     if (Copy(ThisTTY, 1, 8) = '/dev/tty') and
635
 
        not (ThisTTY[9] IN ['p'..'u','P']) then                 // FreeBSD has these
636
 
      begin
637
 
        { running on the console }
638
 
        Case ThisTTY[9] of
639
 
         '0'..'9' : begin { running Linux on native console or native-emulation }
640
 
                     FName:='/dev/vcsa' + ThisTTY[9];
641
 
                     { open console, $1b6=rw-rw-rw- }
642
 
                     TTYFd:=fpOpen(FName, $1b6, O_RdWr);
643
 
                     IF TTYFd <>-1 Then
644
 
                       Console:=ttyLinux;
645
 
                    end;
646
 
         'v'  :  { check for (Free?)BSD native}
647
 
                If (ThisTTY[10]>='0') and (ThisTTY[10]<='9') Then
648
 
                 Console:=ttyFreeBSD;   {TTYFd ?}
649
 
         end;
650
 
       end;
651
 
     If (Copy(fpGetEnv('TERM'),1,4)='cons') Then                // cons<lines>
652
 
       Console:=ttyFreeBSD;
653
 
     If Console<>ttylinux Then
654
 
      begin
 
989
     Console:=TTyNetwork;                 {Default: Network or other vtxxx tty}
 
990
     cur_term_strings:=@term_codes_vt100; {Default: vt100}
 
991
     external_codepage:=iso01;            {Default: ISO-8859-1}
 
992
   {$ifdef linux}
 
993
     if vcs_device>=0 then
 
994
       begin
 
995
         str(vcs_device,s);
 
996
         fname:='/dev/vcsa'+s;
 
997
         { open console, $1b6=rw-rw-rw- }
 
998
         ttyfd:=fpopen(fname,$1b6,O_RDWR);
 
999
         if ttyfd<>-1 then
 
1000
           begin
 
1001
             console:=ttylinux;
 
1002
             external_codepage:=cp437;  {VCSA defaults to codepage 437.}
 
1003
           end
 
1004
         else
 
1005
           if try_grab_vcsa then
 
1006
             begin
 
1007
               ttyfd:=fpopen(fname,$1b6,O_RDWR);
 
1008
               if ttyfd<>-1 then
 
1009
                 begin
 
1010
                   console:=ttylinux;
 
1011
                   external_codepage:=cp437;  {VCSA defaults to codepage 437.}
 
1012
                 end;
 
1013
             end;
 
1014
       end;
 
1015
   {$endif}
 
1016
   {$ifdef freebsd}
 
1017
     ThisTTY:=TTYName(stdinputhandle);
 
1018
     if copy(ThisTTY, 1, 9) = '/dev/ttyv' then  {FreeBSD has these}
 
1019
       begin
 
1020
         { check for (Free?)BSD native}
 
1021
         if (ThisTTY[10]>='0') and (ThisTTY[10]<='9') Then
 
1022
            Console:=ttyFreeBSD;   {TTYFd ?}
 
1023
       end;
 
1024
   {$endif}
 
1025
     term:=fpgetenv('TERM');
 
1026
     for i:=low(terminal_names) to high(terminal_names) do
 
1027
       if copy(term,1,length(terminal_names[i]))=terminal_names[i] then
 
1028
         cur_term_strings:=terminal_data[i];
 
1029
    if cur_term_strings=@term_codes_freebsd then
 
1030
      console:=ttyFreeBSD;
 
1031
{$ifdef linux}
 
1032
    if (console<>ttylinux) then
 
1033
      begin
 
1034
{$endif}
 
1035
        if cur_term_strings=@term_codes_linux then
 
1036
          begin
 
1037
            {Executed in case ttylinux is false (i.e. no vcsa), but
 
1038
             TERM=linux.}
 
1039
            {Enable the VGA character set (codepage 437,850,....)}
 
1040
            fpwrite(stdoutputhandle,font_vga,sizeof(font_vga));
 
1041
            external_codepage:=cp437;  {Now default to codepage 437.}
 
1042
          end
 
1043
        else
 
1044
          {No VGA font :( }
 
1045
          fpwrite(stdoutputhandle,font_custom,sizeof(font_vga));
655
1046
        { running on a remote terminal, no error with /dev/vcsa }
656
 
        LowAscii:=false;
657
 
        //TTYFd:=stdoutputhandle;
 
1047
   {$ifdef linux}
658
1048
      end;
 
1049
   {$endif}
659
1050
     fpioctl(stdinputhandle, TIOCGWINSZ, @WS);
660
1051
     if WS.ws_Col=0 then
661
1052
      WS.ws_Col:=80;
672
1063
     LastCursorType:=$ff;
673
1064
     ScreenColor:=True;
674
1065
     { Start with a clear screen }
 
1066
   {$ifdef linux}
675
1067
     if Console<>ttylinux then
676
1068
      begin
677
 
        prev_term:=cur_term;
678
 
        setupterm(nil, stdoutputhandle, err);
679
 
        can_delete_term:=assigned(prev_term) and (prev_term<>cur_term);
 
1069
   {$endif}
680
1070
        SendEscapeSeqNdx(cursor_home);
681
1071
        SendEscapeSeqNdx(cursor_normal);
682
 
        SendEscapeSeqNdx(cursor_visible);
 
1072
        SendEscapeSeqNdx(cursor_visible_underline);
683
1073
        SendEscapeSeqNdx(enter_ca_mode);
684
1074
        SetCursorType(crUnderLine);
685
1075
        If Console=ttyFreeBSD Then
686
1076
          SendEscapeSeqNdx(exit_am_mode);
687
 
      end
688
 
     else if not assigned(cur_term) then
689
 
       begin
690
 
         setupterm(nil, stdoutputhandle, err);
691
 
         can_delete_term:=false;
692
 
       end;
693
 
     if assigned(cur_term_Strings) then
694
 
       begin
695
 
         ACSIn:=StrPas(cur_term_Strings^[enter_alt_charset_mode]);
696
 
         ACSOut:=StrPas(cur_term_Strings^[exit_alt_charset_mode]);
 
1077
   {$ifdef linux}
 
1078
      end;
 
1079
   {$endif}
 
1080
{   Always true because of vt100 default...
 
1081
      if assigned(cur_term_Strings) then
 
1082
       begin}
 
1083
         ACSIn:=StrPas(cur_term_strings^[enter_alt_charset_mode]);
 
1084
         ACSOut:=StrPas(cur_term_strings^[exit_alt_charset_mode]);
697
1085
         if (ACSIn<>'') and (ACSOut<>'') then
698
1086
           SendEscapeSeqNdx(ena_acs);
699
 
         if pos('$<',ACSIn)>0 then
700
 
           ACSIn:=Copy(ACSIn,1,Pos('$<',ACSIn)-1);
701
 
         if pos('$<',ACSOut)>0 then
702
 
           ACSOut:=Copy(ACSOut,1,Pos('$<',ACSOut)-1);
703
 
         If fpGetEnv('TERM')='xterm' then
704
 
           NoExtendedFrame := true;  {use of acs for xterm is ok}
705
 
       end
 
1087
(*         If fpGetEnv('TERM')='xterm' then
 
1088
           convert:=cv_vga_to_acs;  {use of acs for xterm is ok}*)
 
1089
{       end
706
1090
     else
707
1091
       begin
708
1092
         ACSIn:='';
709
1093
         ACSOut:='';
710
 
       end;
 
1094
       end;}
711
1095
{$ifdef logging}
712
1096
     assign(f,'video.log');
713
1097
     rewrite(f,1);
714
1098
{$endif logging}
715
1099
     { save new terminal characteristics and possible restore rawness }
716
1100
     videoInitDone;
 
1101
 
 
1102
     decide_codepages;
717
1103
   end
718
1104
  else
719
1105
   ErrorCode:=errVioInit; { not a TTY }
720
1106
end;
721
1107
 
722
1108
procedure SysDoneVideo;
 
1109
 
 
1110
var font_custom:array[0..2] of char=#27'(K';
 
1111
 
723
1112
begin
724
1113
  prepareDoneVideo;
 
1114
  SetCursorType(crUnderLine);
 
1115
{$ifdef linux}
725
1116
  if Console=ttylinux then
726
1117
   SetCursorPos(0,0)
727
1118
  else
728
1119
   begin
 
1120
{$endif}
729
1121
     SendEscapeSeqNdx(exit_ca_mode);
730
1122
     SendEscapeSeqNdx(cursor_home);
731
1123
     SendEscapeSeqNdx(cursor_normal);
732
 
     SendEscapeSeqNdx(cursor_visible);
733
 
     SetCursorType(crUnderLine);
 
1124
     SendEscapeSeqNdx(cursor_visible_underline);
734
1125
     SendEscapeSeq(#27'[H');
 
1126
     if cur_term_strings=@term_codes_linux then
 
1127
       begin
 
1128
         {Executed in case ttylinux is false (i.e. no vcsa), but
 
1129
          TERM=linux.}
 
1130
         {Enable the character set set through setfont}
 
1131
         fpwrite(stdoutputhandle,font_custom,3);
 
1132
       end;
 
1133
{$ifdef linux}
735
1134
   end;
 
1135
{$endif}
736
1136
  ACSIn:='';
737
1137
  ACSOut:='';
738
1138
  doneVideoDone;
739
 
  { FreeBSD gives an error here.
740
 
   According to Pierre this could be more a NCurses version thing that
741
 
   a FreeBSD one. FreeBSD 4.4 has ncurses 5.
742
 
   MvdV102003: Since I ran 1.1 with newer FreeBSD without problem, I let it be for now}
743
 
  if can_delete_term then
744
 
    begin
745
 
      del_curterm(cur_term);
746
 
      can_delete_term:=false;
747
 
    end;
748
1139
{$ifdef logging}
749
1140
  close(f);
750
1141
{$endif logging}
753
1144
 
754
1145
procedure SysClearScreen;
755
1146
begin
 
1147
{$ifdef linux}
756
1148
  if Console=ttylinux then
757
1149
    UpdateScreen(true)
758
1150
  else
759
1151
    begin
760
 
    SendEscapeSeq(#27'[0m');
761
 
    SendEscapeSeqNdx(clear_screen);
 
1152
{$endif}
 
1153
      SendEscapeSeq(#27'[0m');
 
1154
      SendEscapeSeqNdx(clear_screen);
 
1155
{$ifdef linux}
762
1156
    end;
 
1157
{$endif}
763
1158
end;
764
1159
 
765
1160
 
769
1164
  i : longint;
770
1165
  p1,p2 : plongint;
771
1166
begin
772
 
  if not force then
773
 
   begin
774
 
{$ifdef cpui386}
775
 
     asm
776
 
          pushl   %esi
777
 
          pushl   %edi
778
 
          movl    VideoBuf,%esi
779
 
          movl    OldVideoBuf,%edi
780
 
          movl    VideoBufSize,%ecx
781
 
          shrl    $2,%ecx
782
 
          repe
783
 
          cmpsl
784
 
          setne   DoUpdate
785
 
          popl    %edi
786
 
          popl    %esi
787
 
     end;
788
 
{$else not cpui386}
789
 
     p1:=plongint(VideoBuf);
790
 
     p2:=plongint(OldVideoBuf);
791
 
     for i:=0 to VideoBufSize div 2 do
792
 
       if (p1^<>p2^) then
793
 
         begin
794
 
           DoUpdate:=true;
795
 
           break;
796
 
         end
797
 
       else
798
 
         begin
799
 
           { Inc does add sizeof(longint) to both pointer values }
800
 
           inc(p1);
801
 
           inc(p2);
802
 
         end;
803
 
{$endif not cpui386}
804
 
   end
805
 
  else
806
 
   DoUpdate:=true;
807
 
  if not DoUpdate then
808
 
   exit;
809
 
  if Console=ttylinux then
810
 
   begin
811
 
     fplSeek(TTYFd, 4, Seek_Set);
812
 
     fpWrite(TTYFd, VideoBuf^,VideoBufSize);
813
 
   end
814
 
  else
815
 
   begin
816
 
     UpdateTTY(force);
817
 
   end;
818
 
  Move(VideoBuf^, OldVideoBuf^, VideoBufSize);
 
1167
{$ifdef linux}
 
1168
  if console=ttylinux then
 
1169
    update_vcsa(force)
 
1170
  else
 
1171
{$endif}
 
1172
    updateTTY(force);
 
1173
  move(VideoBuf^,OldVideoBuf^,VideoBufSize);
819
1174
end;
820
1175
 
821
1176
 
832
1187
begin
833
1188
 if (CursorX=NewCursorX) and (CursorY=NewCursorY) then
834
1189
    exit;
 
1190
{$ifdef linux}
835
1191
  if Console=ttylinux then
836
1192
   begin
837
 
     fplSeek(TTYFd, 2, Seek_Set);
838
1193
     Pos[1]:=NewCursorX;
839
1194
     Pos[2]:=NewCursorY;
840
 
     fpWrite(TTYFd, Pos, 2);
 
1195
     fppwrite(ttyfd,pos,2,2);
841
1196
   end
842
1197
  else
843
 
   begin
844
 
     { newcursorx,y and CursorX,Y are 0 based ! }
845
 
     SendEscapeSeq(XY2Ansi(NewCursorX+1,NewCursorY+1,CursorX+1,CursorY+1));
846
 
   end;
 
1198
{$endif}
 
1199
    { newcursorx,y and CursorX,Y are 0 based ! }
 
1200
    SendEscapeSeq(XY2Ansi(NewCursorX+1,NewCursorY+1,CursorX+1,CursorY+1));
847
1201
  CursorX:=NewCursorX;
848
1202
  CursorY:=NewCursorY;
849
1203
end;
861
1215
   exit;
862
1216
  LastCursorType:=NewType;
863
1217
  case NewType of
864
 
   crBlock :
865
 
     Begin
866
 
       If not SendEscapeSeqNdx(cursor_visible) then
867
 
        If Console<>ttyFreeBSD Then     // should be done only for linux?
868
 
         SendEscapeSeq(#27'[?17;0;64c');
869
 
     End;
870
 
   crHidden :
871
 
     Begin
872
 
       If not SendEscapeSeqNdx(cursor_invisible) then
873
 
        If Console<>ttyFreeBSD Then
874
 
         SendEscapeSeq(#27'[?1c');
875
 
     End;
 
1218
    crBlock:
 
1219
      SendEscapeSeqNdx(cursor_visible_block);
 
1220
    crHidden:
 
1221
      SendEscapeSeqNdx(cursor_invisible);
876
1222
  else
 
1223
    SendEscapeSeqNdx(cursor_normal);
 
1224
  end;
 
1225
end;
 
1226
 
 
1227
function SysSetVideoMode(const mode:Tvideomode):boolean;
 
1228
 
 
1229
var winsize:Twinsize;
 
1230
 
 
1231
begin
 
1232
  {Due to xterm resize this procedure might get called with the new xterm
 
1233
   size. Approve the video mode change if the new size equals that of
 
1234
   the terminal window size.}
 
1235
  SysSetVideoMode:=false;
 
1236
  fpioctl(stdinputhandle,TIOCGWINSZ,@winsize);
 
1237
  if (mode.row=winsize.ws_row) and
 
1238
     (mode.col=winsize.ws_col) then
877
1239
    begin
878
 
      If not SendEscapeSeqNdx(cursor_normal) then
879
 
        If Console<>ttyFreeBSD Then
880
 
         SendEscapeSeq(#27'[?2c');
 
1240
      screenwidth:=mode.col;
 
1241
      screenheight:=mode.row;
 
1242
      screencolor:=true;
 
1243
      SysSetVideoMode:=true;
881
1244
    end;
882
 
  end;
883
1245
end;
884
1246
 
885
1247
Const
888
1250
    DoneDriver : @SysDoneVideo;
889
1251
    UpdateScreen : @SysUpdateScreen;
890
1252
    ClearScreen : @SysClearScreen;
891
 
    SetVideoMode : Nil;
 
1253
    SetVideoMode : @SysSetVideoMode;
892
1254
    GetVideoModeCount : Nil;
893
1255
    GetVideoModeData : Nil;
894
1256
    SetCursorPos : @SysSetCursorPos;
900
1262
initialization
901
1263
  SetVideoDriver(SysVideoDriver);
902
1264
end.
903
 
{
904
 
  $Log: video.pp,v $
905
 
  Revision 1.28  2005/02/14 17:13:31  peter
906
 
    * truncate log
907
 
 
908
 
}
909