+ Moved CRT interface to common include file

rtl/amiga/crt.pp

@@ -37,95 +37,7 @@ Const
   ScreenWidth  = 80;
   ScreenHeight = 25;
 
-{ 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;
-
-{
-  When using this color constants on the Amiga
-  you can bet that they don't work as expected.
-  You never know what color the user has on
-  his Amiga. Perhaps we should do a check of
-  the number of bitplanes (for number of colors)
-
-  The normal 4 first pens for an Amiga are
-
-  0 LightGrey
-  1 Black
-  2 White
-  3 Blue
-
-}
-
-{ Foreground and background color constants  }
-  Black         = 1;  { normal pen for amiga }
-  Blue          = 3;  { windowborder color   }
-  Green         = 15;
-  Cyan          = 7;
-  Red           = 4;
-  Magenta       = 5;
-  Brown         = 6;
-  LightGray     = 0;  { canvas color         }
-
-{ Foreground color constants }
-  DarkGray      = 8;
-  LightBlue     = 9;
-  LightGreen    = 10;
-  LightCyan     = 11;
-  LightRed      = 12;
-  LightMagenta  = 13;
-  Yellow        = 14;
-  White         = 2;  { third color on amiga }
-
-{ Add-in for blinking }
-  Blink         = 128;
-
-{Other Defaults}
-  LastMode   : Word = 3;
-  WindMin    : Word = $0;
-  WindMax    : Word = $184f;
-{ These don't change anything if they are modified }
-  CheckSnow  : Boolean = FALSE;
-  DirectVideo: Boolean = FALSE;
-var
-  TextAttr : BYTE;
-  { CheckBreak have to make this one to a function for Amiga }
-  CheckEOF : Boolean;
-
-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: byte; 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(DTime: Word);
-Procedure Sound(Hz: Word);
-Procedure NoSound;
-
-{ Extra functions }
-
-Procedure CursorOn;
-Procedure CursorOff;
-Function CheckBreak: Boolean;
+{$i crth.inc}
 
 Implementation
 
@@ -1020,7 +932,10 @@ end.
 
 
   $Log$
-  Revision 1.3  2002-09-07 16:01:16  peter
+  Revision 1.4  2004-02-08 16:22:20  michael
+  + Moved CRT interface to common include file
+
+  Revision 1.3  2002/09/07 16:01:16  peter
     * old logs removed and tabs fixed
 
 }

rtl/emx/crt.pas

@@ -17,72 +17,22 @@ unit crt;
 
 interface
 
-uses dos;
-
-const   _40cols=0;
-        _80cols=1;
-        _132cols=2;
-        _25rows=0;
-        _28rows=16;
-        _43rows=32;
-        _50rows=48;
-        font8x8=_50rows;
-
-        black         =0;
-        blue          =1;
-        green         =2;
-        cyan          =3;
-        red           =4;
-        magenta       =5;
-        brown         =6;
-        lightgray     =7;
-        darkgray      =8;
-        lightblue     =9;
-        lightgreen    =10;
-        lightcyan     =11;
-        lightred      =12;
-        lightmagenta  =13;
-        yellow        =14;
-        white         =15;
-        blink         =128;
+{$i crth.inc}
 
 {cemodeset means that the procedure textmode has failed to set up a mode.}
 
-type    cexxxx=(cenoerror,cemodeset);
+type    
+  cexxxx=(cenoerror,cemodeset);
 
-var textattr:byte;                      {Text attribute.        RW}
-    windmin,windmax:word;               {Window coordinates.    R-}
-    lastmode:word;                      {Last videomode.        R-}
-    crt_error:cexxxx;                   {Crt-status.            RW}
-
-function keypressed:boolean;
-function readkey:char;
-
-procedure clrscr;
-procedure clreol;
-function whereX:byte;
-function whereY:byte;
-procedure gotoXY(x,y:byte);
-procedure window(left,top,right,bottom : byte);
-procedure textmode(mode:integer);
-procedure textcolor(colour:byte);
-procedure textbackground(colour:byte);
-procedure insline;
-procedure delline;
-procedure lowvideo;
-procedure normvideo;
-procedure highvideo;
-procedure assigncrt(var f:text);
-procedure delay(ms:word);
-procedure sound(hz:word);
-procedure nosound;
-
-{***************************************************************************}
+var
+ crt_error:cexxxx;                   {Crt-status.            RW}
 
 {***************************************************************************}
 
 implementation
 
+{$i textrec.inc}
+
 const   extkeycode:char=#0;
 
 var maxrows,maxcols:word;
@@ -493,20 +443,20 @@ begin
     clrscr;
 end;
 
-procedure textcolor(colour:byte);
+procedure textcolor(color:byte);
 
 {All text written after calling this will have color as foreground colour.}
 
 begin
-    textattr:=(textattr and $70) or (colour and $f)+colour and 128;
+    textattr:=(textattr and $70) or (color and $f)+color and 128;
 end;
 
-procedure textbackground(colour:byte);
+procedure textbackground(color:byte);
 
 {All text written after calling this will have colour as background colour.}
 
 begin
-    textattr:=(textattr and $8f) or ((colour and $7) shl 4);
+    textattr:=(textattr and $8f) or ((color and $7) shl 4);
 end;
 
 procedure normvideo;
@@ -554,20 +504,20 @@ begin
         end;
 end;
 
-procedure window(left,top,right,bottom:byte);
+procedure window(X1,Y1,X2,Y2:byte);
 
 {Change the write window to the given coordinates.}
 
 begin
-    if (left<1) or
-     (top<1) or
-     (right>maxcols) or
-     (bottom>maxrows) or
-     (left>right) or
-     (top>bottom) then
+    if (X1<1) or
+     (Y1<1) or
+     (X2>maxcols) or
+     (Y2>maxrows) or
+     (X1>X2) or
+     (Y1>Y2) then
         exit;
-    windmin:=(left-1) or ((top-1) shl 8);
-    windmax:=(right-1) or ((bottom-1) shl 8);
+    windmin:=(X1-1) or ((Y1-1) shl 8);
+    windmax:=(X2-1) or ((Y2-1) shl 8);
     gotoXY(1,1);
 end;
 
@@ -814,6 +764,24 @@ begin
         end;
 end;
 
+procedure cursoron;
+
+begin
+end;
+
+procedure cursoroff;
+
+begin
+end;
+
+procedure cursorbig;
+
+begin
+end;
+
+
+
+
 {Initialization.}
 
 type    Pbyte=^byte;
@@ -894,7 +862,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  2003-10-19 09:35:28  hajny
+  Revision 1.3  2004-02-08 16:22:20  michael
+  + Moved CRT interface to common include file
+
+  Revision 1.2  2003/10/19 09:35:28  hajny
     * fixes from OS/2 merged to EMX
 
   Revision 1.1  2003/03/23 23:11:17  hajny

rtl/go32v2/crt.pp

@@ -3,7 +3,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2000 by the Free Pascal development team.
 
-    Borland Pascal 7 Compatible CRT Unit for Go32V2
+    Borland Pascal 7 Compatible CRT Unit - Go32V2 implementation
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -14,92 +14,20 @@
 
  **********************************************************************}
 unit crt;
