paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-17 23:49:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Moved CRT interface to common include file

Browse Source
This commit is contained in:
michael 2004-02-08 16:22:20 +00:00
parent 515ee5aef6
commit 66dd127bd9
9 changed files with 264 additions and 641 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
rtl/amiga/crt.pp
View File

@ -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
}

113
rtl/emx/crt.pas
View File

@ -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

85
rtl/go32v2/crt.pp
View File

@ -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

102
rtl/inc/crth.inc Normal file
View File

@ -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
}

80
rtl/netware/crt.pp
View File

@ -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

115
rtl/os2/crt.pas
View File

@ -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

101
rtl/unix/crt.pp
View File

@ -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

82
rtl/watcom/crt.pp
View File

@ -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

132
rtl/win32/crt.pp
View File

@ -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