+ crt unit that compiles

rtl/win32/Makefile

@@ -55,7 +55,7 @@ LOADEROBJECTS=wprt0 wdllprt0
 
 # Unit Objects
 UNITOBJECTS=$(SYSTEMUNIT) strings windows \
-	    dos objects \
+	    dos crt objects \
 	    objpas sysutils typinfo math \
             cpu mmx getopts heaptrc ole2
 
@@ -213,6 +213,8 @@ ole2$(PPUEXT) : ole2.pp windows$(PPUEXT) $(SYSTEMPPU)
 
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc $(SYSTEMPPU)
 
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMPPU) objpas$(PPUEXT)
+
 objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
 
 #
@@ -360,7 +362,10 @@ endif
 
 #
 # $Log$
-# Revision 1.24  1999-03-22 22:12:50  florian
+# Revision 1.25  1999-04-20 11:34:11  peter
+#   + crt unit that compiles
+#
+# Revision 1.24  1999/03/22 22:12:50  florian
 #   + addition and changes to compile the direct draw unit
 #     of Erik Ungerer (with -dv2com and indirect disabled)
 #

rtl/win32/crt.pp

@@ -1,227 +1,438 @@
-unit WinCrt;
+{
+    $Id$
 
-interface
+    Borland Pascal 7 Compatible CRT Unit for win32
 
-Uses Windows;
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
 
-type
-  WinReadKeyRecord = record
-    KeyStatus: byte;
-    AsciiChar: char;
-    KeyCode: word;
-  end;
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit crt;
+
+{$mode objfpc}
+
+interface
 
 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;
 
-// Foreground color constants
-
-fBlack        = 0;
-fBlue         = FOREGROUND_BLUE;
-fGreen        = FOREGROUND_GREEN;
-fCyan         = FOREGROUND_BLUE OR FOREGROUND_GREEN;
-fRed          = FOREGROUND_RED;
-fMagenta      = FOREGROUND_BLUE OR FOREGROUND_RED;
-fBrown        = FOREGROUND_GREEN OR FOREGROUND_RED;
-fLightGray    = FOREGROUND_BLUE OR FOREGROUND_GREEN OR FOREGROUND_RED;
-fDarkGray     = fBlack OR FOREGROUND_INTENSITY;
-fLightBlue    = fBlue OR FOREGROUND_INTENSITY;
-fLightGreen   = fGreen OR FOREGROUND_INTENSITY;
-fLightCyan    = fCyan OR FOREGROUND_INTENSITY;
-fLightRed     = fRed OR FOREGROUND_INTENSITY;
-fLightMagenta = fMagenta OR FOREGROUND_INTENSITY;
-fYellow       = fBrown OR FOREGROUND_INTENSITY;
-fWhite        = fLightGray OR FOREGROUND_INTENSITY;
-
-// Background color constants
-
-bBlack        = 0;
-bBlue         = BACKGROUND_BLUE;
-bGreen        = BACKGROUND_GREEN;
-bCyan         = BACKGROUND_BLUE OR BACKGROUND_GREEN;
-bRed          = BACKGROUND_RED;
-bMagenta      = BACKGROUND_BLUE OR BACKGROUND_RED;
-bBrown        = BACKGROUND_GREEN OR BACKGROUND_RED;
-bLightGray    = BACKGROUND_BLUE OR BACKGROUND_GREEN OR BACKGROUND_RED;
-bDarkGray     = bBlack OR BACKGROUND_INTENSITY;
-bLightBlue    = bBlue OR BACKGROUND_INTENSITY;
-bLightGreen   = bGreen OR BACKGROUND_INTENSITY;
-bLightCyan    = bCyan OR BACKGROUND_INTENSITY;
-bLightRed     = bRed OR BACKGROUND_INTENSITY;
-bLightMagenta = bMagenta OR BACKGROUND_INTENSITY;
-bYellow       = bBrown OR BACKGROUND_INTENSITY;
-bWhite        = bLightGray OR BACKGROUND_INTENSITY;
-
-// Constants designating input events
-
-NO_EVENT = 0;
-KEY_EVENT_IN_PROGRESS = $100;
-_MOUSE_EVENT_IN_PROGRESS = $200;
+var
 
-procedure ClrEol;
-{ Clears all characters from cursor position to end of line without
-  moving the cursor  by filling character cells with blanks
-  and attribute cells with the current screen buffer attribute.
-}
+{ 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;
-{ Clears screen buffer by filling character cells with blanks
-  and attribute cells with the current screen buffer attribute.
-  The cursor is positioned in the top left corner of the screen
-  buffer
-}
-procedure FlushInputBuffer;
-function GetTextBackground: byte;
-function GetTextColor: byte;
-Procedure GotoXY(X, Y: integer);
-Procedure HighVideo;
-Procedure HighVideoBackground;
-Function InputEvent: word;
-{ Returns
-  NO_EVENT if input buffer is empty ;
-  KEY_EVENT if there is a pending key event with
-    key released again,
-    and key is not one of the control keys;
-  KEY_EVENT_IN_PROGRESS if there is another pending key event;
-  _MOUSE_EVENT if there is a pending mouse event
-    without moving the mouse;
-  _MOUSE_EVENT_IN_PROGRESS if there is another pending mouse event;
-  WINDOW_BUFFER_SIZE_EVENT is the user resized the screen buffer
-    and window input is enabled (default mode disabled).
-}
-function KeyPressed: boolean;
-{ Returns
-  TRUE if there is a pending key event with
-    key released again,
-    and key is not one of the control keys;
-  FALSE otherwise.
-}
-Procedure LowVideo;
-Procedure LowVideoBackground;
-Procedure NormVideo;
-Procedure NormVideoBackground;
-Function ReadKey: char;
-Procedure TextBackground (Color: Byte);
-Procedure TextColor (Color: Byte);
-Function WhereX: integer;
-Function WhereY: integer;
-Function WinReadKey: WinReadKeyRecord;
-{ Return value in KeyStatus element:
-  - bit  0: shift key pressed
-  - bit  1: ctrl key pressed
-  - bit  2: alt key pressed
-  The KeyCode element has the virtual key code.
-
-  N.B. nog regelen: extended ASCII via Alt-keypad toetsen.
-}
+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
+  dos,
+  windows;
+
+
+var OutHandle     : THandle;
+    InputHandle   : THandle;
+
+    UsingAttr     : Longint;
+
+    CursorSaveX   : Longint;
+    CursorSaveY   : Longint;
+
+    ScreenWidth   : Longint;
+    ScreenHeight  : Longint;
+
+    SaveCursorSize: Longint;
+
+{
+  definition of textrec is in textrec.inc
+}
+{$ifdef FPC}
+  {$i textrec.inc}
+{$endif}
+
+Const
+  NO_EVENT = 0;
+  KEY_EVENT_IN_PROGRESS = $100;
+  _MOUSE_EVENT_IN_PROGRESS = $200;
+
 type
   PInputBuffer = ^TInputBuffer;
-  TInputBuffer = array[word] of TInputRecord;
+  TInputBuffer = array[0..1200] of TInputRecord;
 
+
+Function KeyPressed: boolean;
 var
-  StartTextIntensity, StartBackgroundIntensity: byte;
-  pCsbi: PConsoleScreenBufferInfo;
+  hConsoleInput: THandle;
+  pInput: pInputBuffer;
+  lpNumberOfEvents: dword;
+  lpNumberRead: integer;
+  i: word;
 
-function GetScreenInfo: TConsoleScreenBufferInfo; forward;
-Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte): byte; forward;
+  const
+  KeysToSkip: set of byte =
+    [VK_SHIFT, VK_CONTROL, VK_MENU, VK_CAPITAL, VK_NUMLOCK, VK_SCROLL];
 
-procedure ClrEol;
-var
-  hConsoleOutput: THandle;
-  cCharacter: Char;
-  wAttribute: word;
-  nLength: dword;
-  dwWriteCoord: TCoord;
-  lpWritten: dword;
 begin
-  hConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE);
-  cCharacter := ' ';
-  New(pCsbi);
-  GetConsoleScreenBufferInfo(hConsoleOutput, pCsbi^);
-  wAttribute := pCsbi^.wAttributes;
-  nLength := pCsbi^.dwSize.X - pCsbi^.dwCursorPosition.X + 1;
-  dwWriteCoord.X := pCsbi^.dwCursorPosition.X;
-  dwWriteCoord.Y := pCsbi^.dwCursorPosition.Y;
-  Dispose(pCsbi);
-  FillConsoleOutputCharacter(hConsoleOutput, cCharacter, nLength,
-    dwWriteCoord, lpWritten);
-  FillConsoleOutputAttribute(hConsoleOutput, wAttribute, nLength,
-    dwWriteCoord, lpWritten);
+  hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);
+  GetNumberOfConsoleInputEvents(hConsoleInput, lpNumberOfEvents);
+  Result := FALSE;
+  if lpNumberOfEvents > 0 then
+  try
+    GetMem(pInput, lpNumberOfEvents * SizeOf(TInputRecord));
+    PeekConsoleInput(hConsoleInput, pInput^[0], lpNumberOfEvents, lpNumberRead);
+    i := 0;
+    repeat
+      with pInput^[i] do begin
+        if EventType = KEY_EVENT then
+          Result := (KeyEvent.bKeyDown = false) and
+                    not (KeyEvent.wVirtualKeyCode in KeysToSkip);
+      end;
+      inc(i);
+    until (Result = TRUE) or (i >= lpNumberOfEvents);
+
+  finally
+    {$IFDEF VER0_99_11}
+      FreeMem(pInput, lpNumberOfEvents * SizeOf(TInputRecord));
+    {$ELSE}
+      FreeMem(pInput);
+    {$ENDIF}
+  end;
 end;
 