-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;
+interface
 
-var
+{$i crth.inc}
 
-{ 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 }
+Var
   ScreenWidth,
   ScreenHeight : 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 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;
 
-
 {$ASMMODE ATT}
 
 var
@@ -842,7 +770,10 @@ end.
 
 {
   $Log$
-  Revision 1.10  2003-10-03 21:56:36  peter
+  Revision 1.11  2004-02-08 16:22:20  michael
+  + Moved CRT interface to common include file
+
+  Revision 1.10  2003/10/03 21:56:36  peter
     * stdcall fixes
 
   Revision 1.9  2003/03/17 18:13:13  peter

rtl/inc/crth.inc

@@ -0,0 +1,102 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team.
+
+    Borland Pascal 7 Compatible CRT Unit - Interface section
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+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;
+
+var
+
+{ 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 }
+  { FPC Specific for large screen support }
+  WindMinX : DWord;
+  WindMaxX : DWord;
+  WindMinY : DWord;
+  WindMaxY : DWord	;
+
+{ 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;
+
+{
+  $Log$
+  Revision 1.1  2004-02-08 16:23:10  michael
+  + Moved CRT interface to common include file
+
+}

rtl/netware/crt.pp

@@ -23,90 +23,14 @@
                    implement that for netware
 }
 unit crt;
-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;
+interface
 
-var
+{$i crth.inc}
 
-{ Interface variables }
-  CheckBreak: Boolean;    { Enable Ctrl-Break, supported on Netware }
-  CheckEOF: Boolean;      { Enable Ctrl-Z, supported on Netware }
-  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 }
-  
 Const
   ScreenHeight : longint=25;
   ScreenWidth  : longint=80;
