Browse Source

* updates from Tomas Schatzl so it works better with w2k virtual
consoles

peter 24 years ago
parent
commit
68d1090318
1 changed files with 235 additions and 382 deletions
  1. 235 382
      rtl/win32/crt.pp

+ 235 - 382
rtl/win32/crt.pp

@@ -13,8 +13,6 @@
  **********************************************************************}
 unit crt;
 
-{$mode objfpc}
-
 interface
 
 const
@@ -65,29 +63,31 @@ var
   WindMin: Word;          { Window upper left coordinates }
   WindMax: Word;          { Window lower right coordinates }
   { FPC Specific for large screen support }
-  WinMinX,
-  WinMinY,
-  WinMaxX,
-  WinMaxY  : Longint;
+  WindMinX : Longint;
+  WindMaxX : Longint;
+  WindMinY : Longint;
+  WindMaxY : Longint;
 
 { 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 Window(X1,Y1,X2,Y2: DWord);
+procedure GotoXY(X,Y: DWord);
+function WhereX: DWord;
+function WhereY: DWord;
 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;
@@ -101,21 +101,9 @@ procedure cursorbig;
 implementation
 
 uses
-  dos,
   windows;
 
-
 var
-    OutHandle     : THandle;
-    InputHandle   : THandle;
-
-    CursorSaveX   : Longint;
-    CursorSaveY   : Longint;
-
-    ScreenWidth   : Longint;
-    ScreenHeight  : Longint;
-    IsWindowsNT   : Boolean;
-
     SaveCursorSize: Longint;
 
 
@@ -128,64 +116,58 @@ var
                            Low level Routines
 ****************************************************************************}
 
-function GetPlatformID: Longint;
-var OsVersion: TOSVersionInfo;
-begin
-  OsVersion.dwOsVersionInfoSize := SizeOf(OsVersion);
-
-  GetVersionEx(OsVersion);
-
-  Result := OsVersion.dwPlatformID;
-end; { func. GetPlatformID }
-
-
 procedure TurnMouseOff;
 var Mode: DWORD;
 begin
-  if GetConsoleMode(InputHandle, @Mode) then      { Turn the mouse-cursor off }
-    begin
-      Mode := Mode AND cardinal(NOT enable_processed_input)
-                   AND cardinal(NOT enable_mouse_input);
+  if GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), @Mode) then begin { Turn the mouse-cursor off }
+    Mode := Mode AND cardinal(NOT enable_processed_input)
+      AND cardinal(NOT enable_mouse_input);
 
-      SetConsoleMode(InputHandle, Mode);
-    end; { if }
+    SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), Mode);
+  end; { if }
 end; { proc. TurnMouseOff }
 
-
 function GetScreenHeight : longint;
 var
   ConsoleInfo: TConsoleScreenBufferinfo;
 begin
-  if not GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo) then
-    begin
+  if (not GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo)) then begin
 {$ifdef SYSTEMDEBUG}
-      Writeln(stderr,'GetScreenHeight failed GetLastError returns ',GetLastError);
-      Halt(1);
+    Writeln(stderr,'GetScreenHeight failed GetLastError returns ',GetLastError);
+    Halt(1);
 {$endif SYSTEMDEBUG}
-      Result:=25;
-    end
-  else
-    Result := ConsoleInfo.dwSize.Y;
+    // ts: this is really silly assumption; imho better: issue a halt
+    GetScreenHeight:=25;
+  end else
+    GetScreenHeight := ConsoleInfo.dwSize.Y;
 end; { func. GetScreenHeight }
 
-
 function GetScreenWidth : longint;
 var
   ConsoleInfo: TConsoleScreenBufferInfo;
 begin
-  if not GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo) then
-    begin
+  if (not GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo)) then begin
 {$ifdef SYSTEMDEBUG}
-      Writeln(stderr,'GetScreenWidth failed GetLastError returns ',GetLastError);
-      Halt(1);
+    Writeln(stderr,'GetScreenWidth failed GetLastError returns ',GetLastError);
+    Halt(1);
 {$endif SYSTEMDEBUG}
-      Result:=80;
-    end
-  else
-    Result := ConsoleInfo.dwSize.X;
+    // ts: this is really silly assumption; imho better: issue a halt
+    GetScreenWidth:=80;
+  end else
+    GetScreenWidth := ConsoleInfo.dwSize.X;
 end; { func. GetScreenWidth }
 
 
