diff --git a/rtl/amiga/crt.pp b/rtl/amiga/crt.pp index eaab831e17..985a97efc8 100644 --- a/rtl/amiga/crt.pp +++ b/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 } diff --git a/rtl/emx/crt.pas b/rtl/emx/crt.pas index ad4dad5db3..120dc019ee 100644 --- a/rtl/emx/crt.pas +++ b/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 diff --git a/rtl/go32v2/crt.pp b/rtl/go32v2/crt.pp index b85d8f49b6..ba8fe6ab47 100644 --- a/rtl/go32v2/crt.pp +++ b/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 } +{$i crth.inc} -{ 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 } +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 diff --git a/rtl/inc/crth.inc b/rtl/inc/crth.inc new file mode 100644 index 0000000000..10404f4575 --- /dev/null +++ b/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 + +} diff --git a/rtl/netware/crt.pp b/rtl/netware/crt.pp index 772ae0570c..8e6ac833bf 100644 --- a/rtl/netware/crt.pp +++ b/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 } +{$i crth.inc} -{ 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, 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 diff --git a/rtl/os2/crt.pas b/rtl/os2/crt.pas index 12402ecf19..901fb3a030 100644 --- a/rtl/os2/crt.pas +++ b/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); +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; @@ -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 diff --git a/rtl/unix/crt.pp b/rtl/unix/crt.pp index 8302c81346..7c6c107c6e 100644 --- a/rtl/unix/crt.pp +++ b/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 diff --git a/rtl/watcom/crt.pp b/rtl/watcom/crt.pp index 56bfba0dd8..e2aa5f9c04 100644 --- a/rtl/watcom/crt.pp +++ b/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; - +{$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 diff --git a/rtl/win32/crt.pp b/rtl/win32/crt.pp index 7436da60a9..55c88fe3a6 100644 --- a/rtl/win32/crt.pp +++ b/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); -Procedure Window(X1, Y1, X2, Y2: DWord); +begin + Window32(X1,Y1,X2,Y2); +end; + +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