-    
-  ConsoleMaxX=80;
-  ConsoleMaxY=25;
-
-{ Interface procedures }
-procedure AssignCrt(var F: Text);
-function KeyPressed: Boolean;
-function ReadKey: Char;
-procedure TextMode(Mode: Integer);        {dummy function}
-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);                {dummy function}
-procedure NoSound;                        {dummy function}
-
-{Extra Functions}
-procedure cursoron;
-procedure cursoroff;
-procedure cursorbig;
-
 
 implementation
 

rtl/os2/crt.pas

@@ -13,76 +13,22 @@
 
 unit crt;
 
-
 interface
 
-uses dos;
-
-const
-  _40cols=0;
-  _80cols=1;
-  _132cols=2;
-  _25rows=0;
-  _28rows=16;
-  _43rows=32;
-  _50rows=48;
-  font8x8=_50rows;
-
-  black         =0;
-  blue          =1;
-  green         =2;
-  cyan          =3;
-  red           =4;
-  magenta       =5;
-  brown         =6;
-  lightgray     =7;
-  darkgray      =8;
-  lightblue     =9;
-  lightgreen    =10;
-  lightcyan     =11;
-  lightred      =12;
-  lightmagenta  =13;
-  yellow        =14;
-  white         =15;
-  blink         =128;
+{$i crth.inc}
 
 {cemodeset means that the procedure textmode has failed to set up a mode.}
 
-type    cexxxx=(cenoerror,cemodeset);
-
-var textattr:byte;                      {Text attribute.        RW}
-    windmin,windmax:word;               {Window coordinates.    R-}
-    lastmode:word;                      {Last videomode.        R-}
-    crt_error:cexxxx;                   {Crt-status.            RW}
-
-function keypressed:boolean;
-function readkey:char;
+type    
+  cexxxx=(cenoerror,cemodeset);
 
-procedure clrscr;
-procedure clreol;
-function whereX:byte;
-function whereY:byte;
-procedure gotoXY(x,y:byte);
-procedure window(left,top,right,bottom : byte);
-procedure textmode(mode:integer);
-procedure textcolor(colour:byte);
-procedure textbackground(colour:byte);
-procedure insline;
-procedure delline;
-procedure lowvideo;
-procedure normvideo;
-procedure highvideo;
-procedure assigncrt(var f:text);
-procedure delay(ms:word);
-procedure sound(hz:word);
-procedure nosound;
-
-{***************************************************************************}
-
-{***************************************************************************}
+var
+  crt_error:cexxxx;                   {Crt-status.            RW}
 
 implementation
 
+{$i textrec.inc}
+
 const   extkeycode:char=#0;
 
 var maxrows,maxcols:word;
@@ -338,20 +284,20 @@ begin
     clrscr;
 end;
 
-procedure textcolor(colour:byte);
+procedure textcolor(color:byte);
 
 {All text written after calling this will have color as foreground colour.}
 
 begin
-    textattr:=(textattr and $70) or (colour and $f)+colour and 128;
+    textattr:=(textattr and $70) or (color and $f)+color and 128;
 end;
 
-procedure textbackground(colour:byte);
+procedure textbackground(color:byte);
 
 {All text written after calling this will have colour as background colour.}
 
 begin
-    textattr:=(textattr and $8f) or ((colour and $7) shl 4);
+    textattr:=(textattr and $8f) or ((color and $7) shl 4);
 end;
 
 procedure normvideo;