-procedure ClrScr;
-var
-  hConsoleOutput: THandle;
-  cCharacter: Char;
-  wAttribute: word;
-  nLength: dword;
-  dwWriteCoord: TCoord;
-  lpWritten: dword;
+
+{****************************************************************************
+                           Low level Routines
+****************************************************************************}
+
+function GetScreenHeight : longint;
+var ConsoleInfo: TConsoleScreenBufferinfo;
 begin
-  hConsoleOutput := GetStdHandle(STD_OUTPUT_HANDLE);
-  cCharacter := ' ';
-  New(pCsbi);
-  GetConsoleScreenBufferInfo(hConsoleOutput, pCsbi^);
-  wAttribute := pCsbi^.wAttributes;
-  nLength := pCsbi^.dwSize.X * pCsbi^.dwSize.Y;
-  Dispose(pCsbi);
-  dwWriteCoord.X := 0;
-  dwWriteCoord.Y := 0;
-  FillConsoleOutputCharacter(hConsoleOutput, cCharacter, nLength,
-    dwWriteCoord, lpWritten);
-  FillConsoleOutputAttribute(hConsoleOutput, wAttribute, nLength,
-    dwWriteCoord, lpWritten);
-  SetConsoleCursorPosition(hConsoleOutput, dwWriteCoord);
+  GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo);
+
+  Result := ConsoleInfo.SrWindow.Bottom + 1;
 end;
 
