* API 2 RTL

rtl/inc/keyboard.inc

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

rtl/inc/keybrdh.inc

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

rtl/inc/mouseh.inc

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

rtl/inc/video.inc

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

rtl/inc/videoh.inc

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