{
This file is part of the Free Pascal run time library.
A file in Amiga system run time library.
Copyright (c) 1998-2003 by Nils Sjoholm
member of the Amiga RTL 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.
**********************************************************************}
{
History:
Added functions and procedures with array of const.
For use with fpc 1.0.7. Thay are in systemvartags.
11 Nov 2002.
Added the defines use_amiga_smartlink and
use_auto_openlib.
13 Jan 2003.
Update for AmigaOS 3.9.
Changed startcode for unit.
09 Feb 2003.
nils.sjoholm@mailbox.swipnet.se
}
{$I useamigasmartlink.inc}
{$ifdef use_amiga_smartlink}
{$smartlink on}
{$endif use_amiga_smartlink}
UNIT lowlevel;
INTERFACE
USES exec, utility, timer;
Type
{ structure for use with QueryKeys() }
pKeyQuery = ^tKeyQuery;
tKeyQuery = record
kq_KeyCode : WORD;
kq_Pressed : Boolean;
end;
{***************************************************************************}
Const
LOWLEVELNAME : PChar = 'lowlevel.library';
{ bits in the return value of GetKey() }
LLKB_LSHIFT = 16;
LLKB_RSHIFT = 17;
LLKB_CAPSLOCK = 18;
LLKB_CONTROL = 19;
LLKB_LALT = 20;
LLKB_RALT = 21;
LLKB_LAMIGA = 22;
LLKB_RAMIGA = 23;
LLKF_LSHIFT = 65536;
LLKF_RSHIFT = 131072;
LLKF_CAPSLOCK = 262144;
LLKF_CONTROL = 524288;
LLKF_LALT = 1048576;
LLKF_RALT = 2097152;
LLKF_LAMIGA = 4194304;
LLKF_RAMIGA = 8388608;
{***************************************************************************}
{ Tags for SetJoyPortAttrs() }
SJA_Dummy = (TAG_USER+$c00100);
SJA_Type = (SJA_Dummy+1); { force type to mouse, joy, game cntrlr }
SJA_Reinitialize = (SJA_Dummy+2); { free potgo bits, reset to autosense }
{ Controller types for SJA_Type tag }
SJA_TYPE_AUTOSENSE = 0;
SJA_TYPE_GAMECTLR = 1;
SJA_TYPE_MOUSE = 2;
SJA_TYPE_JOYSTK = 3;
{***************************************************************************}
{ ReadJoyPort() return value definitions }
{ Port types }
JP_TYPE_NOTAVAIL = 0; { port data unavailable }
JP_TYPE_GAMECTLR = 268435456; { port has game controller }
JP_TYPE_MOUSE = 536870912; { port has mouse }
JP_TYPE_JOYSTK = 805306368; { port has joystick }
JP_TYPE_UNKNOWN = 1073741824; { port has unknown device }
JP_TYPE_MASK = -268435456; { controller type }
{ Button types, valid for all types except JP_TYPE_NOTAVAIL }
JPB_BUTTON_BLUE = 23; { Blue - Stop; Right Mouse }
JPB_BUTTON_RED = 22; { Red - Select; Left Mouse; Joystick Fire }
JPB_BUTTON_YELLOW = 21; { Yellow - Repeat }
JPB_BUTTON_GREEN = 20; { Green - Shuffle }
JPB_BUTTON_FORWARD = 19; { Charcoal - Forward }
JPB_BUTTON_REVERSE = 18; { Charcoal - Reverse }
JPB_BUTTON_PLAY = 17; { Grey - Play/Pause; Middle Mouse }
JPF_BUTTON_BLUE = 8388608;
JPF_BUTTON_RED = 4194304;
JPF_BUTTON_YELLOW = 2097152;
JPF_BUTTON_GREEN = 1048576;
JPF_BUTTON_FORWARD = 524288;
JPF_BUTTON_REVERSE = 262144;
JPF_BUTTON_PLAY = 131072;
JP_BUTTON_MASK = JPF_BUTTON_BLUE OR JPF_BUTTON_RED OR JPF_BUTTON_YELLOW OR JPF_BUTTON_GREEN OR JPF_BUTTON_FORWARD OR JPF_BUTTON_REVERSE OR JPF_BUTTON_PLAY;
{ Direction types, valid for JP_TYPE_GAMECTLR and JP_TYPE_JOYSTK }
JPB_JOY_UP = 3;
JPB_JOY_DOWN = 2;
JPB_JOY_LEFT = 1;
JPB_JOY_RIGHT = 0;
JPF_JOY_UP = 8;
JPF_JOY_DOWN = 4;
JPF_JOY_LEFT = 2;
JPF_JOY_RIGHT = 1;
JP_DIRECTION_MASK = JPF_JOY_UP OR JPF_JOY_DOWN OR JPF_JOY_LEFT OR JPF_JOY_RIGHT;
{ Mouse position reports, valid for JP_TYPE_MOUSE }
JP_MHORZ_MASK = 255; { horzizontal position }
JP_MVERT_MASK = 65280; { vertical position }
JP_MOUSE_MASK = JP_MHORZ_MASK OR JP_MVERT_MASK;
{ Obsolete ReadJoyPort() definitions, here for source code compatibility only.
* Please do NOT use in new code.
}
JPB_BTN1 = JPB_BUTTON_BLUE ;
JPF_BTN1 = JPF_BUTTON_BLUE ;
JPB_BTN2 = JPB_BUTTON_RED ;
JPF_BTN2 = JPF_BUTTON_RED ;
JPB_BTN3 = JPB_BUTTON_YELLOW ;
JPF_BTN3 = JPF_BUTTON_YELLOW ;
JPB_BTN4 = JPB_BUTTON_GREEN ;
JPF_BTN4 = JPF_BUTTON_GREEN ;
JPB_BTN5 = JPB_BUTTON_FORWARD;
JPF_BTN5 = JPF_BUTTON_FORWARD;
JPB_BTN6 = JPB_BUTTON_REVERSE;
JPF_BTN6 = JPF_BUTTON_REVERSE;
JPB_BTN7 = JPB_BUTTON_PLAY ;
JPF_BTN7 = JPF_BUTTON_PLAY ;
JPB_UP = JPB_JOY_UP ;
JPF_UP = JPF_JOY_UP ;
JPB_DOWN = JPB_JOY_DOWN ;
JPF_DOWN = JPF_JOY_DOWN ;
JPB_LEFT = JPB_JOY_LEFT ;
JPF_LEFT = JPF_JOY_LEFT ;
JPB_RIGHT = JPB_JOY_RIGHT ;
JPF_RIGHT = JPF_JOY_RIGHT ;
{***************************************************************************}
{ Tags for SystemControl() }
SCON_Dummy = (TAG_USER+$00C00000);
SCON_TakeOverSys = (SCON_Dummy+0);
SCON_KillReq = (SCON_Dummy+1);
SCON_CDReboot = (SCON_Dummy+2);
SCON_StopInput = (SCON_Dummy+3);
SCON_AddCreateKeys = (SCON_Dummy+4);
SCON_RemCreateKeys = (SCON_Dummy+5);
{ Reboot control values for use with SCON_CDReboot tag }
CDReboot_On = 1;
CDReboot_Off = 0;
CDReboot_Default = 2;
{***************************************************************************}
{ Rawkey codes returned when using SCON_AddCreateKeys with SystemControl() }
RAWKEY_PORT0_BUTTON_BLUE = $72;
RAWKEY_PORT0_BUTTON_RED = $78;
RAWKEY_PORT0_BUTTON_YELLOW = $77;
RAWKEY_PORT0_BUTTON_GREEN = $76;
RAWKEY_PORT0_BUTTON_FORWARD = $75;
RAWKEY_PORT0_BUTTON_REVERSE = $74;
RAWKEY_PORT0_BUTTON_PLAY = $73;
RAWKEY_PORT0_JOY_UP = $79;
RAWKEY_PORT0_JOY_DOWN = $7A;
RAWKEY_PORT0_JOY_LEFT = $7C;
RAWKEY_PORT0_JOY_RIGHT = $7B;
RAWKEY_PORT1_BUTTON_BLUE = $172;
RAWKEY_PORT1_BUTTON_RED = $178;
RAWKEY_PORT1_BUTTON_YELLOW = $177;
RAWKEY_PORT1_BUTTON_GREEN = $176;
RAWKEY_PORT1_BUTTON_FORWARD = $175;
RAWKEY_PORT1_BUTTON_REVERSE = $174;
RAWKEY_PORT1_BUTTON_PLAY = $173;
RAWKEY_PORT1_JOY_UP = $179;
RAWKEY_PORT1_JOY_DOWN = $17A;
RAWKEY_PORT1_JOY_LEFT = $17C;
RAWKEY_PORT1_JOY_RIGHT = $17B;
RAWKEY_PORT2_BUTTON_BLUE = $272;
RAWKEY_PORT2_BUTTON_RED = $278;
RAWKEY_PORT2_BUTTON_YELLOW = $277;
RAWKEY_PORT2_BUTTON_GREEN = $276;
RAWKEY_PORT2_BUTTON_FORWARD = $275;
RAWKEY_PORT2_BUTTON_REVERSE = $274;
RAWKEY_PORT2_BUTTON_PLAY = $273;
RAWKEY_PORT2_JOY_UP = $279;
RAWKEY_PORT2_JOY_DOWN = $27A;
RAWKEY_PORT2_JOY_LEFT = $27C;
RAWKEY_PORT2_JOY_RIGHT = $27B;
RAWKEY_PORT3_BUTTON_BLUE = $372;
RAWKEY_PORT3_BUTTON_RED = $378;
RAWKEY_PORT3_BUTTON_YELLOW = $377;
RAWKEY_PORT3_BUTTON_GREEN = $376;
RAWKEY_PORT3_BUTTON_FORWARD = $375;
RAWKEY_PORT3_BUTTON_REVERSE = $374;
RAWKEY_PORT3_BUTTON_PLAY = $373;
RAWKEY_PORT3_JOY_UP = $379;
RAWKEY_PORT3_JOY_DOWN = $37A;
RAWKEY_PORT3_JOY_LEFT = $37C;
RAWKEY_PORT3_JOY_RIGHT = $37B;
{***************************************************************************}
{ Return values for GetLanguageSelection() }
LANG_UNKNOWN = 0 ;
LANG_AMERICAN = 1 ; { American English }
LANG_ENGLISH = 2 ; { British English }
LANG_GERMAN = 3 ;
LANG_FRENCH = 4 ;
LANG_SPANISH = 5 ;
LANG_ITALIAN = 6 ;
LANG_PORTUGUESE = 7 ;
LANG_DANISH = 8 ;
LANG_DUTCH = 9 ;
LANG_NORWEGIAN = 10;
LANG_FINNISH = 11;
LANG_SWEDISH = 12;
LANG_JAPANESE = 13;
LANG_CHINESE = 14;
LANG_ARABIC = 15;
LANG_GREEK = 16;
LANG_HEBREW = 17;
LANG_KOREAN = 18;
{***************************************************************************}
{ --- functions in V40 or higher (Release 3.1) --- }
VAR LowLevelBase : pLibrary;
FUNCTION AddKBInt(const intRoutine : POINTER;const intData : POINTER) : POINTER;
FUNCTION AddTimerInt(const intRoutine : POINTER;const intData : POINTER) : POINTER;
FUNCTION AddVBlankInt(const intRoutine : POINTER;const intData : POINTER) : POINTER;
FUNCTION ElapsedTime(context : pEClockVal) : ULONG;
FUNCTION GetKey : ULONG;
FUNCTION GetLanguageSelection : BYTE;
PROCEDURE QueryKeys(queryArray : pKeyQuery; arraySize : ULONG);
FUNCTION ReadJoyPort(port : ULONG) : ULONG;
PROCEDURE RemKBInt(intHandle : POINTER);
PROCEDURE RemTimerInt(intHandle : POINTER);
PROCEDURE RemVBlankInt(intHandle : POINTER);
FUNCTION SetJoyPortAttrsA(portNumber : ULONG;const tagList : pTagItem) : BOOLEAN;
PROCEDURE StartTimerInt(intHandle : POINTER; timeInterval : ULONG; continuous : LONGINT);
PROCEDURE StopTimerInt(intHandle : POINTER);
FUNCTION SystemControlA(const tagList : pTagItem) : ULONG;
{Here we read how to compile this unit}
{You can remove this include and use a define instead}
{$I useautoopenlib.inc}
{$ifdef use_init_openlib}
procedure InitLOWLEVELLibrary;
{$endif use_init_openlib}
{This is a variable that knows how the unit is compiled}
var
LOWLEVELIsCompiledHow : longint;
IMPLEMENTATION
{$ifndef dont_use_openlib}
uses msgbox;
{$endif dont_use_openlib}
FUNCTION AddKBInt(const intRoutine : POINTER;const intData : POINTER) : POINTER;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L intRoutine,A0
MOVEA.L intData,A1
MOVEA.L LowLevelBase,A6
JSR -060(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION AddTimerInt(const intRoutine : POINTER;const intData : POINTER) : POINTER;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L intRoutine,A0
MOVEA.L intData,A1
MOVEA.L LowLevelBase,A6
JSR -078(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION AddVBlankInt(const intRoutine : POINTER;const intData : POINTER) : POINTER;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L intRoutine,A0
MOVEA.L intData,A1
MOVEA.L LowLevelBase,A6
JSR -108(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION ElapsedTime(context : pEClockVal) : ULONG;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L context,A0
MOVEA.L LowLevelBase,A6
JSR -102(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION GetKey : ULONG;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L LowLevelBase,A6
JSR -048(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
FUNCTION GetLanguageSelection : BYTE;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L LowLevelBase,A6
JSR -036(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE QueryKeys(queryArray : pKeyQuery; arraySize : ULONG);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L queryArray,A0
MOVE.L arraySize,D1
MOVEA.L LowLevelBase,A6
JSR -054(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION ReadJoyPort(port : ULONG) : ULONG;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L port,D0
MOVEA.L LowLevelBase,A6
JSR -030(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
PROCEDURE RemKBInt(intHandle : POINTER);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L intHandle,A1
MOVEA.L LowLevelBase,A6
JSR -066(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE RemTimerInt(intHandle : POINTER);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L intHandle,A1
MOVEA.L LowLevelBase,A6
JSR -084(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE RemVBlankInt(intHandle : POINTER);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L intHandle,A1
MOVEA.L LowLevelBase,A6
JSR -114(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION SetJoyPortAttrsA(portNumber : ULONG;const tagList : pTagItem) : BOOLEAN;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVE.L portNumber,D0
MOVEA.L tagList,A1
MOVEA.L LowLevelBase,A6
JSR -132(A6)
MOVEA.L (A7)+,A6
TST.W D0
BEQ.B @end
MOVEQ #1,D0
@end: MOVE.B D0,@RESULT
END;
END;
PROCEDURE StartTimerInt(intHandle : POINTER; timeInterval : ULONG; continuous : LONGINT);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L intHandle,A1
MOVE.L timeInterval,D0
MOVE.L continuous,D1
MOVEA.L LowLevelBase,A6
JSR -096(A6)
MOVEA.L (A7)+,A6
END;
END;
PROCEDURE StopTimerInt(intHandle : POINTER);
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L intHandle,A1
MOVEA.L LowLevelBase,A6
JSR -090(A6)
MOVEA.L (A7)+,A6
END;
END;
FUNCTION SystemControlA(const tagList : pTagItem) : ULONG;
BEGIN
ASM
MOVE.L A6,-(A7)
MOVEA.L tagList,A1
MOVEA.L LowLevelBase,A6
JSR -072(A6)
MOVEA.L (A7)+,A6
MOVE.L D0,@RESULT
END;
END;
const
{ Change VERSION and LIBVERSION to proper values }
VERSION : string[2] = '0';
LIBVERSION : longword = 0;
{$ifdef use_init_openlib}
{$Info Compiling initopening of lowlevel.library}
{$Info don't forget to use InitLOWLEVELLibrary in the beginning of your program}
var
lowlevel_exit : Pointer;
procedure CloselowlevelLibrary;
begin
ExitProc := lowlevel_exit;
if LowLevelBase <> nil then begin
CloseLibrary(LowLevelBase);
LowLevelBase := nil;
end;
end;
procedure InitLOWLEVELLibrary;
begin
LowLevelBase := nil;
LowLevelBase := OpenLibrary(LOWLEVELNAME,LIBVERSION);
if LowLevelBase <> nil then begin
lowlevel_exit := ExitProc;
ExitProc := @CloselowlevelLibrary;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open lowlevel.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
end;
begin
LOWLEVELIsCompiledHow := 2;
{$endif use_init_openlib}
{$ifdef use_auto_openlib}
{$Info Compiling autoopening of lowlevel.library}
var
lowlevel_exit : Pointer;
procedure CloselowlevelLibrary;
begin
ExitProc := lowlevel_exit;
if LowLevelBase <> nil then begin
CloseLibrary(LowLevelBase);
LowLevelBase := nil;
end;
end;
begin
LowLevelBase := nil;
LowLevelBase := OpenLibrary(LOWLEVELNAME,LIBVERSION);
if LowLevelBase <> nil then begin
lowlevel_exit := ExitProc;
ExitProc := @CloselowlevelLibrary;
LOWLEVELIsCompiledHow := 1;
end else begin
MessageBox('FPC Pascal Error',
'Can''t open lowlevel.library version ' + VERSION + #10 +
'Deallocating resources and closing down',
'Oops');
halt(20);
end;
{$endif use_auto_openlib}
{$ifdef dont_use_openlib}
begin
LOWLEVELIsCompiledHow := 3;
{$Warning No autoopening of lowlevel.library compiled}
{$Warning Make sure you open lowlevel.library yourself}
{$endif dont_use_openlib}
END. (* UNIT LOWLEVEL *)
{
$Log: lowlevel.pas,v $
Revision 1.4 2003/02/10 17:59:46 nils
* fixes for delphi mode
Revision 1.3 2003/01/13 20:36:00 nils
* added the defines use_amiga_smartlink
* and use_auto_openlib
Revision 1.2 2002/11/19 18:47:46 nils
* update check internal log
}
syntax highlighted by Code2HTML, v. 0.9.1