-procedure FlushInputBuffer;
+
+function GetScreenWidth : longint;
+var ConsoleInfo: TConsoleScreenBufferInfo;
 begin
-  FlushConsoleInputBuffer(GetStdHandle(STD_INPUT_HANDLE));
+  GetConsoleScreenBufferInfo(OutHandle, ConsoleInfo);
+
+  Result := ConsoleInfo.SrWindow.Right + 1;
 end;
 
-function GetTextBackground: byte;
+
+procedure SetScreenCursor(x,y : longint);
+var CurInfo: TCoord;
 begin
-  Result := GetScreenInfo.wAttributes AND bWhite;
+  FillChar(Curinfo, SizeOf(Curinfo), 0);
+  CurInfo.X := X - 1;
+  CurInfo.Y := Y - 1;
+
+  SetConsoleCursorPosition(OutHandle, CurInfo);
+
+  CursorSaveX := X - 1;
+  CursorSaveY := Y - 1;
 end;
 
-function GetTextColor: byte;
+
+procedure GetScreenCursor(var x,y : longint);
 begin
-  Result := GetScreenInfo.wAttributes AND fWhite;
+  X := CursorSaveX + 1;
+  Y := CursorSaveY + 1;
 end;
 
-function GetScreenInfo: TConsoleScreenBufferInfo;
+
+{****************************************************************************
+                              Helper Routines
+****************************************************************************}
+
+
+Function WinMinX: Byte;
+{
+  Current Minimum X coordinate
+}
+Begin
+  WinMinX:=(WindMin and $ff)+1;
+End;
+
+
+
+Function WinMinY: Byte;
+{
+  Current Minimum Y Coordinate
+}
+Begin
+  WinMinY:=(WindMin shr 8)+1;
+End;
+
+
+
+Function WinMaxX: Byte;
+{
+  Current Maximum X coordinate
+}
+Begin
+  WinMaxX:=(WindMax and $ff)+1;
+End;
+
+
+
+Function WinMaxY: Byte;
+{
+  Current Maximum Y coordinate;
+}
+Begin
+  WinMaxY:=(WindMax shr 8) + 1;
+End;
+
+
+
+Function FullWin:boolean;
+{
+  Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
+}
 begin