+procedure GetScreenCursor(var x : longint; var y : longint);
+var
+  ConsoleInfo : TConsoleScreenBufferInfo;
+begin
+  FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
+  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo);
+  X := ConsoleInfo.dwCursorPosition.X + 1;
+  Y := ConsoleInfo.dwCursorPosition.Y + 1;
+end;
+
 procedure SetScreenCursor(x,y : longint);
 var
   CurInfo: TCoord;
@@ -193,36 +175,9 @@ begin
   FillChar(Curinfo, SizeOf(Curinfo), 0);
   CurInfo.X := X - 1;
   CurInfo.Y := Y - 1;
-
-  SetConsoleCursorPosition(OutHandle, CurInfo);
-
-  CursorSaveX := X - 1;
-  CursorSaveY := Y - 1;
-end;
-
-
-procedure GetScreenCursor(var x,y : longint);
-begin
-  X := CursorSaveX + 1;
-  Y := CursorSaveY + 1;
+  SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), CurInfo);
 end;
 
-
-{****************************************************************************
-                              Helper Routines
-****************************************************************************}
-
-
-Function FullWin:boolean;
-{
-  Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
-}
-begin
-  FullWin:=(WinMinX=1) and (WinMinY=1) and
-           (WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
-end;
-
-
 {****************************************************************************
                              Public Crt Functions
 ****************************************************************************}
@@ -233,137 +188,81 @@ begin
   {!!! Not done yet !!! }
 end;
 
-
 Procedure TextColor(Color: Byte);
-{
-  Switch foregroundcolor
-}
+{ Switch foregroundcolor }
 Begin
   TextAttr:=(Color and $8f) or (TextAttr and $70);
 End;
 
-
-
 Procedure TextBackground(Color: Byte);
-{
-  Switch backgroundcolor
-}
+{ Switch backgroundcolor }
 Begin
   TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
 End;
 
-
-
 Procedure HighVideo;
-{
-  Set highlighted output.
-}
+{ Set highlighted output. }
 Begin
   TextColor(TextAttr Or $08);
 End;
 
-
-
 Procedure LowVideo;
-{
-  Set normal output
-}
+{ Set normal output }
 Begin
   TextColor(TextAttr And $77);
 End;
 
-
-
 Procedure NormVideo;
-{
-  Set normal back and foregroundcolors.
-}
+{ Set normal back and foregroundcolors. }
 Begin
   TextColor(7);
   TextBackGround(0);
 End;
 
-
-Procedure GotoXy(X: Byte; Y: Byte);
-{
-  Go to coordinates X,Y in the current window.
-}
+Procedure GotoXY(X: DWord; Y: DWord);
+{ 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;
+  If (X > 0) and (X <= (WindMaxX - WindMinX + 1)) and
+    (Y > 0) and (Y <= (WindMaxY - WindMinY + 1)) Then Begin
+    Inc(X, WindMinX - 1);
+    Inc(Y, WindMinY - 1);
+    SetScreenCursor(x,y);
+  End;
 End;
 
 
-Procedure Window(X1, Y1, X2, Y2: Byte);
+Procedure Window(X1, Y1, X2, Y2: DWord);
 {
   Set screen window to the specified coordinates.
 }
 Begin
-  if (X1>X2) or (X2>ScreenWidth) or
-     (Y1>Y2) or (Y2>ScreenHeight) then
-   exit;
-  WinMinX:=X1;
-  WinMaxX:=X2;
-  WinMinY:=Y1;
-  WinMaxY:=Y2;
+  if (X1 > X2) or (X2 > GetScreenWidth) or
+    (Y1 > Y2) or (Y2 > GetScreenHeight) then
+    exit;
+  WindMinY := Y1;
+  WindMaxY := Y2;
+  WindMinX := X1;
+  WindMaxX := X2;
   WindMin:=((Y1-1) Shl 8)+(X1-1);
   WindMax:=((Y2-1) Shl 8)+(X2-1);
-  GoToXY(1,1);
+  GotoXY(1, 1);
 End;
 
-
 procedure ClrScr;
 var
-  ClipRect: TSmallRect;
-  SrcRect: TSmallRect;
   DestCoor: TCoord;
-  CharInfo: TCharInfo;
+  numChars, x : DWord;
 begin
-  CharInfo.UnicodeChar := 32;
-  CharInfo.Attributes := TextAttr;
-
-  SrcRect.Left := WinMinX - 1;
-  SrcRect.Top := WinMinY - 1;
-  SrcRect.Right := WinMaxX - 1;
-  SrcRect.Bottom := WinMaxY - 1;
-  ClipRect := SrcRect;
-
-  if IsWindowsNT then
-    begin
-      DestCoor.X := -WinMaxX;
-      DestCoor.Y := -WinMaxY;
-
-      ScrollConsoleScreenBuffer(OutHandle, SrcRect, ClipRect,
-                                DestCoor, CharInfo);
-    end
-      else begin      { Win95 seems to have a bug in scrolling, unfortunately }
-             { This routine 3 times copies the bottom 12 lines to the }
-             { top part of the screen. This eventually will clear the }
-             { screen. }
-
-             DestCoor.X := WinMinX - 1;
-             DestCoor.Y := WinMinY - (Succ((WinMaxY - WinMinY) div 2));
+  DestCoor.X := WindMinX - 1;
+  DestCoor.Y := WindMinY - 1;
+  numChars := (WindMaxX - WindMinX + 1) * (WindMaxY - WindMinY + 1);
 
-             {-------- Scroll 1st part }
-             ScrollConsoleScreenBuffer(OutHandle, SrcRect, ClipRect,
-                                       DestCoor, CharInfo);
+  FillConsoleOutputAttribute(GetStdHandle(STD_OUTPUT_HANDLE), TextAttr,
+    numChars, DestCoor, x);
+  FillConsoleOutputCharacter(GetStdHandle(STD_OUTPUT_HANDLE), #32,
+    numChars, DestCoor, x);
 
-
-             {-------- Scroll 2nd part }
-             ScrollConsoleScreenBuffer(OutHandle, SrcRect, ClipRect,
-                                       DestCoor, CharInfo);
-
-             {-------- Scroll 3rd part (last line) }
-             ScrollConsoleScreenBuffer(OutHandle, SrcRect, ClipRect,
-                                       DestCoor, CharInfo);
-           end; { if in Windows95 }
-
-  GotoXY(1,1);
+  GotoXY(1, 1);
 end; { proc. ClrScr }
 
 
@@ -371,46 +270,44 @@ procedure ClrEol;
 {
   Clear from current position to end of line.
 }
-var Temp: Dword;
-    CharInfo: Char;
-    Coord: TCoord;
-    X,Y: Longint;
+var
+  Temp: DWord;
+  CharInfo: Char;
+  Coord: TCoord;
+  X,Y: Longint;
 begin
-  GetScreenCursor(x,y);
+  GetScreenCursor(x, y);
 
   CharInfo := #32;
-  
   Coord.X := X - 1;
   Coord.Y := Y - 1;
 
-  FillConsoleOutputCharacter(OutHandle, CharInfo, WinMaxX - X + 1, Coord, @Temp);
-  FillConsoleOutputAttribute(OutHandle, TextAttr, WinMaxX - X + 1, Coord, @Temp);
+  FillConsoleOutputCharacter(GetStdHandle(STD_OUTPUT_HANDLE), CharInfo, WindMaxX - X + 1,
+    Coord, @Temp);
+  FillConsoleOutputAttribute(GetStdHandle(STD_OUTPUT_HANDLE), TextAttr, WindMaxX - X + 1,
+    Coord, @Temp);
 end;
 
-
-
-Function WhereX: Byte;
+Function WhereX: DWord;
 {
   Return current X-position of cursor.
 }
 var
   x,y : longint;
 Begin
-  GetScreenCursor(x,y);
-  WhereX:=x-WinMinX+1;
+  GetScreenCursor(x, y);
+  WhereX:= x - WindMinX +1;
 End;
 
-
-
-Function WhereY: Byte;
+Function WhereY: DWord;
 {
   Return current Y-position of cursor.
 }
 var
-  x,y : longint;
+  x, y : longint;
 Begin
-  GetScreenCursor(x,y);
-  WhereY:=y-WinMinY+1;
+  GetScreenCursor(x, y);
+  WhereY:= y - WindMinY + 1;
 End;
 
 
@@ -506,7 +403,7 @@ begin
     // Function keys
     $57..$58: inc(Scancode, $2E); // F11 and F12
   end;
-  Result := ScanCode;
+  RemapScanCode := ScanCode;
 end;
 
 
@@ -584,15 +481,12 @@ end;
 
 function ReadKey: char;
 begin
-  repeat
+  while (not KeyPressed) do
     Sleep(1);
-  until KeyPressed;
-
   if SpecialKey then begin
     ReadKey := #0;
     SpecialKey := FALSE;
-  end
-  else begin
+  end else begin
     ReadKey := ScanCode;
     ScanCode := #0;
   end;
@@ -623,7 +517,6 @@ end;
 {****************************************************************************
                           HighLevel Crt Functions
 ****************************************************************************}
-
 procedure removeline(y : longint);
 var
   ClipRect: TSmallRect;
@@ -634,18 +527,21 @@ begin
   CharInfo.UnicodeChar := 32;
   CharInfo.Attributes := TextAttr;
 
-  Y := WinMinY + Y-1;
+  Y := (WindMinY - 1) + (Y - 1) + 1;
+
+  SrcRect.Top := Y;
+  SrcRect.Left := WindMinX - 1;
+  SrcRect.Right := WindMaxX - 1;
+  SrcRect.Bottom := WindMaxY - 1;
 
-  SrcRect.Top := Y - 01;
-  SrcRect.Left := WinMinX - 1;
-  SrcRect.Right := WinMaxX - 1;
-  SrcRect.Bottom := WinMaxY - 1;
+  DestCoor.X := WindMinX - 1;
+  DestCoor.Y := Y - 1;
 
-  DestCoor.X := WinMinX - 1;
-  DestCoor.Y := Y - 2;
   ClipRect := SrcRect;
+  cliprect.top := destcoor.y;
 
-  ScrollConsoleScreenBuffer(OutHandle, SrcRect, ClipRect, DestCoor, CharInfo);
+  ScrollConsoleScreenBuffer(GetStdHandle(STD_OUTPUT_HANDLE), SrcRect, ClipRect,
+    DestCoor, CharInfo);
 end; { proc. RemoveLine }
 
 
@@ -669,20 +565,20 @@ begin
   CharInfo.Attributes := TextAttr;
 
   SrcRect.Top := Y - 1;
-  SrcRect.Left := WinMinX - 1;
-  SrcRect.Right := WinMaxX - 1;
-  SrcRect.Bottom := WinMaxY - 1;
+  SrcRect.Left := WindMinX - 1;
+  SrcRect.Right := WindMaxX - 1;
+  SrcRect.Bottom := WindMaxY - 1 + 1;
 
-  DestCoor.X := WinMinX - 1;
+  DestCoor.X := WindMinX - 1;
   DestCoor.Y := Y;
   ClipRect := SrcRect;
+  ClipRect.Bottom := WindMaxY - 1;
 
-  ScrollConsoleScreenBuffer(OutHandle, SrcRect, ClipRect, DestCoor, CharInfo);
+  ScrollConsoleScreenBuffer(GetStdHandle(STD_OUTPUT_HANDLE), SrcRect, ClipRect,
+    DestCoor, CharInfo);
 end; { proc. InsLine }
 
 
-
-
 {****************************************************************************
                              Extra Crt Functions
 ****************************************************************************}
@@ -690,29 +586,29 @@ end; { proc. InsLine }
 procedure cursoron;
 var CursorInfo: TConsoleCursorInfo;
 begin
-  GetConsoleCursorInfo(OutHandle, CursorInfo);
+  GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
   CursorInfo.dwSize := SaveCursorSize;
   CursorInfo.bVisible := true;
-  SetConsoleCursorInfo(OutHandle, CursorInfo);
+  SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
 end;
 
 
 procedure cursoroff;
 var CursorInfo: TConsoleCursorInfo;
 begin
-  GetConsoleCursorInfo(OutHandle, CursorInfo);
+  GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
   CursorInfo.bVisible := false;
-  SetConsoleCursorInfo(OutHandle, CursorInfo);
+  SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
 end;
 
 
 procedure cursorbig;
 var CursorInfo: TConsoleCursorInfo;
 begin
-  GetConsoleCursorInfo(OutHandle, CursorInfo);
+  GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
   CursorInfo.dwSize := 100;
   CursorInfo.bVisible := true;
-  SetConsoleCursorInfo(OutHandle, CursorInfo);
+  SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
 end;
 
 
@@ -723,67 +619,59 @@ end;
 var
   CurrX, CurrY : longint;
 
-procedure WriteChar(c:char);
+procedure WriteChar(c : char);
 var
-    Cell    : TCharInfo;
-    BufSize : Coord;                    { Column-row size of source buffer }
-    WritePos: TCoord;                       { Upper-left cell to write from }
-    DestRect: TSmallRect;
+    WritePos: Coord;                       { Upper-left cell to write from }
+    numWritten : DWord;
+    WinAttr : word;
 begin
   Case C of
-   #10 : begin
-           Inc(CurrY);
-         end;
-   #13 : begin
-           CurrX := WinMinX;
-         end; { if }
-   #08 : begin
-           if CurrX > WinMinX then Dec(CurrX);
-         end; { ^H }
-   #07 : begin
-           // MessagBeep(0);
-         end; { ^G }
-     else begin
-            BufSize.X := 01;
-            BufSize.Y := 01;
-
-            WritePos.X := 0;
-            WritePos.Y := 0;
-
-            Cell.UniCodeChar := Ord(c);
-            Cell.Attributes := TextAttr;
-
-            DestRect.Left := (CurrX - 01);
-            DestRect.Top := (CurrY - 01);
-            DestRect.Right := (CurrX - 01);
-            DestRect.Bottom := (CurrY - 01);
-
-            WriteConsoleOutput(OutHandle, @Cell, BufSize, WritePos, DestRect);
-
-            Inc(CurrX);
-          end; { else }
-  end; { case }
-  if CurrX > WinMaxX then
-    begin
-      CurrX := WinMinX;
+    #10 : begin
       Inc(CurrY);
+    end;
+    #13 : begin
+      CurrX := WindMinX;
     end; { if }
-  While CurrY > WinMaxY do
-   begin
-     RemoveLine(1);
-     Dec(CurrY);
-   end; { while }
+    #08 : begin
+      if CurrX > WindMinX then Dec(CurrX);
+    end; { ^H }
+    #07 : begin
+      //MessagBeep(0);
+    end; { ^G }
+    else begin
+      WritePos.X := currX - 1;
+      WritePos.Y := currY - 1;
+
+      WriteConsoleOutputCharacter(GetStdhandle(STD_OUTPUT_HANDLE),
+        @c, 1, writePos, numWritten);
+
+      WinAttr:=TextAttr;
+      WriteConsoleOutputAttribute(GetStdhandle(STD_OUTPUT_HANDLE),
+        @WinAttr, 1, writePos, numWritten);
+
+      Inc(CurrX);
+    end; { else }
+  end; { case }
+  if CurrX > WindMaxX then begin
+    CurrX := WindMinX;
+    Inc(CurrY);
+  end; { if }
+  While CurrY > WindMaxY do begin
+    RemoveLine(1);
+    Dec(CurrY);
+  end; { while }
 end;
 
-
-Function CrtWrite(var f : textrec):integer;
+Function CrtWrite(var f : textrec) : integer;
 var
   i : longint;
 begin
-  GetScreenCursor(CurrX,CurrY);
+  GetScreenCursor(CurrX, CurrY);
+
   for i:=0 to f.bufpos-1 do
-   WriteChar(f.buffer[i]);
-  SetScreenCursor(CurrX,CurrY);
+    WriteChar(f.buffer[i]);
+  SetScreenCursor(CurrX, CurrY);
+
   f.bufpos:=0;
   CrtWrite:=0;
 end;
@@ -793,14 +681,13 @@ 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;
+    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
@@ -811,67 +698,60 @@ Begin
   f.bufend:=0;
   repeat
     if f.bufpos>f.bufend then
-     f.bufend:=f.bufpos;
-    SetScreenCursor(CurrX,CurrY);
-    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;
-          #77 : if f.bufpos<f.bufend then
-                 begin
-                   WriteChar(f.bufptr^[f.bufpos]);
-                   inc(f.bufpos);
-                 end;
-          #79 : while f.bufpos<f.bufend do
-                 begin
-                   WriteChar(f.bufptr^[f.bufpos]);
-                   inc(f.bufpos);
-                 end;
-         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;
+      f.bufend:=f.bufpos;
+      SetScreenCursor(CurrX,CurrY);
+      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;
+          #77 : if f.bufpos<f.bufend then begin
+            WriteChar(f.bufptr^[f.bufpos]);
+            inc(f.bufpos);
           end;
-    else
-     begin
-       if f.bufpos<f.bufsize-2 then
-        begin
+          #79 : while f.bufpos<f.bufend do begin
+            WriteChar(f.bufptr^[f.bufpos]);
+            inc(f.bufpos);
+          end;
+        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;
+      end;
+      end;
   until false;
   f.bufpos:=0;
-  SetScreenCursor(CurrX,CurrY);
+  SetScreenCursor(CurrX, CurrY);
   CrtRead:=0;
 End;
 
@@ -891,17 +771,14 @@ 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;
+  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;
@@ -913,78 +790,54 @@ begin
   TextRec(F).OpenFunc:=@CrtOpen;
 end;
 
-
-const
-  conout : pchar = 'CONOUT$';
-
 var
   CursorInfo  : TConsoleCursorInfo;
   ConsoleInfo : TConsoleScreenBufferinfo;
 
+// ts
 begin
   { Initialize the output handles }
-  OutHandle := GetStdHandle(STD_OUTPUT_HANDLE);
-  InputHandle := GetStdHandle(STD_INPUT_HANDLE);
   LastMode := 3;
 
+  SetActiveWindow(0);
+
   {--------------------- Get the cursor size and such -----------------------}
   FillChar(CursorInfo, SizeOf(CursorInfo), 00);
-  GetConsoleCursorInfo(OutHandle, CursorInfo);
+  GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
   SaveCursorSize := CursorInfo.dwSize;
 
   {------------------ Get the current cursor position and attr --------------}
   FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
-  if not GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo) then
-    begin
-      OutHandle:=CreateFile(ConOut, generic_read or generic_write,
-        file_share_read or file_share_write,nil,
-        open_existing,0,0);
-      If (OutHandle=Invalid_handle_value) then
-        begin
-          Writeln(stderr,'No way to get the console handle');
-          Halt(1);
-        end;
-      if not GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo) then
-        begin
-          Writeln(stderr,'No way to get console screen buffer info');
-          Halt(1);
-        end;
-    end;
-  CursorSaveX := ConsoleInfo.dwCursorPosition.X;
-  CursorSaveY := ConsoleInfo.dwCursorPosition.Y;
+  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo);
+
   TextAttr := ConsoleInfo.wAttributes;
 
   { Load startup values }
