* updated crt with new delay, almost like bp7 routine

rtl/dos/crt.pp

@@ -12,883 +12,936 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{
-  history:
-  29th may 1994: version 1.0
-             unit is completed
-  14th june 1994: version 1.01
-             the address from which startaddr was read wasn't right; fixed
-  18th august 1994: version 1.1
-             the upper left corner of winmin is now 0,0
-  19th september 1994: version 1.11
-             keypressed handles extended keycodes false; fixed
-  27th february 1995: version 1.12
-             * crtinoutfunc didn't the line wrap in the right way;
-               fixed
-  20th january 1996: version 1.13
-             - unused variables removed
-  21th august 1996: version 1.14
-             * adapted to newer FPKPascal versions
-             * make the comments english
-   6th november 1996: version 1.49
-             * some stuff for DPMI adapted
-  15th november 1996: version 1.5
-             * bug in screenrows fixed
-  13th november 1997: removed textrec definition, is now included from 
-               textrec.inc
-}
-
 unit crt;
+interface
 
-{$I os.inc}
-
-  interface
-  
-    uses
-       go32;
-
-    const
-       { screen modes }
-       bw40 = 0;
-       co40 = 1;
-       bw80 = 2;
-       co80 = 3;
-       mono = 7;
-       font8x8 = 256;
-
-       { screen color, fore- and background }
-       black = 0;
-       blue = 1;
-       green = 2;
-       cyan = 3;
-       red = 4;
-       magenta = 5;
-       brown = 6;
-       lightgray = 7;
-
-       { only foreground }
-       darkgray = 8;
-       lightblue = 9;
-       lightgreen = 10;
-       lightcyan = 11;
-       lightred = 12;
-       lightmagenta = 13;
-       yellow = 14;
-       white = 15;
-
-       { blink flag }
-       blink = $80;
-
-    const
-    {$ifndef GO32V2}
-       directvideo:boolean=true;
-    {$else GO32V2}
-       { direct video generates a GPF in DPMI of setcursor }
-       directvideo:boolean=false;
-    {$endif GO32V2}
-
-    var
-       { for compatibility }
-       checkbreak,checkeof,checksnow : boolean;
-
-       lastmode : word; { screen mode}
-       textattr : byte; { current text attribute }
-       windmin  : word; { upper right corner of the CRT window }
-       windmax  : word; { lower left corner of the CRT window }
-
-    function keypressed : boolean;
-    function readkey : char;
-    procedure gotoxy(x,y : byte);
-    procedure window(left,top,right,bottom : byte);
-    procedure clrscr;
-    procedure textcolor(color : byte);
-    procedure textbackground(color : byte);
-    procedure assigncrt(var f : text);
-    function wherex : byte;
-    function wherey : byte;
-    procedure delline;
-    procedure delline(line : byte);
-    procedure clreol;
-    procedure insline;
-    procedure cursoron;
-    procedure cursoroff;
-    procedure cursorbig;
-    procedure lowvideo;
-    procedure highvideo;
-    procedure nosound;
-    procedure sound(hz : word);
-    procedure delay(ms : longint);
-    procedure textmode(mode : integer);
-    procedure normvideo;
-    
-  implementation
-  
-    var
-       maxcols,maxrows : longint;
-
-    { definition of textrec is in textrec.inc}
-
-    {$i textrec.inc}
-
-    { low level routines }
-
-    function getscreenmode : byte;
-
-      begin
-         dosmemget($40,$49,getscreenmode,1);
-      end;
-
-    procedure setscreenmode(mode : byte);
+  var
+    DelayCnt : longint;
 
-     var regs : trealregs;
-
-      begin
-{$ifdef GO32V2}
-         regs.realeax:=mode;
-         realintr($10,regs);
-{$else GO32V2}
-         asm
-            movb 8(%ebp),%al
-            xorb %ah,%ah
-            pushl %ebp
-            int $0x10
-            popl %ebp
-         end;
-{$endif GO32V2}
-      end;
+{$I os.inc}
 
-    function screenrows : byte;
+{$I386_ATT}
+
+const
+{ CRT modes }
+  BW40          = 0;            { 40x25 B/W on Color Adapter }
+  CO40          = 1;            { 40x25 Color on Color Adapter }
+  BW80          = 2;            { 80x25 B/W on Color Adapter }
+  CO80          = 3;            { 80x25 Color on Color Adapter }
+  Mono          = 7;            { 80x25 on Monochrome Adapter }
+  Font8x8       = 256;          { Add-in for ROM font }
+
+{ Mode constants for 3.0 compatibility }
+  C40           = CO40;
+  C80           = CO80;
+
+{ Foreground and background color constants }
+  Black         = 0;
+  Blue          = 1;
+  Green         = 2;
+  Cyan          = 3;
+  Red           = 4;
+  Magenta       = 5;
+  Brown         = 6;
+  LightGray     = 7;
+
+{ Foreground color constants }
+  DarkGray      = 8;
+  LightBlue     = 9;
+  LightGreen    = 10;
+  LightCyan     = 11;
+  LightRed      = 12;
+  LightMagenta  = 13;
+  Yellow        = 14;
+  White         = 15;
+
+{ Add-in for blinking }
+  Blink         = 128;
 
