← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to rtl/go32v2/crt.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/go32v2/crt.pp
1
 
{
2
 
    $Id: crt.pp,v 1.11 2004/02/08 16:22:20 michael Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by the Free Pascal development team.
5
 
 
6
 
    Borland Pascal 7 Compatible CRT Unit - Go32V2 implementation
7
 
 
8
 
    See the file COPYING.FPC, included in this distribution,
9
 
    for details about the copyright.
10
 
 
11
 
    This program is distributed in the hope that it will be useful,
12
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
13
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
 
 
15
 
 **********************************************************************}
16
 
unit crt;
17
 
 
18
 
interface
19
 
 
20
 
{$i crth.inc}
21
 
 
22
 
Var
23
 
  ScreenWidth,
24
 
  ScreenHeight : longint;
25
 
 
26
 
implementation
27
 
 
28
 
uses
29
 
  go32;
30
 
 
31
 
{$ASMMODE ATT}
32
 
 
33
 
var
34
 
  DelayCnt : Longint;
35
 
  VidSeg : Word;
36
 
 
37
 
{
38
 
  definition of textrec is in textrec.inc
39
 
}
40
 
{$i textrec.inc}
41
 
 
42
 
 
43
 
{****************************************************************************
44
 
                           Low level Routines
45
 
****************************************************************************}
46
 
 
47
 
procedure setscreenmode(mode : byte);
48
 
var
49
 
  regs : trealregs;
50
 
begin
51
 
  regs.realeax:=mode;
52
 
  realintr($10,regs);
53
 
end;
54
 
 
55
 
 
56
 
function GetScreenHeight : longint;
57
 
begin
58
 
  getscreenheight:=mem[$40:$84]+1;
59
 
  If mem[$40:$84]=0 then
60
 
    getscreenheight := 25;
61
 
end;
62
 
 
63
 
 
64
 
function GetScreenWidth : longint;
65
 
begin
66
 
  getscreenwidth:=memw[$40:$4a];
67
 
end;
68
 
 
69
 
 
70
 
procedure SetScreenCursor(x,y : longint);
71
 
var
72
 
  regs : trealregs;
73
 
begin
74
 
  regs.realeax:=$0200;
75
 
  regs.realebx:=0;
76
 
  regs.realedx:=(y-1) shl 8+(x-1);
77
 
  realintr($10,regs);
78
 
end;
79
 
 
80
 
 
81
 
procedure GetScreenCursor(var x,y : longint);
82
 
begin
83
 
  x:=mem[$40:$50]+1;
84
 
  y:=mem[$40:$51]+1;
85
 
end;
86
 
 
87
 
 
88
 
{****************************************************************************
89
 
                              Helper Routines
90
 
****************************************************************************}
91
 
 
92
 
Function WinMinX: Byte;
93
 
{
94
 
  Current Minimum X coordinate
95
 
}
96
 
Begin
97
 
  WinMinX:=(WindMin and $ff)+1;
98
 
End;
99
 
 
100
 
 
101
 
 
102
 
Function WinMinY: Byte;
103
 
{
104
 
  Current Minimum Y Coordinate
105
 
}
106
 
Begin
107
 
  WinMinY:=(WindMin shr 8)+1;
108
 
End;
109
 
 
110
 
 
111
 
 
112
 
Function WinMaxX: Byte;
113
 
{
114
 
  Current Maximum X coordinate
115
 
}
116
 
Begin
117
 
  WinMaxX:=(WindMax and $ff)+1;
118
 
End;
119
 
 
120
 
 
121
 
 
122
 
Function WinMaxY: Byte;
123
 
{
124
 
  Current Maximum Y coordinate;
125
 
}
126
 
Begin
127
 
  WinMaxY:=(WindMax shr 8) + 1;
128
 
End;
129
 
 
130
 
 
131
 
 
132
 
Function FullWin:boolean;
133
 
{
134
 
  Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
135
 
}
136
 
begin
137
 
  FullWin:=(WinMinX=1) and (WinMinY=1) and
