123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571 |
- {
- 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.
- [email protected]
- }
- {$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 *)
|