paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 18:25:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

* API 2 RTL

Browse Source
This commit is contained in:
peter 2001-01-13 11:13:12 +00:00
parent 9d6b7fdcc0
commit 3baf37cbd1
5 changed files with 556 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
rtl/inc/keyboard.inc Normal file
View File

@ -0,0 +1,62 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
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.
**********************************************************************}
procedure PutKeyEvent(KeyEvent: TKeyEvent);
begin
PendingKeyEvent := KeyEvent;
end;
function GetKeyEventFlags(KeyEvent: TKeyEvent): Byte;
begin
GetKeyEventFlags := (KeyEvent and $FF000000) shr 24;
end;
function GetKeyEventChar(KeyEvent: TKeyEvent): Char;
begin
if KeyEvent and $03000000 = $00000000 then
GetKeyEventChar := Chr(KeyEvent and $000000FF)
else
GetKeyEventChar := #0;
end;
function GetKeyEventUniCode(KeyEvent: TKeyEvent): Word;
begin
if KeyEvent and $03000000 = $01000000 then
GetKeyEventUniCode := KeyEvent and $0000FFFF
else
GetKeyEventUniCode := 0;
end;
function GetKeyEventCode(KeyEvent: TKeyEvent): Word;
begin
GetKeyEventCode := KeyEvent and $0000FFFF
end;
function GetKeyEventShiftState(KeyEvent: TKeyEvent): Byte;
begin
GetKeyEventShiftState := (KeyEvent and $00FF0000) shr 16;
end;
function IsFunctionKey(KeyEvent: TKeyEvent): Boolean;
begin
IsFunctionKey := KeyEvent and $03000000 = $02000000;
end;
{
$Log$
Revision 1.1 2001-01-13 11:13:12 peter
* API 2 RTL
}

159
rtl/inc/keybrdh.inc Normal file
View File

@ -0,0 +1,159 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
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
{ We have an errorcode base of 1010 }
errKbdBase = 1010;
errKbdInitError = errKbdBase + 0;
errKbdNotImplemented = errKbdBase + 1;
type
TKeyEvent = Longint;
{ The structure of a TKeyEvent follows in LSB-MSB order:
2 bytes: depending on flags either the physical representation of a key
(under DOS scancode, ascii code pair), or the translated
ASCII/unicode character
1 byte: shift-state when this key was pressed (or shortly after)
1 byte: flags, the following flags are defined:
bit0-1
0: the lowest two bytes is the translated ASCII value
1: the lowest two bytes is the translated Unicode value
(wide-char)
2: the lowest two bytes is a function key, and the lowest
two bytes contains its platform independent code
3: the lowest two bytes is the physical representation
bit2
0: the key is pressed
1: the key is released (This event is not guaranteed to occur on all platforms)
bit3-7 undefined, should be 0
If there are two keys returning the same char-code, there's no way to find
out which one was pressed (Gray+ and Simple+). If you need to know which
was pressed, you'll need to use the untranslated keycodes, which is system
dependent. System dependent constants may be defined to cover those, with
possibily having the same name (but different value). }
{ System independent function key codes }
const
kbdF1 = $FF01;
kbdF2 = $FF02;
kbdF3 = $FF03;
kbdF4 = $FF04;
kbdF5 = $FF05;
kbdF6 = $FF06;
kbdF7 = $FF07;
kbdF8 = $FF08;
kbdF9 = $FF09;
kbdF10 = $FF0A;
kbdF11 = $FF0B;
kbdF12 = $FF0C;
kbdF13 = $FF0D;
kbdF14 = $FF0E;
kbdF15 = $FF0F;
kbdF16 = $FF10;
kbdF17 = $FF11;
kbdF18 = $FF12;
kbdF19 = $FF13;
kbdF20 = $FF14;
{ $15 - $1F reserved for future Fxx keys }
kbdHome = $FF20;
kbdUp = $FF21;
kbdPgUp = $FF22;
kbdLeft = $FF23;
kbdMiddle = $FF24;
kbdRight = $FF25;
kbdEnd = $FF26;
kbdDown = $FF27;
kbdPgDn = $FF28;
kbdInsert = $FF29;
kbdDelete = $FF2A;
{ $2B - $2F reserved for future keypad keys }
{ possible flag values }
kbASCII = $00;
kbUniCode = $01;
kbFnKey = $02;
kbPhys = $03;
kbReleased = $04;
{ shiftstate flags }
kbLeftShift = 1;
kbRightShift = 2;
kbShift = kbLeftShift or kbRightShift;
kbCtrl = 4;
kbAlt = 8;
var
PendingKeyEvent : TKeyEvent;
procedure InitKeyboard;
{ Initializes the keyboard interface, additional platform specific parameters
can be passed by global variables (RawMode etc.) for the first implementation
under DOS it does nothing }
procedure DoneKeyboard;
{ Deinitializes the keyboard interface }
function GetKeyEvent: TKeyEvent;
{ Returns the last keyevent, and waits for one if not available }
procedure PutKeyEvent(KeyEvent: TKeyEvent);
{ Adds the given KeyEvent to the input queue. Please note that depending on
the implementation this can hold only one value (NO FIFOs etc) }
function PollKeyEvent: TKeyEvent;
{ Checks if a keyevent is available, and returns it if one is found. If no
event is pending, it returns 0 }
function PollShiftStateEvent: TKeyEvent;
{ Return the current shiftstate in a keyevent }
function TranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
{ Performs ASCII translation of the KeyEvent }
function TranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
{ Performs Unicode translation of the KeyEvent }
function GetKeyEventFlags(KeyEvent: TKeyEvent): Byte;
{ Returns the flags part of the given KeyEvent }
function GetKeyEventChar(KeyEvent: TKeyEvent): Char;
{ Returns the charcode part of the given KeyEvent, if it contains a translated
keycode }
function GetKeyEventUniCode(KeyEvent: TKeyEvent): Word;
{ Returns the unicode part of the given KeyEvent, if it contains a translated
unicode character }
function GetKeyEventCode(KeyEvent: TKeyEvent): Word;
{ Returns the translated function keycode part of the given KeyEvent, if it
contains a translated function keycode }
function GetKeyEventShiftState(KeyEvent: TKeyEvent): Byte;
{ Returns the shift-state values of the given KeyEvent }
function IsFunctionKey(KeyEvent: TKeyEvent): Boolean;
{ Returns true if the given key was a function key or not }
{
$Log$
Revision 1.1 2001-01-13 11:13:12 peter
* API 2 RTL
}