@@ -384,18 +330,18 @@ begin
   dossleep(ms)
 end;
 
-procedure window(left,top,right,bottom:byte);
+procedure window(X1,Y1,X2,Y2:byte);
 {Change the write window to the given coordinates.}
 begin
-    if (left<1) or
-     (top<1) or
-     (right>maxcols) or
-     (bottom>maxrows) or
-     (left>right) or
-     (top>bottom) then
+    if (X1<1) or
+     (Y1<1) or
+     (X2>maxcols) or
+     (Y2>maxrows) or
+     (X1>X2) or
+     (Y1>Y2) then
         exit;
-    windmin:=(left-1) or ((top-1) shl 8);
-    windmax:=(right-1) or ((bottom-1) shl 8);
+    windmin:=(X1-1) or ((Y1-1) shl 8);
+    windmax:=(X2-1) or ((Y2-1) shl 8);
     gotoXY(1,1);
 end;
 
@@ -563,6 +509,22 @@ procedure nosound;
 begin
 end;
 
+{Extra Functions}
+procedure cursoron;
+
+begin
+end;
+
+procedure cursoroff;
+
+begin
+end;
+
+procedure cursorbig;
+
+begin
+end;
+
 {Initialization.}
 
 var
@@ -596,7 +558,10 @@ end.
 
 {
   $Log$
-  Revision 1.5  2003-10-18 16:53:21  hajny
+  Revision 1.6  2004-02-08 16:22:20  michael
+  + Moved CRT interface to common include file
+
+  Revision 1.5  2003/10/18 16:53:21  hajny
     * longint2cardinal
 
   Revision 1.4  2003/09/24 12:30:08  yuri

rtl/unix/crt.pp

@@ -13,64 +13,19 @@
 
  **********************************************************************}
 unit Crt;
+
 Interface
 