-      begin
-         dosmemget($40,$84,screenrows,1);
-         { don't forget this: }
-         inc(screenrows);
-      end;
+var
 
-    function screencols : byte;
+{ Interface variables }
+  CheckBreak: Boolean;    { Enable Ctrl-Break }
+  CheckEOF: Boolean;      { Enable Ctrl-Z }
+  DirectVideo: Boolean;   { Enable direct video addressing }
+  CheckSnow: Boolean;     { Enable snow filtering }
+  LastMode: Word;         { Current text mode }
+  TextAttr: Byte;         { Current text attribute }
+  WindMin: Word;          { Window upper left coordinates }
+  WindMax: Word;          { Window lower right coordinates }
+
+{ Interface procedures }
+procedure AssignCrt(var F: Text);
+function KeyPressed: Boolean;
+function ReadKey: Char;
+procedure TextMode(Mode: Integer);
+procedure Window(X1,Y1,X2,Y2: Byte);
+procedure GotoXY(X,Y: Byte);
+function WhereX: Byte;
+function WhereY: Byte;
+procedure ClrScr;
+procedure ClrEol;
+procedure InsLine;
+procedure DelLine;
+procedure TextColor(Color: Byte);
+procedure TextBackground(Color: Byte);
+procedure LowVideo;
+procedure HighVideo;
+procedure NormVideo;
+procedure Delay(MS: Word);
+procedure Sound(Hz: Word);
+procedure NoSound;
+
+{Extra Functions}
+procedure cursoron;
+procedure cursoroff;
+procedure cursorbig;
+
+
+implementation
+
+uses
+  go32;
+
+{$I386_ATT} {can be removed in the future}
+
+{$ASMMODE ATT}
 
-      begin
-         dosmemget($40,$4a,screencols,1);
-      end;
+var
+  ScreenWidth,
+  ScreenHeight : longint;
 
-    function get_addr(row,col : byte) : word;
 
-      begin
-         get_addr:=((row-1)*maxcols+(col-1))*2;
-      end;
+{
+  definition of textrec is in textrec.inc
+}
+{$i textrec.inc}
 
-    procedure screensetcursor(row,col : longint);
 
-      var
-         cols : byte;
-         pos : word;
+{****************************************************************************
+                           Low level Routines
+****************************************************************************}
 
+procedure setscreenmode(mode : byte);
 {$ifdef GO32V2}
-         regs : trealregs;
+var
+  regs : trealregs;
 {$endif GO32V2}
-      begin
-         if directvideo then
-           begin
-              { set new position for the BIOS }
-              dosmemput($40,$51,row,1);
-              dosmemput($40,$50,col,1);
-
-              { calculates screen position }
-              dosmemget($40,$4a,cols,1);
-              { FPKPascal calculates with 32 bit }
-              pos:=row*cols+col;
-
-              { direct access to the graphics card registers }
-              outportb($3d4,$0e);
-              outportb($3d5,hi(pos));
-              outportb($3d4,$0f);
-              outportb($3d5,lo(pos));
-           end
-         else
-{$ifndef GO32V2}
-            asm
-               movb     $0x02,%ah
-               movb     $0,%bh
-               movb     row,%dh
-               movb     col,%dl
-               pushl    %ebp
-               int      $0x10
-               popl     %ebp
-            end;
+begin
+{$ifdef GO32V2}
+  regs.realeax:=mode;
+  realintr($10,regs);
 {$else GO32V2}
-            regs.realeax:=$0200;
-            regs.realebx:=0;
-            regs.realedx:=row*$100+col;
-            realintr($10,regs);
+  asm
+        movb    8(%ebp),%al
+        xorb    %ah,%ah
+        pushl   %ebp
+        int     $0x10
+        popl    %ebp
+  end;
 {$endif GO32V2}
-       end;
+end;
 
-    procedure screengetcursor(var row,col : longint);
 
-      begin
-         col:=0;
-         row:=0;
-         dosmemget($40,$50,col,1);
-         dosmemget($40,$51,row,1);
-      end;
-
-    { exported routines }
+function GetScreenHeight : longint;
+begin
+{$ifdef GO32V2}
+  getscreenheight:=mem[$40:$84]+1;
+{$else}
+  dosmemget($40,$84,getscreenheight,1);
+  inc(getscreenheight);
+{$endif}
+end;
 
-    procedure cursoron;
 
+function GetScreenWidth : longint;
+begin
 {$ifdef GO32V2}
-    var     regs : trealregs;
-{$endif GO32V2}
-      begin
-{$ifndef GO32V2}
-         asm
-            movb   $1,%ah
-            movb   $10,%cl
-            movb   $9,%ch
-            pushl %ebp
-            int   $0x10
-            popl %ebp
-         end;
-{$else GO32V2}
-            regs.realeax:=$0100;
-            regs.realecx:=$90A;
-            realintr($10,regs);
-{$endif GO32V2}
-      end;
+  getscreenwidth:=mem[$40:$4a];
+{$else}
+  dosmemget($40,$4a,getscreenwidth,1);
+{$endif}
+end;
 
-    procedure cursoroff;
 
+procedure SetScreenCursor(x,y : longint);
 {$ifdef GO32V2}
-    var     regs : trealregs;
+var
+  regs : trealregs;
 {$endif GO32V2}
-      begin
-{$ifndef GO32V2}
-         asm
-            movb   $1,%ah
-            movb   $-1,%cl
-            movb   $-1,%ch
-            pushl %ebp
-            int   $0x10
-            popl %ebp
-         end;
+begin
+{$ifdef GO32V2}
+  regs.realeax:=$0200;
+  regs.realebx:=0;
+  regs.realedx:=(y-1) shl 8+(x-1);
+  realintr($10,regs);
 {$else GO32V2}
-            regs.realeax:=$0100;
-            regs.realecx:=$ffff;
-            realintr($10,regs);
+  asm
+        movb    $0x02,%ah
+        movb    $0,%bh
+        movb    y,%dh
+        movb    x,%dl
+        subw    $0x0101,%dx
+        pushl   %ebp
+        int     $0x10
+        popl    %ebp
+  end;
 {$endif GO32V2}
-      end;
+end;
 
-    procedure cursorbig;
 
-{$ifdef GO32V2}
-    var     regs : trealregs;
-{$endif GO32V2}
-      begin
-{$ifdef GO32V2}
-            regs.realeax:=$0100;
-            regs.realecx:=$10A;
-            realintr($10,regs);
-{$else GO32V2}
-         asm
-            movb   $1,%ah
-            movb   $10,%cl
-            movb   $1,%ch
-            pushl %ebp
-            int   $0x10
-            popl %ebp
-         end;
+procedure GetScreenCursor(var x,y : longint);
+begin
+{$ifdef Go32V2}
+  x:=mem[$40:$50]+1;
+  y:=mem[$40:$51]+1;
+{$else Go32V2}
+  x:=0;
+  y:=0;
+  dosmemget($40,$50,x,1);
+  dosmemget($40,$51,y,1);
+  inc(x);
+  inc(y);
 {$endif GO32V2}
-      end;
+end;
 
-    var
-       is_last : boolean;
-       last : char;
 
-    function readkey : char;
+{****************************************************************************
+                              Helper Routines
+****************************************************************************}
 
-      var
-         char2 : char;
-         char1 : char;
-{$ifdef GO32V2}
-    var     regs : trealregs;
-{$endif GO32V2}
+Function WinMinX: Byte;
+{
+  Current Minimum X coordinate
+}
+Begin
+  WinMinX:=(WindMin and $ff)+1;
+End;
 
-      begin
-         if is_last then
-           begin
-              is_last:=false;
-              readkey:=last;
-           end
-         else
-           begin
-{$ifdef GO32V2}
-            regs.realeax:=$0000;
-            realintr($16,regs);
-            byte(char1):=regs.realeax and $ff;
-            byte(char2):=(regs.realeax and $ff00) div $100;
-{$else GO32V2}
-              asm
-                 movb $0,%ah
-                 pushl %ebp
-                 int $0x16
-                 popl %ebp
-                 movw %ax,-2(%ebp)
-              end;
-{$endif GO32V2}
-              if char1=#0 then
-                begin
-                   is_last:=true;
-                   last:=char2;
-                end;
-              readkey:=char1;
-           end;
-      end;
 
-    function keypressed : boolean;
 
-{$ifdef GO32V2}
-   var regs : trealregs;
-{$endif GO32V2}
-      begin
-         if is_last then
-           begin
-              keypressed:=true;
-              exit;
-           end
-         else
-{$ifdef GO32V2}
-         begin
-            regs.realeax:=$0100;
-            realintr($16,regs);
-            if (regs.realflags and zeroflag) = 0 then
-              keypressed:=true
-              else keypressed:=false;
-         end;
-{$else GO32V2}
-           asm
-              movb $1,%ah
-              pushl %ebp
-              int $0x16
-              popl %ebp
-              setnz %al
-              movb %al,__RESULT
-           end;
-{$endif GO32V2}
-      end;
+Function WinMinY: Byte;
+{
+  Current Minimum Y Coordinate
+}
+Begin
+  WinMinY:=(WindMin shr 8)+1;
+End;
 
-   procedure gotoxy(x,y : byte);
 
-     begin
-        if (x<1) then
-          x:=1;
-        if (y<1) then
-          y:=1;
-        if y+hi(windmin)-2>=hi(windmax) then
-          y:=hi(windmax)-hi(windmin)+1;
-        if x+lo(windmin)-2>=lo(windmax) then
-          x:=lo(windmax)-lo(windmin)+1;
-        screensetcursor(y+hi(windmin)-1,x+lo(windmin)-1);
-     end;
 
-   function wherex : byte;
+Function WinMaxX: Byte;
+{
+  Current Maximum X coordinate
+}
+Begin
+  WinMaxX:=(WindMax and $ff)+1;
+End;
 
-     var
-        row,col : longint;
 
-     begin
-        screengetcursor(row,col);
-        wherex:=col-lo(windmin)+1;
-     end;
 
-   function wherey : byte;
+Function WinMaxY: Byte;
+{
+  Current Maximum Y coordinate;
+}
+Begin
+  WinMaxY:=(WindMax shr 8) + 1;
+End;
 
-     var
-        row,col : longint;
 
-     begin
-        screengetcursor(row,col);
-        wherey:=row-hi(windmin)+1;
-     end;
 
-   procedure window(left,top,right,bottom : byte);
+Function FullWin:boolean;
+{
+  Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
+begin
+  FullWin:=(WindMax-WindMin=$184f);
+end;
 
-     begin
-        if (left<1) or
-           (right>screencols) or
-           (bottom>screenrows) or
-           (left>right) or
-           (top>bottom) then
-           exit;
-        windmin:=(left-1) or ((top-1) shl 8);
-        windmax:=(right-1) or ((bottom-1) shl 8);
-        gotoxy(1,1);
-     end;
 
-   procedure clrscr;
+{****************************************************************************
+                             Public Crt Functions
+****************************************************************************}
 
-     var
-        fil : word;
-        row : longint;
 
-     begin
-        fil:=32 or (textattr shl 8);
-        for row:=hi(windmin) to hi(windmax) do
-          dosmemfillword($b800,get_addr(row+1,lo(windmin)+1),lo(windmax)-lo(windmin)+1,fil);
-        gotoxy(1,1);
-     end;
+procedure textmode(mode : integer);
+begin
+  lastmode:=mode;
+  mode:=mode and $ff;
+  setscreenmode(mode);
+  screenwidth:=getscreenwidth;
+  screenheight:=getscreenheight;
+  windmin:=0;
+  windmax:=(screenwidth-1) or ((screenheight-1) shl 8);
+end;
 
-   procedure textcolor(color : Byte);
 
-     begin
-        textattr:=(textattr and $70) or color;
-     end;
+Procedure TextColor(Color: Byte);
+{
+  Switch foregroundcolor
+}
+Begin
+  TextAttr:=(Color and $8f) or (TextAttr and $70);
+End;
 
-   procedure lowvideo;
 
-     begin
-        textattr:=textattr and $f7;
-     end;
 
-   procedure highvideo;
+Procedure TextBackground(Color: Byte);
+{
+  Switch backgroundcolor
+}
+Begin
+  TextAttr:=(Color shl 4) or (TextAttr and $0f);
+End;
 
-     begin
-        textattr:=textattr or $08;
-     end;
 
-   procedure textbackground(color : Byte);
 
-     begin
-        textattr:=(textattr and $8f) or ((color and $7) shl 4);
-     end;
+Procedure HighVideo;
+{
+  Set highlighted output.
+}
+Begin
+  TextColor(TextAttr Or $08);
+End;
 
-   var
-      startattrib : byte;
 
-   procedure normvideo;
 
-     begin
-        textattr:=startattrib;
-     end;
+Procedure LowVideo;
+{
+  Set normal output
+}
+Begin
+  TextColor(TextAttr And $77);
+End;
 
-   procedure delline(line : byte);
 
-     var
-        row,left,right,bot : longint;
-        fil : word;
 
-     begin
-        row:=line+hi(windmin);
-        left:=lo(windmin)+1;
-        right:=lo(windmax)+1;
-        bot:=hi(windmax)+1;
-        fil:=32 or (textattr shl 8);
-        while (row<bot) do
-          begin
-             dosmemmove($b800,get_addr(row+1,left),$b800,get_addr(row,left),(right-left+1)*2);
-             inc(row);
-          end;
-        dosmemfillword($b800,get_addr(bot,left),right-left+1,fil);
-     end;
+Procedure NormVideo;
+{
+  Set normal back and foregroundcolors.
+}
+Begin
+  TextColor(7);
+  TextBackGround(0);
+End;
 
-   procedure delline;
 
-     begin
-        delline(wherey);
-     end;
+Procedure GotoXy(X: Byte; Y: Byte);
+{
+  Go to coordinates X,Y in the current window.
+}
+Begin
+  If (X>0) and (X<=WinMaxX- WinMinX+1) and
+     (Y>0) and (Y<=WinMaxY-WinMinY+1) Then
+   Begin
+     Inc(X,WinMinX-1);
+     Inc(Y,WinMinY-1);
+     SetScreenCursor(x,y);
+   End;
+End;
+
+
+Procedure Window(X1, Y1, X2, Y2: Byte);
+{
+  Set screen window to the specified coordinates.
+}
+Begin
+  if (X1>X2) or (X2>ScreenWidth) or
+     (Y1>Y2) or (Y2>ScreenHeight) then
+   exit;
+  WindMin:=((Y1-1) Shl 8)+(X1-1);
+  WindMax:=((Y2-1) Shl 8)+(X2-1);
+  GoToXY(1,1);
+End;
+
+
+Procedure ClrScr;
+{
+  Clear the current window, and set the cursor on 1,1
+}
+var
+  fil : word;
+  y   : longint;
+begin
+  fil:=32 or (textattr shl 8);
+  if FullWin then
+   DosmemFillWord($b800,0,ScreenHeight*ScreenWidth,fil)
+  else
+   begin
+     for y:=WinMinY to WinMaxY do
+      DosmemFillWord($b800,((y-1)*ScreenWidth+(WinMinX-1))*2,WinMaxX-WinMinX+1,fil);
+   end;
+  Gotoxy(1,1);
+end;
+
+
+Procedure ClrEol;
+{
+  Clear from current position to end of line.
+}
+var
+  x,y : longint;
+  fil : word;
+Begin
+  GetScreenCursor(x,y);
+  fil:=32 or (textattr shl 8);
+  if x<WinMaxX then
+   DosmemFillword($b800,((y-1)*ScreenWidth+(x-1))*2,WinMaxX-x+1,fil);
+End;
 
-   procedure insline;
 
-     var
-        row,col,left,right,bot : longint;
-        fil : word;
 
-     begin
-        screengetcursor(row,col);
-        inc(row);
-        left:=lo(windmin)+1;
-        right:=lo(windmax)+1;
-        bot:=hi(windmax);
-        fil:=32 or (textattr shl 8);
-        while (bot>row) do
-          begin
-             dosmemmove($b800,get_addr(bot-1,left),$b800,get_addr(bot,left),(right-left+1)*2);
-             dec(bot);
-          end;
-        dosmemfillword($b800,get_addr(row,left),right-left+1,fil);
-     end;
+Function WhereX: Byte;
+{
+  Return current X-position of cursor.
+}
+var
+  x,y : longint;
+Begin
+  GetScreenCursor(x,y);
+  WhereX:=x-WinMinX+1;
+End;
 
-   procedure clreol;
 
-     var
-        row,col : longint;
-        fil : word;
 
-     begin
-        screengetcursor(row,col);
-        inc(row);
-        inc(col);
-        fil:=32 or (textattr shl 8);
-        dosmemfillword($b800,get_addr(row,col),lo(windmax)-col+2,fil);
-     end;
+Function WhereY: Byte;
+{
+  Return current Y-position of cursor.
+}
+var
+  x,y : longint;
+Begin
+  GetScreenCursor(x,y);
+  WhereY:=y-WinMinY+1;
+End;
 
 
-   Function CrtWrite(var f : textrec):integer;
+{*************************************************************************
+                            KeyBoard
+*************************************************************************}
 
-      var
-         i,col,row : longint;
-         c : char;
-         va,sa : word;
+var
+   is_last : boolean;
+   last    : char;
 
+function readkey : char;
+var
+  char2 : char;
+  char1 : char;
+{$ifdef GO32V2}
+  regs : trealregs;
+{$endif GO32V2}
+begin
+  if is_last then
+   begin
+     is_last:=false;
+     readkey:=last;
+   end
+  else
+   begin
+{$ifdef GO32V2}
+     regs.realeax:=$0000;
+     realintr($16,regs);
+     char1:=chr(regs.realeax and $ff);
+     char2:=chr((regs.realeax and $ff00) shr 8);
+{$else GO32V2}
+     asm
+        movb    $0,%ah
+        pushl   %ebp
+        int     $0x16
+        popl    %ebp
+        movb    %al,char1
+        movb    %ah,char2
+     end;
+{$endif GO32V2}
+     if char1=#0 then
       begin
-         screengetcursor(row,col);
-         inc(row);
-         inc(col);
-         va:=get_addr(row,col);
-         for i:=0 to f.bufpos-1 do
-           begin
-              c:=f.buffer[i];
-              case ord(c) of
-                 10 : begin
-                         inc(row);
-                         va:=va+maxcols*2;
-                      end;
-                 13 : begin
-                         col:=lo(windmin)+1;
-                         va:=get_addr(row,col);
-                     end;
-                 8 : if col>lo(windmin)+1 then
-                       begin
-                          dec(col);
-                          va:=va-2;
-                       end;
-                 7 : begin
-                         { beep }
-                      end;
-              else
-                 begin
-                    sa:=textattr shl 8 or ord(c);
-                    dosmemput($b800,va,sa,sizeof(sa));
-                    inc(col);
-                    va:=va+2;
-                 end;
-              end;
-              if col>lo(windmax)+1 then
-                begin
-                   col:=lo(windmin)+1;
-                   inc(row);
-                   { it's easier to calculate the new address }
-                   { it don't spend much time                 }
-                   va:=get_addr(row,col);
-                end;
-              while row>hi(windmax)+1 do
-                begin
-                   delline(1);
-                   dec(row);
-                   va:=va-maxcols*2;
-                end;
-           end;
-         f.bufpos:=0;
-         screensetcursor(row-1,col-1);
-         CrtWrite:=0;
+        is_last:=true;
+        last:=char2;
       end;
+     readkey:=char1;
+   end;
+end;
 
-   Function CrtClose(Var F: TextRec): Integer;
-     Begin
-       F.Mode:=fmClosed;
-       CrtClose:=0;
-     End;
-
-   Function CrtOpen(Var F: TextRec): Integer;
-     Begin
-       If F.Mode = fmOutput Then
-        CrtOpen:=0
-       Else
-        CrtOpen:=5;
-     End;
-
-   Function CrtRead(Var F: TextRec): Integer;
-     Begin
-     {$IFDEF GO32V2}
-       f.bufend:=do_read(f.handle,longint(f.bufptr),f.bufsize);
-     {$ENDIF}
-       f.bufpos:=0;
-       CrtRead:=0;
-     End;
-
-   Function CrtInOut(Var F: TextRec): Integer;
-     Begin
-       Case F.Mode of
-        fmInput: CrtInOut:=CrtRead(F);
-        fmOutput: CrtInOut:=CrtWrite(F);
-       End;
-     End;
-
-   procedure assigncrt(var f : text);
-     begin
-        TextRec(F).Mode:=fmClosed;
-        TextRec(F).BufSize:=SizeOf(TextBuf);
-        TextRec(F).BufPtr:=@TextRec(F).Buffer;
-        TextRec(F).BufPos:=0;
-        TextRec(F).OpenFunc:=@CrtOpen;
-        TextRec(F).InOutFunc:=@CrtInOut;
-        TextRec(F).FlushFunc:=@CrtInOut;
-        TextRec(F).CloseFunc:=@CrtClose;
-        TextRec(F).Name[0]:='.';
-        TextRec(F).Name[1]:=#0;
+
+function keypressed : boolean;
+{$ifdef GO32V2}
+var
+  regs : trealregs;
+{$endif GO32V2}
+begin
+  if is_last then
+   begin
+     keypressed:=true;
+     exit;
+   end
+  else
+   begin
+{$ifdef GO32V2}
+     regs.realeax:=$0100;
+     realintr($16,regs);
+     keypressed:=((regs.realflags and zeroflag) = 0);
+{$else GO32V2}
+     asm
+        movb    $1,%ah
+        pushl   %ebp
+        int     $0x16
+        popl    %ebp
+        setnz   %al
+        movb    %al,__RESULT
      end;
+{$endif GO32V2}
+   end;
+end;
 
-   procedure sound(hz : word);
 
-     begin
-        if hz=0 then
-          begin
-             nosound;
-             exit;
-          end;
-        asm
-           movzwl hz,%ecx
-           movl $1193046,%eax
-	   cdq
-           divl %ecx
-           movl %eax,%ecx
-           movb $0xb6,%al
-           outb %al,$0x43
-           movb %cl,%al
-           outb %al,$0x42
-           movb %ch,%al
-           outb %al,$0x42
-           inb $0x61,%al
-           orb $0x3,%al
-           outb %al,$0x61
-        end ['EAX','ECX','EDX'];
-     end;
+{*************************************************************************
+                                   Delay
+*************************************************************************}
+
+procedure Delayloop;
+begin
+  asm
+.LDelayLoop1:
+        subl    $1,%eax
+        jc      .LDelayLoop2
+        cmpl    %fs:(%edi),%ebx
+        je      .LDelayLoop1
+.LDelayLoop2:
+  end;
+end;
+
+
+procedure initdelay;
+begin
+  asm
+        movl    $0x46c,%edi
+        movl    $-28,%edx
+        movl    %fs:(%edi),%ebx
+.LInitDel1:
+        cmpl    %fs:(%edi),%ebx
+        je      .LInitDel1
+        movl    %fs:(%edi),%ebx
+        movl    %edx,%eax
+        call    DelayLoop
+
+        notl    %eax
+        xorl    %edx,%edx
+        movl    $55,%ecx
+        divl    %ecx
+        movl    %eax,DelayCnt
+  end;
+end;
+
+
+procedure Delay(MS: Word);
+begin
+  asm
+        movzwl  MS,%ecx
+        jecxz   .LDelay2
+        movl    $0x400,%edi
+        movl    DelayCnt,%edx
+        movl    %fs:(%edi),%ebx
+.LDelay1:
+        movl    %edx,%eax
+        call    DelayLoop
+        loop    .LDelay1
+.LDelay2:
+  end;
+end;
+
+
+procedure sound(hz : word);
+begin
+  if hz=0 then
+   begin
+     nosound;
+     exit;
+   end;
+  asm
+        movzwl  hz,%ecx
+        movl    $1193046,%eax
+        cdq
+        divl    %ecx
+        movl    %eax,%ecx
+        movb    $0xb6,%al
+        outb    %al,$0x43
+        movb    %cl,%al
+        outb    %al,$0x42
+        movb    %ch,%al
+        outb    %al,$0x42
+        inb     $0x61,%al
+        orb     $0x3,%al
+        outb    %al,$0x61
+  end ['EAX','ECX','EDX'];
+end;
+
+
+procedure nosound;
+begin
+  asm
+        inb     $0x61,%al
+        andb    $0xfc,%al
+        outb    %al,$0x61
+  end ['EAX'];
+end;
 
-   procedure nosound;
 
-     begin
-        asm
-           inb $0x61,%al
-           andb $0xfc,%al
-           outb %al,$0x61
-        end ['EAX'];
-     end;
 
-   var
-      calibration : longint;
+{****************************************************************************
+                          HighLevel Crt Functions
+****************************************************************************}
 
-   procedure delay(ms : longint);
+procedure removeline(y : longint);
+var
+  fil : word;
+begin
+  fil:=32 or (textattr shl 8);
+  While (y<WinMaxY) do
+   begin
+     dosmemmove($b800,(((WinMinY+y)-1)*ScreenWidth+(WinMinX-1))*2,
+                $b800,(((WinMinY+y-1)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
+     inc(y);
+   end;
+  dosmemfillword($b800,((WinMaxY-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
+end;
+
+
+procedure delline;
+begin
+  removeline(wherey);
+end;
 
-      var
-         i,j : longint;
 
-     begin
-        for i:=1 to ms do
-          for j:=1 to calibration do
-             begin
-             end;
-     end;
+procedure insline;
+var
+  my,y : longint;
+  fil : word;
+begin
+  fil:=32 or (textattr shl 8);
+  y:=WhereY;
+  my:=WinMaxY-1;
+  while (my>=y) do
+   begin
+     dosmemmove($b800,(((WinMinY+my-1)-1)*ScreenWidth+(WinMinX-1))*2,
+                $b800,(((WinMinY+my)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1)*2);
+     dec(my);
+   end;
+  dosmemfillword($b800,(((WinMinY+y-1)-1)*ScreenWidth+(WinMinX-1))*2,(WinMaxX-WinMinX+1),fil);
+end;
 
-  function get_ticks:longint;
 
-    begin
-       dosmemget($40,$6c,get_ticks,4);
-    end;
 
-  procedure initdelay;
-  
-       { From the mailling list, 
-         by Jonathan Anderson ([email protected]) }
-
-    const
-       threshold=3;
-       { Raise this to increase speed but decrease accuracy        }
-       { currently the calibration will be no more than 7 off      }
-       { and shave a few ticks off the most accurate setting of 0  }
-       { The best values to pick are powers of 2-1 (0,1,3,7,15...) }
-       { but any non-negative value will work.                     }
-
-    var
-       too_small : boolean;
-       first,
-       incval    : longint;
-
-    begin
-       calibration:=0;
-       { wait for new tick }
-       first:=get_ticks;
-       while get_ticks=first do
-         begin
+
+{****************************************************************************
+                             Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+{$ifdef GO32V2}
+var
+  regs : trealregs;
+{$endif GO32V2}
+begin
+{$ifndef GO32V2}
+  asm
+        movb    $1,%ah
+        movb    $10,%cl
+        movb    $9,%ch
+        pushl   %ebp
+        int     $0x10
+        popl    %ebp
+  end;
+{$else GO32V2}
+  regs.realeax:=$0100;
+  regs.realecx:=$90A;
+  realintr($10,regs);
+{$endif GO32V2}
+end;
+
+
+procedure cursoroff;
+{$ifdef GO32V2}
+var
+  regs : trealregs;
+{$endif GO32V2}
+begin
+{$ifdef GO32V2}
+  regs.realeax:=$0100;
+  regs.realecx:=$ffff;
+  realintr($10,regs);
+{$else GO32V2}
+  asm
+        movb    $1,%ah
+        movb    $-1,%cl
+        movb    $-1,%ch
+        pushl   %ebp
+        int     $0x10
+        popl    %ebp
+  end;
+{$endif GO32V2}
+end;
+
+
+procedure cursorbig;
+{$ifdef GO32V2}
+var
+  regs : trealregs;
+{$endif GO32V2}
+begin
+{$ifdef GO32V2}
+  regs.realeax:=$0100;
+  regs.realecx:=$10A;
+  realintr($10,regs);
+{$else GO32V2}
+  asm
+        movb    $1,%ah
+        movw    $110,%cx
+        pushl   %ebp
+        int     $0x10
+        popl    %ebp
+  end;
+{$endif GO32V2}
+end;
+
+
+{*****************************************************************************
+                          Read and Write routines
+*****************************************************************************}
+
+var
+  CurrX,CurrY : longint;
+
+Procedure WriteChar(c:char);
+var
+{$ifdef GO32V2}
+  regs : trealregs;
+{$else}
+  chattr : word;
+{$endif}
+begin
+  case c of
+   #10 : inc(CurrY);
+   #13 : CurrX:=WinMinX;
+    #8 : begin
+           if CurrX>WinMinX then
+            dec(CurrX);
+         end;
+    #7 : begin { beep }
+{$ifdef GO32V2}
+           regs.dl:=7;
+           regs.ah:=2;
+           realintr($21,regs);
+{$endif}
          end;
-       first:=get_ticks;
-
-       { this estimates calibration }
-       while get_ticks=first do
-         inc(calibration);
-
-       { calculate this to ms }
-       { calibration:=calibration div 70; }
-       { this is a very bad estimation because }
-       { the loop above calls a function       }
-       { and the dealy loop does not           }
-       calibration:=calibration div 3;
-
-       { The ideal guess value is about half of the real value      }
-       { although a value lower than that take a large performance  }
-       { hit compared to a value higher than that because it has to }
-       { go through the loop a few times.                           }
-
-       if calibration<(threshold+1)*2 then
-          calibration:=(threshold+1)*2;
-          
-       { If calibration is not at least this value, an }
-       { infinite loop will result.                    }
-
-       repeat
-          incval:=calibration;
-          if calibration<0 then
-            begin
-               calibration:=$7FFFFFFF;
-               exit;
-            end;
-          { If calibration becomes less than 0, then    }
-          { the maximum value was not long enough, so   }
-          { assign it the maximum value and exit.       }
-          { Without this code, an infinite loop would   }
-          { result on superfast computers about 315800  }
-          { times faster (oh yeah!) than my Pentium 75. }
-          { If you don't think that will happen, take   }
-          { out the if and save a few clock cycles.     }
-
-          too_small:=true;     { Assumed true at beginning }
-
-          while incval>threshold do
-            begin
-               incval:=incval div 2;
-               first:=get_ticks;
-               while get_ticks=first do
+  else
+   begin
+{$ifdef GO32V2}
+     memw[$b800:((CurrY-1)*ScreenWidth+(CurrX-1))*2]:=(textattr shl 8) or byte(c);
+{$else}
+     chattr:=(textattr shl 8) or byte(c);
+     dosmemput($b800,((CurrY-1)*ScreenWidth+(CurrX-1))*2,chattr,2);
+{$endif}
+     inc(CurrX);
+   end;
+  end;
+  if CurrX>WinMaxX then
+   begin
+     CurrX:=WinMinX;
+     inc(CurrY);
+   end;
+  while CurrY>WinMaxY do
+   begin
+     removeline(1);
+     dec(CurrY);
+   end;
+end;
+
+
+Function CrtWrite(var f : textrec):integer;
+var
+  i : longint;
+begin
+  GetScreenCursor(CurrX,CurrY);
+  for i:=0 to f.bufpos-1 do
+   WriteChar(f.buffer[i]);
+  SetScreenCursor(CurrX,CurrY);
+  f.bufpos:=0;
+  CrtWrite:=0;
+end;
+
+
+Function CrtRead(Var F: TextRec): Integer;
+
+  procedure BackSpace;
+  begin
+    if (f.bufpos>0) and (f.bufpos=f.bufend) then
+     begin
+       WriteChar(#8);
+       WriteChar(' ');
+       WriteChar(#8);
+       dec(f.bufpos);
+       dec(f.bufend);
+     end;
+  end;
+
+var
+  ch : Char;
+Begin
+  f.bufpos:=0;
+  f.bufend:=0;
+  repeat
+    if f.bufpos>f.bufend then
+     f.bufend:=f.bufpos;
+    SetScreenCursor(CurrY,CurrX);
+    ch:=readkey;
+    case ch of
+    #0 : case readkey of
+          #71 : while f.bufpos>0 do
+                 begin
+                   dec(f.bufpos);
+                   WriteChar(#8);
+                 end;
+          #75 : if f.bufpos>0 then
                  begin
+                   dec(f.bufpos);
+                   WriteChar(#8);
                  end;
-               first:=get_ticks;
-               delay(55);
-               if first=get_ticks then
+          #77 : if f.bufpos<f.bufend then
                  begin
-                    calibration:=calibration+incval;
-                 end
-               else
+                   WriteChar(f.bufptr^[f.bufpos]);
+                   inc(f.bufpos);
+                 end;
+          #79 : while f.bufpos<f.bufend do
                  begin
-                    calibration:=calibration-incval;
-                    too_small:=false;
-                    { If you have to decrement calibration,  }
-                    { the initial value was not too small to }
-                    { result in an accurate measurement.     }
+                   WriteChar(f.bufptr^[f.bufpos]);
+                   inc(f.bufpos);
                  end;
-            end;
-       until not too_small;
+         end;
+    ^S,
+    #8 : BackSpace;
+    ^Y,
+   #27 : begin
+           f.bufpos:=f.bufend;
+           while f.bufend>0 do
+            BackSpace;
+         end;
+   #13 : begin
+           WriteChar(#13);
+           WriteChar(#10);
+           f.bufptr^[f.bufend]:=#13;
+           f.bufptr^[f.bufend+1]:=#10;
+           inc(f.bufend,2);
+           break;
+         end;
+   #26 : if CheckEOF then
+          begin
+            f.bufptr^[f.bufend]:=#26;
+            inc(f.bufend);
+            break;
+          end;
+    else
+     begin
+       if f.bufpos<f.bufsize-2 then
+        begin
+          f.buffer[f.bufpos]:=ch;
+          inc(f.bufpos);
+          WriteChar(ch);
+        end;
+     end;
     end;
+  until false;
+  f.bufpos:=0;
+  SetScreenCursor(CurrY,CurrX);
+  CrtRead:=0;
+End;
+
+
+Function CrtReturn:Integer;
+Begin
+  CrtReturn:=0;
+end;
+
+
+Function CrtClose(Var F: TextRec): Integer;
+Begin
+  F.Mode:=fmClosed;
+  CrtClose:=0;
+End;
+
+
+Function CrtOpen(Var F: TextRec): Integer;
+Begin
+  If F.Mode=fmOutput Then
+   begin
+     TextRec(F).InOutFunc:=@CrtWrite;
+     TextRec(F).FlushFunc:=@CrtWrite;
+   end
+  Else
+   begin
+     F.Mode:=fmInput;
+     TextRec(F).InOutFunc:=@CrtRead;
+     TextRec(F).FlushFunc:=@CrtReturn;
+   end;
+  TextRec(F).CloseFunc:=@CrtClose;
+  CrtOpen:=0;
+End;
+
+
+procedure AssignCrt(var F: Text);
+begin
+  Assign(F,'');
+  TextRec(F).OpenFunc:=@CrtOpen;
+end;
 
 
-  procedure textmode(mode : integer);
-
-    var
-       set_font8x8 : boolean;
-
-    begin
-       lastmode:=mode;
-       set_font8x8:=(mode and font8x8)<>0;
-       mode:=mode and $ff;
-       setscreenmode(mode);
-       windmin:=0;
-       windmax:=(screencols-1) or ((screenrows-1) shl 8);
-       maxcols:=screencols;
-       maxrows:=screenrows;
-    end;
-
 var
-   col,row : longint;
-
+  x,y : longint;
 begin
-   is_last:=false;
-
-   { load system variables to temporary variables to save time }
-   maxcols:=screencols;
-   maxrows:=screenrows;
-
-   { set output window }
-   windmax:=(maxcols-1) or ((maxrows-1) shl 8);
-
-   { save the current settings to restore the old state after the exit }
-   screengetcursor(row,col);
-   dosmemget($b800,get_addr(row+1,col+1)+1,startattrib,1);
-   lastmode:=getscreenmode;
-   textattr:=startattrib;
-
-   { redirect the standard output }
-   assigncrt(Output);
-   TextRec(Output).mode:=fmOutput;
-{$IFDEF GO32V2}
-   assigncrt(Input);
-   TextRec(Input).mode:=fmInput;
-{$ENDIF GO32V2}
-
-   { calculates delay calibration }
-   initdelay;
+{ Load startup values }
+  ScreenWidth:=GetScreenWidth;
+  ScreenHeight:=GetScreenHeight;
+  WindMax:=(ScreenWidth-1) or ((ScreenHeight-1) shl 8);
+{ Load TextAttr }
+  GetScreenCursor(x,y);
+{$ifdef GO32V2}
+  TextAttr:=mem[$b800:((y-1)*ScreenWidth+(x-1))*2+1];
+  lastmode:=mem[$40:$49];
+{$else Go32V2}
+  dosmemget($b800,((y-1)*ScreenWidth+(x-1))*2+1,TextAttr,1);
+  dosmemget($40,$49,lastmode,1);
+{$endif Go32V2}
+{ Redirect the standard output }
+  assigncrt(Output);
+  Rewrite(Output);
+  TextRec(Output).Handle:=StdOutputHandle;
+  assigncrt(Input);
+  Reset(Input);
+  TextRec(Input).Handle:=StdInputHandle;
+{ Calculates delay calibration }
+  initdelay;
 end.
 
 {
   $Log$
-  Revision 1.7  1998-07-29 12:30:40  carl
-    * Restored working version
-
-  Revision 1.1.1.1  1998/03/25 11:18:41  root
-  * Restored version
-
-  Revision 1.8  1998/01/26 11:56:39  michael
-  + Added log at the end
-
-
-  
-  Working file: rtl/dos/crt.pp
-  description:
-  ----------------------------
-  revision 1.7
-  date: 1998/01/07 09:24:18;  author: michael;  state: Exp;  lines: +7 -2
-  * Bug fixed in initdelay, avoiding possible infiniteloop.
-  ----------------------------
-  revision 1.6
-  date: 1998/01/06 00:29:28;  author: michael;  state: Exp;  lines: +2 -2
-  Implemented a system independent sequence of reset/rewrite/append fileopenfunc etc system \n (from Peter Vreman)
-  ----------------------------
-  revision 1.5
-  date: 1998/01/05 16:52:15;  author: michael;  state: Exp;  lines: +7 -3
-  + Minor change making use of new GO32V2 feature (From Peter Vreman)
-  ----------------------------
-  revision 1.4
-  date: 1998/01/05 13:47:01;  author: michael;  state: Exp;  lines: +199 -127
-  * Bug fixes by Peter Vreman ([email protected]), discovered
-    when writing CRT examples.
-    Bug fix from mailing list also applied.
-  ----------------------------
-  revision 1.3
-  date: 1997/12/12 13:14:36;  author: pierre;  state: Exp;  lines: +33 -12
-     + added handling of swap_vectors if under exceptions
-       i.e. swapvector is not dummy under go32v2
-     * bug in output, exceptions where not allways reset correctly
-       now the code in dpmiexcp is called from v2prt0.as exit routine
-     * in crt.pp corrected init_delay calibration loop
-       and added it for go32v2 also (was disabled before due to crashes !!)
-       the previous code did a wrong assumption on the time need to call
-       get_ticks compared to an internal loop without call
-  ----------------------------
-  revision 1.2
-  date: 1997/12/01 12:15:44;  author: michael;  state: Exp;  lines: +11 -5
-  + added copyright reference in header.
-  ----------------------------
-  revision 1.1
-  date: 1997/11/27 08:33:49;  author: michael;  state: Exp;
-  Initial revision
-  ----------------------------
-  revision 1.1.1.1
-  date: 1997/11/27 08:33:49;  author: michael;  state: Exp;  lines: +0 -0
-  FPC RTL CVS start
-  =============================================================================
+  Revision 1.8  1998-08-08 21:56:45  peter
+    * updated crt with new delay, almost like bp7 routine
+
+  Revision 1.5  1998/05/31 14:18:12  peter
+    * force att or direct assembling
+    * cleanup of some files
+
+  Revision 1.4  1998/05/28 10:21:38  pierre
+    * Handles of input and output restored
+
+  Revision 1.3  1998/05/27 00:19:16  peter
+    * fixed crt input
+
+  Revision 1.2  1998/05/21 19:30:46  peter
+    * objects compiles for linux
+    + assign(pchar), assign(char), rename(pchar), rename(char)
+    * fixed read_text_as_array
+    + read_text_as_pchar which was not yet in the rtl
 }
+
+