-  ScreenWidth := GetScreenWidth;
-  ScreenHeight := GetScreenHeight;
-  IsWindowsNT := (GetPlatformID = VER_PLATFORM_WIN32_NT);
   TurnMouseOff;
 
-  WinMinX:=1;
-  WinMinY:=1;
-  WinMaxX:=ScreenWidth;
-  WinMaxY:=ScreenHeight;
-  WindMax := (ScreenWidth - 1) OR ((ScreenHeight - 1) SHL 8);
+  WindMinX := (ConsoleInfo.srWindow.Left) + 1;
+  WindMinY := (ConsoleInfo.srWindow.Top) + 1;
+  WindMaxX := (ConsoleInfo.srWindow.Right) + 1;
+  WindMaxY := (ConsoleInfo.srWindow.Bottom) + 1;
+
   DoingNumChars := false;
   DoingNumCode := 0;
 
   { Redirect the standard output }
   AssignCrt(Output);
   Rewrite(Output);
-  TextRec(Output).Handle:= OutHandle;
+  TextRec(Output).Handle:= GetStdHandle(STD_OUTPUT_HANDLE);
 
   AssignCrt(Input);
   Reset(Input);
-  TextRec(Input).Handle:= InputHandle;
+  TextRec(Input).Handle:= GetStdHandle(STD_INPUT_HANDLE);
 end. { unit Crt }
 
 {
   $Log$
-  Revision 1.10  2001-06-29 19:43:40  peter
-    * fixed clreol
-
-  Revision 1.9  2001/06/27 20:21:47  peter
-    * support large screens
+  Revision 1.11  2001-07-13 17:43:25  peter
+    * updates from Tomas Schatzl so it works better with w2k virtual
+      consoles
 
   Revision 1.8  2001/04/14 14:05:42  peter
     * fixed for stricter checking