-Const
-{ Controlling consts }
-  Flushing=false;               {if true then don't buffer output}
-
-{ 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;
-
-{Other Defaults}
-  TextAttr   : Byte = $07;
-  LastMode   : Word = 3;
-  WindMin    : Word = $0;
-  WindMax    : Word = $184f;
-var
-  CheckBreak,
-  CheckEOF,
-  CheckSnow,
-  DirectVideo: Boolean;
+{$i crth.inc}  
 
 Const
-  ScreenHeight : longint=25;
-  ScreenWidth  : longint=80;
-
-  ConsoleMaxX=1024;
-  ConsoleMaxY=1024;
+  { Controlling consts }
+  Flushing     = false;               {if true then don't buffer output}
+  ConsoleMaxX  = 1024;
+  ConsoleMaxY  = 1024;
+  ScreenHeight : longint = 25;
+  ScreenWidth  : longint = 80;
+  
 Type
   TCharAttr=packed record
     ch   : char;
@@ -78,37 +33,10 @@ Type
   end;
   TConsoleBuf=Array[0..ConsoleMaxX*ConsoleMaxY-1] of TCharAttr;
   PConsoleBuf=^TConsoleBuf;
+
 var
   ConsoleBuf : PConsoleBuf;
 
-
-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: Byte; 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(DTime: Word);
-Procedure Sound(Hz: Word);
-Procedure NoSound;
-
-{ extra }
-procedure CursorBig;
-procedure CursorOn;
-procedure CursorOff;
-
-
 Implementation
 
 uses BaseUnix ,unix, termio;
@@ -1116,12 +1044,12 @@ Begin
 End;
 
 
-Procedure Delay(DTime: Word);
+Procedure Delay(MS: Word);
 {
   Wait for DTime milliseconds.
 }
 Begin
-  fpSelect(0,nil,nil,nil,DTime);
+  fpSelect(0,nil,nil,nil,MS);
 End;
 
 
@@ -1683,7 +1611,10 @@ Finalization
 End.
 {
   $Log$
-  Revision 1.16  2003-11-24 22:27:25  michael
+  Revision 1.17  2004-02-08 16:22:20  michael
+  + Moved CRT interface to common include file
+
+  Revision 1.16  2003/11/24 22:27:25  michael
   + Bugfix for bug 2741
 
   Revision 1.15  2003/11/19 17:11:40  marco

rtl/watcom/crt.pp

@@ -4,83 +4,10 @@
 }
 
 unit crt;
-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;
 
-var
-
-{ 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;
+interface
 
+{$i crth.inc}
 
 implementation
 
@@ -829,7 +756,10 @@ end.
 
 {
   $Log$
-  Revision 1.3  2003-10-03 21:59:28  peter
+  Revision 1.4  2004-02-08 16:22:20  michael
+  + Moved CRT interface to common include file
+
+  Revision 1.3  2003/10/03 21:59:28  peter
     * stdcall fixes
 
   Revision 1.2  2003/09/07 22:29:26  hajny

rtl/win32/crt.pp

@@ -1,7 +1,9 @@
 {
     $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team.
 
-    Borland Pascal 7 Compatible CRT Unit for win32
+    Borland Pascal 7 Compatible CRT Unit - win32 implentation
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -15,88 +17,12 @@ unit crt;
 
 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;
-
-var
-
-{ 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 }
-  { FPC Specific for large screen support }
-  WindMinX : DWord;
-  WindMaxX : DWord;
-  WindMinY : DWord;
-  WindMaxY : DWord	;
-
-{ Interface procedures }
-procedure AssignCrt(var F: Text);
-function KeyPressed: Boolean;
-function ReadKey: Char;
-procedure TextMode(Mode: Integer);
-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;
-
-{Extra Functions}
-procedure cursoron;
-procedure cursoroff;
-procedure cursorbig;
+{$i crth.inc}
 
+procedure Window32(X1,Y1,X2,Y2: DWord);
+procedure GotoXY32(X,Y: DWord);
+function WhereX32: DWord;
+function WhereY32: DWord;
 
 implementation
 
@@ -219,7 +145,14 @@ Begin
   TextBackGround(0);
 End;
 
-Procedure GotoXY(X: DWord; Y: DWord);
+Procedure GotoXY(X: Byte; Y: Byte);
+
+begin
+  GotoXY32(X,Y);
+end;
+
+Procedure GotoXY32(X: DWord; Y: DWord);
+
 { Go to coordinates X,Y in the current window. }
 Begin
   If (X > 0) and (X <= (WindMaxX - WindMinX + 1)) and
@@ -230,8 +163,13 @@ Begin
   End;
 End;
 
+Procedure Window(X1, Y1, X2, Y2: Byte);
+
+begin
+  Window32(X1,Y1,X2,Y2);
+end;
 
-Procedure Window(X1, Y1, X2, Y2: DWord);
+Procedure Window32(X1, Y1, X2, Y2: DWord);
 {
   Set screen window to the specified coordinates.
 }
@@ -288,7 +226,14 @@ begin
     Coord, @Temp);
 end;
 
-Function WhereX: DWord;
+Function WhereX: Byte;
+
+
+begin
+  WhereX:=WhereX32 mod 256;
+end;
+
+Function WhereX32: DWord;
 {
   Return current X-position of cursor.
 }
@@ -296,10 +241,16 @@ var
   x,y : DWord;
 Begin
   GetScreenCursor(x, y);
-  WhereX:= x - WindMinX +1;
+  WhereX32:= x - WindMinX +1;
 End;
 
-Function WhereY: DWord;
+Function WhereY: Byte;
+
+begin
+  WhereY:=WhereY32 mod 256;
+end;
+
+Function WhereY32: DWord;
 {
   Return current Y-position of cursor.
 }
@@ -307,7 +258,7 @@ var
   x, y : DWord;
 Begin
   GetScreenCursor(x, y);
-  WhereY:= y - WindMinY + 1;
+  WhereY32:= y - WindMinY + 1;
 End;
 
 
@@ -861,7 +812,10 @@ end. { unit Crt }
 
 {
   $Log$
-  Revision 1.20  2003-11-03 09:42:28  marco
+  Revision 1.21  2004-02-08 16:22:20  michael
+  + Moved CRT interface to common include file
+
+  Revision 1.20  2003/11/03 09:42:28  marco
    * Peter's Cardinal<->Longint fixes patch
 
   Revision 1.19  2002/12/15 20:23:30  peter