96
rtl/inc/mouseh.inc Normal file
View File

@ -0,0 +1,96 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
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
{ We have an errorcode base of 1030 }
errMouseBase = 1030;
errMouseInitError = errMouseBase + 0;
errMouseNotImplemented = errMouseBase + 1;
type
PMouseEvent=^TMouseEvent;
TMouseEvent=packed record { 8 bytes }
buttons : word;
x,y : word;
Action : word;
end;
const
MouseActionDown = $0001; { Mouse down event }
MouseActionUp = $0002; { Mouse up event }
MouseActionMove = $0004; { Mouse move event }
MouseLeftButton = $01; { Left mouse button }
MouseRightButton = $02; { Right mouse button }
MouseMiddleButton = $04; { Middle mouse button }
var
PendingMouseEvent : array[0..MouseEventBufSize-1] of TMouseEvent;
PendingMouseHead,
PendingMouseTail : PMouseEvent;
PendingMouseEvents : byte;
LastMouseEvent : TMouseEvent;
MouseIntFlag : Byte; { Mouse in int flag }
MouseButtons : Byte; { Mouse button state }
MouseWhereX,
MouseWhereY : Word; { Mouse position }
procedure InitMouse;
{ Initialize the mouse interface }
procedure DoneMouse;
{ Deinitialize the mouse interface }
function DetectMouse:byte;
{ Detect if a mouse is present, returns the amount of buttons or 0
if no mouse is found }
procedure ShowMouse;
{ Show the mouse cursor }
procedure HideMouse;
{ Hide the mouse cursor }
function GetMouseX:word;
{ Return the current X position of the mouse }
function GetMouseY:word;
{ Return the current Y position of the mouse }
function GetMouseButtons:word;
{ Return the current button state of the mouse }
procedure SetMouseXY(x,y:word);
{ Place the mouse cursor on x,y }
procedure GetMouseEvent(var MouseEvent:TMouseEvent);
{ Returns the last Mouseevent, and waits for one if not available }
procedure PutMouseEvent(const MouseEvent: TMouseEvent);
{ Adds the given MouseEvent to the input queue. Please note that depending on
the implementation this can hold only one value (NO FIFOs etc) }
function PollMouseEvent(var MouseEvent: TMouseEvent):boolean;
{ Checks if a Mouseevent is available, and returns it if one is found. If no
event is pending, it returns 0 }
{
$Log$
Revision 1.1 2001-01-13 11:13:12 peter
* API 2 RTL
}

81
rtl/inc/video.inc Normal file
View File

@ -0,0 +1,81 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
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.
**********************************************************************}
procedure GetVideoMode(var Mode: TVideoMode);
begin
Mode.Col := ScreenWidth;
Mode.Row := ScreenHeight;
Mode.Color := ScreenColor;
end;
procedure SetVideoMode(Mode: TVideoMode);
var
P: PVideoModeList;
begin
P := Modes;
while (P<>Nil) and ((P^.Row <> Mode.Row) or (P^.Col <> Mode.Col) or (P^.Color<>Mode.Color)) do
P := P^.Next;
if P <> nil then begin
DoneVideo;
ScreenWidth:=$ffff;
ScreenHeight:=$ffff;
P^.VideoModeSelector(PVideoMode(P)^, P^.Params);
InitVideo;
end
else begin
ErrorHandler(errVioNoSuchMode, @Mode);
end;
end;
procedure RegisterVideoMode(Col, Row: Word; Color: Boolean; VideoModeSelector: TVideoModeSelector; Params: Longint);
var
P: PVideoModeList;
begin
New(P);
P^.Col := Col;
P^.Row := Row;
P^.Color := Color;
P^.VideoModeSelector := VideoModeSelector;
P^.Params := Params;
P^.Next := Modes;
Modes := P;
end;
procedure UnRegisterVideoModes;
var
P: PVideoModeList;
begin
while assigned(modes) do
begin
p:=modes;
modes:=modes^.next;
dispose(p);
end;
end;
function DefaultErrorHandler(AErrorCode: Longint; AErrorInfo: Pointer): TErrorHandlerReturnValue;
begin
ErrorCode := AErrorCode;
ErrorInfo := AErrorInfo;
DefaultErrorHandler := errAbort; { return error code }
end;
{
$Log$
Revision 1.1 2001-01-13 11:13:12 peter
* API 2 RTL
}