138
 
           (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
139
 
end;
140
 
 
141
 
 
142
 
{****************************************************************************
143
 
                             Public Crt Functions
144
 
****************************************************************************}
145
 
 
146
 
 
147
 
procedure textmode(mode : integer);
148
 
 
149
 
var
150
 
   regs : trealregs;
151
 
 
152
 
begin
153
 
  lastmode:=mode;
154
 
  mode:=mode and $ff;
155
 
  setscreenmode(mode);
156
 
 
157
 
  { set 8x8 font }
158
 
  if (lastmode and $100)<>0 then
159
 
    begin
160
 
       regs.realeax:=$1112;
161
 
       regs.realebx:=$0;
162
 
       realintr($10,regs);
163
 
    end;
164
 
 
165
 
  screenwidth:=getscreenwidth;
166
 
  screenheight:=getscreenheight;
167
 
  windmin:=0;
168
 
  windmax:=(screenwidth-1) or ((screenheight-1) shl 8);
169
 
end;
170
 
 
171
 
 
172
 
Procedure TextColor(Color: Byte);
173
 
{
174
 
  Switch foregroundcolor
175
 
}
176
 
Begin
177
 
  TextAttr:=(Color and $f) or (TextAttr and $70);
178
 
  If (Color>15) Then TextAttr:=TextAttr Or Blink;
179
 
End;
180
 
 
181
 
 
182
 
 
183
 
Procedure TextBackground(Color: Byte);
184
 
{
185
 
  Switch backgroundcolor
186
 
}
187
 
Begin
188
 
  TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
189
 
End;
190
 
 
191
 
 
192
 
 
193
 
Procedure HighVideo;
194
 
{
195
 
  Set highlighted output.
196
 
}
197
 
Begin
198
 
  TextColor(TextAttr Or $08);
199
 
End;
200
 
 
201
 
 
202
 
 
203
 
Procedure LowVideo;
204
 
{
205
 
  Set normal output
206
 
}
207
 
Begin
208
 
  TextColor(TextAttr And $77);
209
 
End;
210
 
 
211
 
 
212
 
 
213
 
Procedure NormVideo;
214
 
{
215
 
  Set normal back and foregroundcolors.
216
 
}
217
 
Begin
218
 
  TextColor(7);
219
 
  TextBackGround(0);
220
 
End;
221
 
 
222
 
 
223
 
Procedure GotoXy(X: Byte; Y: Byte);
224
 
{
225
 
  Go to coordinates X,Y in the current window.
226
 
}
227
 
Begin
228
 
  If (X>0) and (X<=WinMaxX- WinMinX+1) and
229
 
     (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
230
 
   Begin
231
 
     Inc(X,WinMinX-1);
232
 
     Inc(Y,WinMinY-1);
233
 
     SetScreenCursor(x,y);
234
 
   End;
235
 
End;
236
 
 
237
 
 
238
 
Procedure Window(X1, Y1, X2, Y2: Byte);
239
 
{
240
 
  Set screen window to the specified coordinates.
241
 
}
242
 
Begin
243
 
  if (X1>X2) or (X2>ScreenWidth) or
244
 
     (Y1>Y2) or (Y2>ScreenHeight) then
245
 
   exit;
246
 
  WindMin:=((Y1-1) Shl 8)+(X1-1);
247
 
  WindMax:=((Y2-1) Shl 8)+(X2-1);
248
 
  GoToXY(1,1);
249
 
End;
250
 
 
251
 
 
252
 
Procedure ClrScr;
253
 
{
254
 
  Clear the current window, and set the cursor on 1,1
255
 
}
256
 
var
257
 
  fil : word;
258
 
  y   : longint;
259
 
begin
260
 
  fil:=32 or (textattr shl 8);
261
 
  if FullWin then
262
 
   DosmemFillWord(VidSeg,0,ScreenHeight*ScreenWidth,fil)
263
 
  else
264
 
   begin
265
 
     for y:=WinMinY to WinMaxY do
266
 
      DosmemFillWord(VidSeg,((y-1)*ScreenWidth+(WinMinX-1))*2,WinMaxX-WinMinX+1,fil);
267
 
   end;
268
 
  Gotoxy(1,1);
269
 
end;
270
 
 
271
 
 
272
 
Procedure ClrEol;
273
 
{
274
 
  Clear from current position to end of line.
275
 
}
276
 
var
277
 
  x,y : longint;
278
 
  fil : word;
279
 
Begin
280
 
  GetScreenCursor(x,y);
281
 
  fil:=32 or (textattr shl 8);
282
 
  if x<=WinMaxX then
283
 
   DosmemFillword(VidSeg,((y-1)*ScreenWidth+(x-1))*2,WinMaxX-x+1,fil);
284
 
End;
285
 
 
286
 
 
287
 
 
288
 
Function WhereX: Byte;
289
 
{
290
 
  Return current X-position of cursor.
291
 
}
292
 
var
293
 
  x,y : longint;
294
 
Begin
295
 
  GetScreenCursor(x,y);
296
 
  WhereX:=x-WinMinX+1;
297
 
End;
298
 
 
299
 
 
300
 
 
301
 
Function WhereY: Byte;
302
 
{
303
 
  Return current Y-position of cursor.
304
 
}
305
 
var
306
 
  x,y : longint;
307
 
Begin
308
 
  GetScreenCursor(x,y);
309
 
  WhereY:=y-WinMinY+1;
310
 
End;
311
 
 
312
 
 
313
 
{*************************************************************************
314
 
                            KeyBoard
315
 
*************************************************************************}
316
 
 
317
 
var
318
 
   is_last : boolean;
319
 
   last    : char;
320
 
 
321
 
function readkey : char;
322
 
var
323
 
  char2 : char;
324
 
  char1 : char;
325
 
  regs : trealregs;
326
 
begin
327
 
  if is_last then
328
 
   begin
329
 
     is_last:=false;
330
 
     readkey:=last;
331
 
   end
332
 
  else
333
 
   begin
334
 
     regs.ah:=$10;
335
 
     realintr($16,regs);
336
 
     if (regs.al=$e0) and (regs.ah<>0) then
337
 
      regs.al:=0;
338
 
     char1:=chr(regs.al);
339
 
     char2:=chr(regs.ah);
340
 
     if char1=#0 then
341
 
      begin
342
 
        is_last:=true;
343
 
        last:=char2;
344
 
      end;
345
 
     readkey:=char1;
346
 
   end;
347
 
end;
348
 
 
349
 
 
350
 
function keypressed : boolean;
351
 
var
352
 
  regs : trealregs;
353
 
begin
354
 
  if is_last then
355
 
   begin
356
 
     keypressed:=true;
357
 
     exit;
358
 
   end
359
 
  else
360
 
   begin
361
 
     regs.ah:=$11;
362
 
     realintr($16,regs);
363
 
     keypressed:=((regs.realflags and zeroflag) = 0);
364
 
   end;
365
 
end;
366
 
 
367
 
 
368
 
{*************************************************************************
369
 
                                   Delay
370
 
*************************************************************************}
371
 
 
372
 
procedure Delayloop;assembler;
373
 
asm
374
 
.LDelayLoop1:
375
 
        subl    $1,%eax
376
 
        jc      .LDelayLoop2
377
 
        cmpl    %fs:(%edi),%ebx
378
 
        je      .LDelayLoop1
379
 
.LDelayLoop2:
380
 
end;
381
 
 
382
 
 
383
 
procedure initdelay;assembler;
384
 
asm
385
 
        pushl %ebx
386
 
        pushl %edi
387
 
        { for some reason, using int $31/ax=$901 doesn't work here }
388
 
        { and interrupts are always disabled at this point when    }
389
 
        { running a program inside gdb(pas). Web bug 1345 (JM)     }
390
 
        sti
391
 
        movl    $0x46c,%edi
392
 
        movl    $-28,%edx
393
 
        movl    %fs:(%edi),%ebx
394
 
.LInitDel1:
395
 
        cmpl    %fs:(%edi),%ebx
396
 
        je      .LInitDel1
397
 
        movl    %fs:(%edi),%ebx
398
 
        movl    %edx,%eax
399
 
        call    DelayLoop
400
 
 
401
 
        notl    %eax
402
 
        xorl    %edx,%edx
403
 
        movl    $55,%ecx
404
 
        divl    %ecx
405
 
        movl    %eax,DelayCnt
406
 
        popl %edi
407
 
        popl %ebx
408
 
end;
409
 
 
410
 
 
411
 
procedure Delay(MS: Word);assembler;
412
 
asm
413
 
        pushl %ebx
414
 
        pushl %edi
415
 
        movzwl  MS,%ecx
416
 
        jecxz   .LDelay2
417
 
        movl    $0x400,%edi
418
 
        movl    DelayCnt,%edx
419
 
        movl    %fs:(%edi),%ebx
420
 
.LDelay1:
421
 
        movl    %edx,%eax
422
 
        call    DelayLoop
423
 
        loop    .LDelay1
424
 
.LDelay2:
425
 
        popl %edi
426
 
        popl %ebx
427
 
end;
428
 
 
429
 
 
430
 
procedure sound(hz : word);
431
 
begin
432
 
  if hz=0 then
433
 
   begin
434
 
     nosound;
435
 
     exit;
436
 
   end;
437
 
  asm
438
 
        movzwl  hz,%ecx
439
 
        movl    $1193046,%eax
440
 
        cltd
441
 
        divl    %ecx
442
 
        movl    %eax,%ecx
443
 
        inb     $0x61,%al
444
 
        testb   $0x3,%al
445
 
        jnz     .Lsound_next
446
 
        orb     $0x3,%al
447
 
        outb    %al,$0x61
448
 
        movb    $0xb6,%al
449
 
        outb    %al,$0x43
450
 
     .Lsound_next:
451
 
        movb    %cl,%al
452
 
        outb    %al,$0x42
453
 
        movb    %ch,%al
454
 
        outb    %al,$0x42
455
 
  end ['EAX','ECX','EDX'];
456
 
end;
457
 
 
458
 
 
459
 
procedure nosound;
460
 
begin
461
 
  asm
462
 
        inb     $0x61,%al
463
 
        andb    $0xfc,%al
464
 
        outb    %al,$0x61
465
 
  end ['EAX'];
466
 
end;
467
 
 
468
 
 
469
 
 
470
 
{****************************************************************************
471
 
                          HighLevel Crt Functions
472
 
****************************************************************************}
473
 
 
474
 
procedure removeline(y : longint);
475
 
var
476
 
  fil : word;
477
 
begin
478
 
  fil:=32 or (textattr shl 8);
479
 
  y:=WinMinY+y-1;
480
 
  While (y<WinMaxY) do
481
 
   begin
482
 
     dosmemmove(VidSeg,(y*ScreenWidth+(WinMinX-1))*2,
483
 
                VidSeg,((y-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
484
 
     inc(y);
485
 
   end;
486
 
  dosmemfillword(VidSeg,((WinMaxY-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
487
 
end;
488
 
 
489
 
 
490
 
procedure delline;
491
 
begin
492
 
  removeline(wherey);
493
 
end;
494
 
 
495
 
 
496
 
procedure insline;
497
 
var
498
 
  my,y : longint;
499
 
  fil : word;
500
 
begin
501
 
  fil:=32 or (textattr shl 8);
502
 
  y:=WhereY;
503
 
  my:=WinMaxY-WinMinY;
504
 
  while (my>=y) do
505
 
   begin
506
 
     dosmemmove(VidSeg,(((WinMinY+my-1)-1)*ScreenWidth+(WinMinX-1))*2,
507
 
                VidSeg,(((WinMinY+my)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
508
 
     dec(my);
509
 
   end;
510
 
  dosmemfillword(VidSeg,(((WinMinY+y-1)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
511
 
end;
512
 
 
513
 
 
514
 
 
515
 
 
516
 
{****************************************************************************
517
 
                             Extra Crt Functions
518
 
****************************************************************************}
519
 
 
520
 
procedure cursoron;
521
 
var
522
 
  regs : trealregs;
523
 
begin
524
 
  regs.realeax:=$0100;
525
 
  regs.realecx:=$90A;
526
 
  If VidSeg=$b800 then
527
 
    regs.realecx:=$90A
528
 
  else
529
 
    regs.realecx:=$b0d;
530
 
  realintr($10,regs);
531
 
end;
532
 
 
533
 
 
534
 
procedure cursoroff;
535
 
var
536
 
  regs : trealregs;
537
 
begin
538
 
  regs.realeax:=$0100;
539
 
  regs.realecx:=$ffff;
540
 
  realintr($10,regs);
541
 
end;
542
 
 
543
 
 
544
 
procedure cursorbig;
545
 
var
546
 
  regs : trealregs;
547
 
begin
548
 
  regs.realeax:=$0100;
549
 
  regs.realecx:=$10A;
550
 
  realintr($10,regs);
551
 
end;
552
 
 
553
 
 
554
 
{*****************************************************************************
555
 
                          Read and Write routines
556
 
*****************************************************************************}
557
 
 
558
 
var
559
 
  CurrX,CurrY : longint;
560
 
 
561
 
Procedure WriteChar(c:char);
562
 
var
563
 
  regs : trealregs;
564
 
begin
565
 
  case c of
566
 
   #10 : inc(CurrY);
567
 
   #13 : CurrX:=WinMinX;
568
 
    #8 : begin
569
 
           if CurrX>WinMinX then
570
 
            dec(CurrX);
571
 
         end;
572
 
    #7 : begin { beep }
573
 
           regs.dl:=7;
574
 
           regs.ah:=2;
575
 
           realintr($21,regs);
576
 
         end;
577
 
  else
578
 
   begin
579
 
     memw[VidSeg:((CurrY-1)*ScreenWidth+(CurrX-1))*2]:=(textattr shl 8) or byte(c);
580
 
     inc(CurrX);
581
 
   end;
582
 
  end;
583
 
  if CurrX>WinMaxX then
584
 
   begin
585
 
     CurrX:=WinMinX;
586
 
     inc(CurrY);
587
 
   end;
588
 
  while CurrY>WinMaxY do
589
 
   begin
590
 
     removeline(1);
591
 
     dec(CurrY);
592
 
   end;
593
 
end;
594
 
 
595
 
 
596
 
Function CrtWrite(var f : textrec):integer;
597
 
var
598
 
  i : longint;
599
 
begin
600
 
  GetScreenCursor(CurrX,CurrY);
601
 
  for i:=0 to f.bufpos-1 do
602
 
   WriteChar(f.buffer[i]);
603
 
  SetScreenCursor(CurrX,CurrY);
604
 
  f.bufpos:=0;
605
 
  CrtWrite:=0;
606
 
end;
607
 
 
608
 
 
609
 
Function CrtRead(Var F: TextRec): Integer;
610
 
 
611
 
  procedure BackSpace;
612
 
  begin
613
 
    if (f.bufpos>0) and (f.bufpos=f.bufend) then
614
 
     begin
615
 
       WriteChar(#8);
616
 
       WriteChar(' ');
617
 
       WriteChar(#8);
618
 
       dec(f.bufpos);
619
 
       dec(f.bufend);
620
 
     end;
621
 
  end;
622
 
 
623
 
var
624
 
  ch : Char;
625
 
Begin
626
 
  GetScreenCursor(CurrX,CurrY);
627
 
  f.bufpos:=0;
628
 
  f.bufend:=0;
629
 
  repeat
630
 
    if f.bufpos>f.bufend then
631
 
     f.bufend:=f.bufpos;
632
 
    SetScreenCursor(CurrX,CurrY);
633
 
    ch:=readkey;
634
 
    case ch of
635
 
    #0 : case readkey of
636
 
          #71 : while f.bufpos>0 do
637
 
                 begin
638
 
                   dec(f.bufpos);
639
 
                   WriteChar(#8);
640
 
                 end;
641
 
          #75 : if f.bufpos>0 then
642
 
                 begin
643
 
                   dec(f.bufpos);
644
 
                   WriteChar(#8);
645
 
                 end;
646
 
          #77 : if f.bufpos<f.bufend then
647
 
                 begin
648
 
                   WriteChar(f.bufptr^[f.bufpos]);
649
 
                   inc(f.bufpos);
650
 
                 end;
651
 
          #79 : while f.bufpos<f.bufend do
652
 
                 begin
653
 
                   WriteChar(f.bufptr^[f.bufpos]);
654
 
                   inc(f.bufpos);
655
 
                 end;
656
 
         end;
657
 
    ^S,
658
 
    #8 : BackSpace;
659
 
    ^Y,
660
 
   #27 : begin
661
 
           while f.bufpos<f.bufend do begin
662
 
            WriteChar(f.bufptr^[f.bufpos]);
663
 
            inc(f.bufpos);
664
 
           end;
665
 
           while f.bufend>0 do
666
 
            BackSpace;
667
 
         end;
668
 
   #13 : begin
669
 
           WriteChar(#13);
670
 
           WriteChar(#10);
671
 
           f.bufptr^[f.bufend]:=#13;
672
 
           f.bufptr^[f.bufend+1]:=#10;
673
 
           inc(f.bufend,2);
674
 
           break;
675
 
         end;
676
 
   #26 : if CheckEOF then
677
 
          begin
678
 
            f.bufptr^[f.bufend]:=#26;
679
 
            inc(f.bufend);
680
 
            break;
681
 
          end;
682
 
    else
683
 
     begin
684
 
       if f.bufpos<f.bufsize-2 then
685
 
        begin
686
 
          f.buffer[f.bufpos]:=ch;
687
 
          inc(f.bufpos);
688
 
          WriteChar(ch);
689
 
        end;
690
 
     end;
691
 
    end;
692
 
  until false;
693
 
  f.bufpos:=0;
694
 
  SetScreenCursor(CurrX,CurrY);
695
 
  CrtRead:=0;
696
 
End;
697
 
 
698
 
 
699
 
Function CrtReturn(Var F: TextRec): Integer;
700
 
Begin
701
 
  CrtReturn:=0;
702
 
end;
703
 
 
704
 
 
705
 
Function CrtClose(Var F: TextRec): Integer;
706
 
Begin
707
 
  F.Mode:=fmClosed;
708
 
  CrtClose:=0;
709
 
End;
710
 
 
711
 
 
712
 
Function CrtOpen(Var F: TextRec): Integer;
713
 
Begin
714
 
  If F.Mode=fmOutput Then
715
 
   begin
716
 
     TextRec(F).InOutFunc:=@CrtWrite;
717
 
     TextRec(F).FlushFunc:=@CrtWrite;
718
 
   end
719
 
  Else
720
 
   begin
721
 
     F.Mode:=fmInput;
722
 
     TextRec(F).InOutFunc:=@CrtRead;
723
 
     TextRec(F).FlushFunc:=@CrtReturn;
724
 
   end;
725
 
  TextRec(F).CloseFunc:=@CrtClose;
726
 
  CrtOpen:=0;
727
 
End;
728
 
 
729
 
 
730
 
procedure AssignCrt(var F: Text);
731
 
begin
732
 
  Assign(F,'');
733
 
  TextRec(F).OpenFunc:=@CrtOpen;
734
 
end;
735
 
 
736
 
{ use the C version to avoid using dpmiexcp unit
737
 
  which makes sysutils and exceptions working incorrectly  PM }
738
 
 
739
 
function __djgpp_set_ctrl_c(enable : longint) : boolean;cdecl;external;
740
 
 
741
 
var
742
 
  x,y : longint;
743
 
begin
744
 
{ Load startup values }
745
 
  ScreenWidth:=GetScreenWidth;
746
 
  ScreenHeight:=GetScreenHeight;
747
 
  WindMax:=(ScreenWidth-1) or ((ScreenHeight-1) shl 8);
748
 
{ Load TextAttr }
749
 
  GetScreenCursor(x,y);
750
 
  lastmode := mem[$40:$49];
751
 
  if screenheight>25 then
752
 
    lastmode:=lastmode or $100;
753
 
  If not(lastmode=Mono) then
754
 
    VidSeg := $b800
755
 
  else
756
 
    VidSeg := $b000;
757
 
  TextAttr:=mem[VidSeg:((y-1)*ScreenWidth+(x-1))*2+1];
758
 
{ Redirect the standard output }
759
 
  assigncrt(Output);
760
 
  Rewrite(Output);
761
 
  TextRec(Output).Handle:=StdOutputHandle;
762
 
  assigncrt(Input);
763
 
  Reset(Input);
764
 
  TextRec(Input).Handle:=StdInputHandle;
765
 
{ Calculates delay calibration }
766
 
  initdelay;
767
 
{ Enable ctrl-c input (JM) }
768
 
  __djgpp_set_ctrl_c(0);
769
 
end.
770
 
 
771
 
{
772
 
  $Log: crt.pp,v $
773
 
  Revision 1.11  2004/02/08 16:22:20  michael
774
 
  + Moved CRT interface to common include file
775
 
 
776
 
  Revision 1.10  2003/10/03 21:56:36  peter
777
 
    * stdcall fixes
778
 
 
779
 
  Revision 1.9  2003/03/17 18:13:13  peter
780
 
    * exported ScreenHeight, ScreenWidth
781
 
 
782
 
  Revision 1.8  2002/12/15 20:22:24  peter
783
 
    * fix making string empty in readln when cursor is not at the end
784
 
 
785
 
  Revision 1.7  2002/09/10 10:38:04  pierre
786
 
   * merged from fixes: fix bug report 1974
787
 
 
788
 
  Revision 1.6  2002/09/07 16:01:18  peter
789
 
    * old logs removed and tabs fixed
790
 
 
791
 
}