-  GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), Result);
+  FullWin:=(WindMax-WindMin=$184f);
 end;
 
-Procedure GotoXY(X, Y: integer);
-var
-  CoordCursor: TCoord;
+
+{****************************************************************************
+                             Public Crt Functions
+****************************************************************************}
+
+
+procedure textmode(mode : integer);
 begin
-  CoordCursor.X := X - 1;
-  CoordCursor.Y := Y - 1;
-  SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), CoordCursor);
+  {!!! Not done yet !!! }
 end;
 
+
+Procedure TextColor(Color: Byte);
+{
+  Switch foregroundcolor
+}
+Begin
+  TextAttr:=(Color and $8f) or (TextAttr and $70);
+End;
+
+
+
+Procedure TextBackground(Color: Byte);
+{
+  Switch backgroundcolor
+}
+Begin
+  TextAttr:=(Color shl 4) or (TextAttr and $0f);
+End;
+
+
+
 Procedure HighVideo;
+{
+  Set highlighted output.
+}
+Begin
+  TextColor(TextAttr Or $08);
+End;
+
+
+
+Procedure LowVideo;
+{
+  Set normal output
+}
+Begin
+  TextColor(TextAttr And $77);
+End;
+
+
+
+Procedure NormVideo;
+{
+  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.
+}
+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
-  Attribute: word;
+  ClipRect: TSmallRect;
+  SrcRect: TSmallRect;
+  DestCoor: TCoord;
+  CharInfo: TCharInfo;
 begin
-  Attribute := GetScreenInfo.wAttributes;
-  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
-    Attribute OR FOREGROUND_INTENSITY);
+  CharInfo.UnicodeChar := 32;
+  CharInfo.Attributes := TextAttr;
+
+  SrcRect.Left := WinMinX;
+  SrcRect.Top := WinMinY;
+  SrcRect.Right := WinMaxX;
+  SrcRect.Bottom := WinMaxY;
+  ClipRect := SrcRect;
+
+  DestCoor.X := WinMinX - 1;
+  DestCoor.Y := WinMinY - 1;
+
+  ScrollConsoleScreenBuffer(OutHandle, SrcRect, @ClipRect, DestCoor, CharInfo);
+  Gotoxy(1,1);
 end;
 
-Procedure HighVideoBackground;
-var
-  Attribute: word;
-begin
-  Attribute := GetScreenInfo.wAttributes;
-  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
-    Attribute OR BACKGROUND_INTENSITY);
+
+Procedure ClrEol;
+{
+  Clear from current position to end of line.
+}
+var Temp: DWORD;
+    CharInfo: Char;
+    Coord: TCoord;
+    X,Y: Longint;
+Begin
+  GetScreenCursor(x,y);
+
+  CharInfo := #32;
+  Coord.X := X;
+  Coord.Y := Y;
+
+  FillConsoleOutputCharacter(OutHandle, CharInfo, WinMaxX - (X + 01), Coord, Temp);
 end;
 