158
rtl/inc/videoh.inc Normal file
View File

@ -0,0 +1,158 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
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.
**********************************************************************}
type
PVideoMode = ^TVideoMode;
TVideoMode = record
Col,Row : Word;
Color : Boolean;
end;
TVideoModeSelector = function (const VideoMode: TVideoMode; Params: Longint): Boolean;
TVideoCell = Word;
PVideoCell = ^TVideoCell;
TVideoBuf = array[0..32759] of TVideoCell;
PVideoBuf = ^TVideoBuf;
const
{ 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;
{ Capabilities bitmask }
cpUnderLine = $0001;
cpBlink = $0002;
cpColor = $0004;
cpChangeFont = $0008;
cpChangeMode = $0010;
cpChangeCursor = $0020;
{ Possible cursor types }
crHidden = 0;
crUnderLine = 1;
crBlock = 2;
crHalfBlock = 3;
{ Possible error codes }
vioOK = 0;
errVioBase = 1000;
errVioInit = errVioBase + 1; { Initialization error, shouldn't occur on DOS, but may
on Linux }
errVioNotSupported = errVioBase + 2; { call to an unsupported function }
errVioNoSuchMode = errVioBase + 3; { No such video mode }
const
ScreenWidth : Word = 0;
ScreenHeight : Word = 0;
var
ScreenColor : Boolean;
CursorX,
CursorY : Word;
LockUpdateScreen : Word;
VideoBuf : PVideoBuf;
VideoBufSize : Longint;
CursorLines : Byte;
const
LowAscii : Boolean = true;
NoExtendedFrame : Boolean = false;
FVMaxWidth = 132;
procedure InitVideo;
{ Initializes the video subsystem }
procedure DoneVideo;
{ Deinitializes the video subsystem }
function GetCapabilities: Word;
{ Return the capabilities of the current environment }
procedure ClearScreen;
{ Clears the screen }
procedure UpdateScreen(Force: Boolean);
{ Force specifies whether the whole screen has to be redrawn, or (if target
platform supports it) its parts only }
procedure SetCursorPos(NewCursorX, NewCursorY: Word);
{ Position the cursor to the given position }
function GetCursorType: Word;
{ Return the cursor type: Hidden, UnderLine or Block }
procedure SetCursorType(NewType: Word);
{ Set the cursor to the given type }
function DefaultVideoModeSelector(const VideoMode: TVideoMode; Params: Longint): Boolean;
procedure GetVideoMode(var Mode: TVideoMode);
{ Return dimensions of the current video mode }
procedure SetVideoMode(Mode: TVideoMode);
{ Set video-mode to have Mode dimensions, may return errVioNoSuchMode }
procedure RegisterVideoMode(Col, Row: Word; Color: Boolean; VideoModeSelector: TVideoModeSelector; Params: Longint);
{ Registers a video mode to be selectable by SetVideoMode }
{ moved to interface because we need a way to retrieve the modes }
{ System independent part }
type
PVideoModeList = ^TVideoModeList;
TVideoModeList = record
Col, Row: Word;
Color: Boolean;
VideoModeSelector: TVideoModeSelector;
Params: Longint;
Next: PVideoModeList;
end;
const
Modes: PVideoModeList = nil;
type
TErrorHandlerReturnValue = (errRetry, errAbort, errContinue);
{ errRetry = retry the operation,
errAbort = abort, return error code,
errContinue = abort, without returning errorcode }
TErrorHandler = function (Code: Longint; Info: Pointer): TErrorHandlerReturnValue;
{ ErrorHandler is the standard procedural interface for all error functions.
Info may contain any data type specific to the error code passed to the
function. }
function DefaultErrorHandler(AErrorCode: Longint; AErrorInfo: Pointer): TErrorHandlerReturnValue;
{ Default error handler, simply sets error code, and returns errContinue }
const
errOk = 0;
ErrorCode: Longint = ErrOK;
ErrorInfo: Pointer = nil;
ErrorHandler: TErrorHandler = DefaultErrorHandler;
{
$Log$
Revision 1.1 2001-01-13 11:13:12 peter
* API 2 RTL
}