+
+
+Function WhereX: Byte;
+{
+  Return current X-position of cursor.
+}
+var
+  x,y : longint;
+Begin
+  GetScreenCursor(x,y);
+  WhereX:=x-WinMinX+1;
+End;
+
+
+
+Function WhereY: Byte;
+{
+  Return current Y-position of cursor.
+}
+var
+  x,y : longint;
+Begin
+  GetScreenCursor(x,y);
+  WhereY:=y-WinMinY+1;
+End;
+
+
+{*************************************************************************
+                            KeyBoard
+*************************************************************************}
+
 Function InputEvent: word;
 var
   hConsoleInput: THandle;
@@ -264,79 +475,94 @@ begin
       inc(i);
     until (Result <> NO_EVENT) or (i >= lpNumberOfEvents);
   finally
-    FreeMem(pInput);
+    {$IFDEF VER0_99_11}
+      FreeMem(pInput, lpNumberOfEvents * SizeOf(TInputRecord));
+    {$ELSE}
+      FreeMem(pInput);
+    {$ENDIF}
   end;
 end;
 
-Function KeyPressed: boolean;
-var
-  hConsoleInput: THandle;
-  pInput: pInputBuffer;
-  lpNumberOfEvents: dword;
-  lpNumberRead: integer;
-  i: word;
 
-  const
-  KeysToSkip: set of byte =
-    [VK_SHIFT, VK_CONTROL, VK_MENU, VK_CAPITAL, VK_NUMLOCK, VK_SCROLL];
+Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte): byte;
 
-begin
-  hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);
-  GetNumberOfConsoleInputEvents(hConsoleInput, lpNumberOfEvents);
-  Result := FALSE;
-  if lpNumberOfEvents > 0 then
-  try
-    GetMem(pInput, lpNumberOfEvents * SizeOf(TInputRecord));
-    PeekConsoleInput(hConsoleInput, pInput^[0], lpNumberOfEvents, lpNumberRead);
-    i := 0;
-    repeat
-      with pInput^[i] do begin
-        if EventType = KEY_EVENT then
-          Result := (KeyEvent.bKeyDown = false) and
-                    not (KeyEvent.wVirtualKeyCode in KeysToSkip);
-      end;
-      inc(i);
-    until (Result = TRUE) or (i >= lpNumberOfEvents);
-  finally
-    FreeMem(pInput);
-  end;
-end;
+  { Several remappings of scancodes are necessary to comply with what
+    we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc.
+    are excluded }
 
-Procedure LowVideo;
 var
-  Attribute: word;
-begin
-  Attribute := GetScreenInfo.wAttributes;
-  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
-    Attribute AND NOT FOREGROUND_INTENSITY);
-end;
+  AltKey, CtrlKey, ShiftKey: boolean;
+const
+  {
+    Keypad key scancodes:
 
-Procedure LowVideoBackground;
-var
-  Attribute: word;
-begin
-  Attribute := GetScreenInfo.wAttributes;
-  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
-    Attribute AND NOT BACKGROUND_INTENSITY);
-end;
-Procedure NormVideo;
-var
-  Attribute: word;
-begin
-  Attribute := GetScreenInfo.wAttributes;
-  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
-    Attribute AND (fLightGray OR bWhite) OR StartTextIntensity);
-end;
+      Ctrl Norm
+
+      $77  $47 - Home
+      $8D  $48 - Up arrow
+      $84  $49 - PgUp
+      $8E  $4A - -
+      $73  $4B - Left Arrow
+      $8F  $4C - 5
+      $74  $4D - Right arrow
+      $4E  $4E - +
+      $75  $4F - End
+      $91  $50 - Down arrow
+      $76  $51 - PgDn
+      $92  $52 - Ins
+      $93  $53 - Del
+  }
+  CtrlKeypadKeys: array[$47..$53] of byte =
+    ($77, $8D, $84, $8E, $73, $8F, $74, $4E, $75, $91, $76, $92, $93);
 
-Procedure NormVideoBackground;
-var
-  Attribute: word;
 begin
-  Attribute := GetScreenInfo.wAttributes;
-  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
-    Attribute AND (fWhite OR bLightGray) OR StartBackgroundIntensity);
+  AltKey := ((CtrlKeyState AND
+            (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
+  CtrlKey := ((CtrlKeyState AND
+            (RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0);
+  ShiftKey := ((CtrlKeyState AND SHIFT_PRESSED) > 0);
+  if AltKey then
+    case ScanCode of
+    // Digits, -, =
+    $02..$0D: inc(ScanCode, $76);
+    // Function keys
+    $3B..$44: inc(Scancode, $2D);
+    $57..$58: inc(Scancode, $34);
+    // Extended cursor block keys
+    $47..$49, $4B, $4D, $4F..$53:
+              inc(Scancode, $50);
+    // Other keys
+    $1C:      Scancode := $A6;   // Enter
+    $35:      Scancode := $A4;   // / (keypad and normal!)
+    end
+  else if CtrlKey then
+    case Scancode of
+    // Tab key
+    $0F:      Scancode := $94;
+    // Function keys
+    $3B..$44: inc(Scancode, $23);
+    $57..$58: inc(Scancode, $32);
+    // Keypad keys
+    $35:      Scancode := $95;   // \
+    $37:      Scancode := $96;   // *
+    $47..$53: Scancode := CtrlKeypadKeys[Scancode];
+    end
+  else if ShiftKey then
+    case Scancode of
+    // Function keys
+    $3B..$44: inc(Scancode, $19);
+    $57..$58: inc(Scancode, $30);
+    end
+  else
+    case Scancode of
+    // Function keys
+    $57..$58: inc(Scancode, $2E); // F11 and F12
+  end;
+  Result := ScanCode;
 end;
 
+
+
 Function ReadKey: char;
 var
   hConsoleInput: THandle;
@@ -416,165 +642,355 @@ begin
   end;
 end;
 
-Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte): byte;
+{*************************************************************************
+                                   Delay
+*************************************************************************}
 
-  { Several remappings of scancodes are necessary to comply with what
-    we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc.
-    are excluded }
+procedure Delay(MS: Word);
+begin
+  Sleep(ms);
+end; { proc. Delay }
 
-var
-  AltKey, CtrlKey, ShiftKey: boolean;
-const
-  {
-    Keypad key scancodes:
 
-      Ctrl Norm
+procedure sound(hz : word);
+begin
+  MessageBeep(0); { lame ;-) }
+end;
 
-      $77  $47 - Home
-      $8D  $48 - Up arrow
-      $84  $49 - PgUp
-      $8E  $4A - -
-      $73  $4B - Left Arrow
-      $8F  $4C - 5
-      $74  $4D - Right arrow
-      $4E  $4E - +
-      $75  $4F - End
-      $91  $50 - Down arrow
-      $76  $51 - PgDn
-      $92  $52 - Ins
-      $93  $53 - Del
-  }
-  CtrlKeypadKeys: array[$47..$53] of byte =
-    ($77, $8D, $84, $8E, $73, $8F, $74, $4E, $75, $91, $76, $92, $93);
 
+procedure nosound;
 begin
-  AltKey := ((CtrlKeyState AND
-            (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
-  CtrlKey := ((CtrlKeyState AND
-            (RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0);
-  ShiftKey := ((CtrlKeyState AND SHIFT_PRESSED) > 0);
-  if AltKey then
-    case ScanCode of
-    // Digits, -, =
-    $02..$0D: inc(ScanCode, $76);
-    // Function keys
-    $3B..$44: inc(Scancode, $2D);
-    $57..$58: inc(Scancode, $34);
-    // Extended cursor block keys
-    $47..$49, $4B, $4D, $4F..$53:
-              inc(Scancode, $50);
-    // Other keys
-    $1C:      Scancode := $A6;   // Enter
-    $35:      Scancode := $A4;   // / (keypad and normal!)
-    end
-  else if CtrlKey then
-    case Scancode of
-    // Tab key
-    $0F:      Scancode := $94;
-    // Function keys
-    $3B..$44: inc(Scancode, $23);
-    $57..$58: inc(Scancode, $32);
-    // Keypad keys
-    $35:      Scancode := $95;   // \
-    $37:      Scancode := $96;   // *
-    $47..$53: Scancode := CtrlKeypadKeys[Scancode];
-    end
-  else if ShiftKey then
-    case Scancode of
-    // Function keys
-    $3B..$44: inc(Scancode, $19);
-    $57..$58: inc(Scancode, $30);
-    end
-  else
-    case Scancode of
-    // Function keys
-    $57..$58: inc(Scancode, $2E); // F11 and F12
-  end;
-  Result := ScanCode;
 end;
 
 
-Procedure TextBackground (Color: Byte);
+
+{****************************************************************************
+                          HighLevel Crt Functions
+****************************************************************************}
+
+procedure removeline(y : longint);
 var
-  Background, Foreground: byte;
+  ClipRect: TSmallRect;
+  SrcRect: TSmallRect;
+  DestCoor: TCoord;
+  CharInfo: TCharInfo;
 begin
-  Background := Color AND bWhite;
-  Foreground := GetScreenInfo.wAttributes AND fWhite;
-  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
-    Background OR Foreground);
-end;
+  CharInfo.UnicodeChar := 32;
+  CharInfo.Attributes := TextAttr;
+
+  SrcRect.Top := Y - 01;
+  SrcRect.Left := WinMinX - 1;
+  SrcRect.Right := WinMaxX - 1;
+  SrcRect.Bottom := WinMaxY - 1;
+
+  DestCoor.X := WinMinX - 1;
+  DestCoor.Y := Y - 2;
+  ClipRect := SrcRect;
+
+  ScrollConsoleScreenBuffer(OutHandle, SrcRect, @ClipRect, DestCoor, CharInfo);
+end; { proc. RemoveLine }
+
 
-Procedure TextColor (Color: Byte);
+procedure delline;
+begin
+  removeline(wherey);
+end; { proc. DelLine }
+
+
+procedure insline;
 var
-  Background, Foreground: byte;
+  ClipRect: TSmallRect;
+  SrcRect: TSmallRect;
+  DestCoor: TCoord;
+  CharInfo: TCharInfo;
+  X,Y: Longint;
+begin
+  GetScreenCursor(X, Y);
+
+  CharInfo.UnicodeChar := 32;
+  CharInfo.Attributes := TextAttr;
+
+  SrcRect.Top := Y - 1;
+  SrcRect.Left := WinMinX - 1;
+  SrcRect.Right := WinMaxX - 1;
+  SrcRect.Bottom := WinMaxY - 1;
+
+  DestCoor.X := WinMinX - 1;
+  DestCoor.Y := Y;
+  ClipRect := SrcRect;
+
+  ScrollConsoleScreenBuffer(OutHandle, SrcRect, @ClipRect, DestCoor, CharInfo);
+end; { proc. InsLine }
+
+
+
+
+{****************************************************************************
+                             Extra Crt Functions
+****************************************************************************}
+
+procedure cursoron;
+var CursorInfo: TConsoleCursorInfo;
 begin
-  Background := GetScreenInfo.wAttributes AND bWhite;
-  Foreground := Color AND fWhite;
-  SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
-    Background OR Foreground);
+  GetConsoleCursorInfo(OutHandle, CursorInfo);
+  CursorInfo.dwSize := SaveCursorSize;
+  CursorInfo.bVisible := true;
+  SetConsoleCursorInfo(OutHandle, CursorInfo);
 end;
 
-Function WhereX: integer;
+
+procedure cursoroff;
+var CursorInfo: TConsoleCursorInfo;
 begin
-  Result := GetScreenInfo.dwCursorPosition.X + 1;
+  GetConsoleCursorInfo(OutHandle, CursorInfo);
+  CursorInfo.bVisible := false;
+  SetConsoleCursorInfo(OutHandle, CursorInfo);
 end;
 
-Function WhereY: integer;
+
+procedure cursorbig;
+var CursorInfo: TConsoleCursorInfo;
 begin
-  Result := GetScreenInfo.dwCursorPosition.Y + 1;
+  GetConsoleCursorInfo(OutHandle, CursorInfo);
+  CursorInfo.dwSize := 100;
+  CursorInfo.bVisible := true;
+  SetConsoleCursorInfo(OutHandle, CursorInfo);
 end;
 
-Function WinReadKey: WinReadKeyRecord;
-var
-  hConsoleInput: THandle;
-  pInput: pInputRecord;
-  lpcRead: integer;
 
-  const
-  KeysToSkip: set of byte =
-    [VK_SHIFT, VK_CONTROL, VK_MENU, VK_CAPITAL, VK_NUMLOCK, VK_SCROLL];
+{*****************************************************************************
+                          Read and Write routines
+*****************************************************************************}
+
+var
+  CurrX, CurrY : longint;
 
+procedure WriteChar(c:char);
+var
+    Cell    : TCharInfo;
+    BufSize : TCoord;                    { Column-row size of source buffer }
+    WritePos: TCoord;                       { Upper-left cell to write from }
+    DestRect: TSmallRect;
 begin
-  hConsoleInput := GetStdHandle(STD_INPUT_HANDLE);
-  try
-    New(pInput);
-    with pInput^.KeyEvent do begin
-      Repeat
-        ReadConsoleInput(hConsoleInput, pInput^, 1, lpcRead);
-      until (pInput^.EventType = KEY_EVENT)
-        and (bKeyDown = TRUE)
-        and not (wVirtualKeyCode in KeysToSkip);
+  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) + 01;
+            DestRect.Bottom := (CurrY - 01);
+
+            WriteConsoleOutput(OutHandle, @Cell, BufSize, WritePos, DestRect);
+
+            Inc(CurrX);
+          end; { else }
+  end; { case }
+
+  if CurrX > WinMaxX then
+    begin
+      CurrX := WinMinX;
+      Inc(CurrY);
+    end; { if }
+
+  While CurrY > WinMaxY do
+   begin
+     RemoveLine(1);
+     Dec(CurrY);
+   end; { while }
+
+end;
 
-      { Get key value }
 
-      with Result do begin
+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;
 
-        KeyStatus := 0;
-        AsciiChar := pInput^.KeyEvent.AsciiChar;
-        KeyCode := wVirtualKeyCode;
 
-      { Set bits 0..2 of KeyStatus to indicate control key state}
+Function CrtRead(Var F: TextRec): Integer;
 
-      if ((dwControlKeyState AND SHIFT_PRESSED) > 0) then
-        KeyStatus := (KeyStatus OR $01);
-      if ((dwControlKeyState AND
-          (RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0) then
-        KeyStatus := (KeyStatus OR $02);
-      if ((dwControlKeyState AND
-          (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0) then
-        KeyStatus := (KeyStatus OR $04);
+  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;
 
-      end;
+var
+  ch : Char;
+Begin
+  GetScreenCursor(CurrX,CurrY);
+  f.bufpos:=0;
+  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;
+          end;
+    else
+     begin
+       if f.bufpos<f.bufsize-2 then
+        begin
+          f.buffer[f.bufpos]:=ch;
+          inc(f.bufpos);
+          WriteChar(ch);
+        end;
+     end;
     end;
-  finally
-    Dispose(pInput);
-  end;
+  until false;
+  f.bufpos:=0;
+  SetScreenCursor(CurrX,CurrY);
+  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;
 
+var CursorInfo: TConsoleCursorInfo;
 begin
-  New(pCsbi);
-  pCsbi^ := GetScreenInfo;
-  StartTextIntensity := pCsbi^.wAttributes AND FOREGROUND_INTENSITY;
-  StartBackgroundIntensity := pCsbi^.wAttributes AND BACKGROUND_INTENSITY;
-  Dispose(pCsbi);
-end.
+  { Initialize the output handles }
+  OutHandle := GetStdHandle(STD_OUTPUT_HANDLE);
+  InputHandle := GetStdHandle(STD_INPUT_HANDLE);
+  UsingAttr := 07;
+  LastMode := 3;
+
+  {--------------------- Get the cursor information -------------------------}
+  GetConsoleCursorInfo(OutHandle, CursorInfo);
+  SaveCursorSize := CursorInfo.dwSize;
+
+
+  { Load startup values }
+  ScreenWidth := GetScreenWidth;
+  ScreenHeight := GetScreenHeight;
+  WindMax := (ScreenWidth - 1) OR ((ScreenHeight - 1) SHL 8);
+
+
+  { Redirect the standard output }
+  AssignCrt(Output);
+  Rewrite(Output);
+  TextRec(Output).Handle:= OutHandle;
+
+  AssignCrt(Input);
+  Reset(Input);
+  TextRec(Input).Handle:= InputHandle;
+end. { unit Crt }
+{
+  $Log$
+  Revision 1.2  1999-04-20 11:34:12  peter
+    + crt unit that compiles
+
+}
+