{ This file is part of the Free Pascal run time library. A file in Amiga system run time library. Copyright (c) 1998-2002 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 overlay functions for Pchar->Strings, functions and procedures. 14 Jul 2000. Added the defines use_amiga_smartlink and use_auto_openlib. Implemented autoopening of the library. 13 Jan 2003. changed integer > smallint, cardinal > longword. 09 Feb 2003. nils.sjoholm@mailbox.swipnet.se } {$I useamigasmartlink.inc} {$ifdef use_amiga_smartlink} {$smartlink on} {$endif use_amiga_smartlink} unit commodities; INTERFACE uses exec, inputevent, keymap; { ************** * Broker stuff **************} CONST { buffer sizes } CBD_NAMELEN = 24; CBD_TITLELEN = 40; CBD_DESCRLEN = 40; { CxBroker errors } CBERR_OK = 0; { No error } CBERR_SYSERR = 1; { System error , no memory, etc } CBERR_DUP = 2; { uniqueness violation } CBERR_VERSION = 3; { didn't understand nb_VERSION } NB_VERSION = 5; { Version of NewBroker structure } Type pNewBroker = ^tNewBroker; tNewBroker = record nb_Version : Shortint; { set to NB_VERSION } nb_Name, nb_Title, nb_Descr : STRPTR; nb_Unique, nb_Flags : smallint; nb_Pri : Shortint; { new in V5 } nb_Port : pMsgPort; nb_ReservedChannel : smallint; { plans for later port sharing } END; CONST { Flags for nb_Unique } NBU_DUPLICATE = 0; NBU_UNIQUE = 1; { will not allow duplicates } NBU_NOTIFY = 2; { sends CXM_UNIQUE to existing broker } { Flags for nb_Flags } COF_SHOW_HIDE = 4; { ******* * cxusr *******} { * Fake data types for system private objects } Type CxObj = Longint; pCxObj = ^CxObj; CxMsg = Longint; pCXMsg = ^CxMsg; CONST { ******************************} { * Commodities Object Types *} { ******************************} CX_INVALID = 0; { not a valid object (probably null) } CX_FILTER = 1; { input event messages only } CX_TYPEFILTER = 2; { filter on message type } CX_SEND = 3; { sends a message } CX_SIGNAL = 4; { sends a signal } CX_TRANSLATE = 5; { translates IE into chain } CX_BROKER = 6; { application representative } CX_DEBUG = 7; { dumps kprintf to serial port } CX_CUSTOM = 8; { application provids function } CX_ZERO = 9; { system terminator node } { ***************} { * CxMsg types *} { ***************} CXM_UNIQUE = 16; { sent down broker by CxBroker() } { Obsolete: subsumed by CXM_COMMAND (below) } { Messages of this type rattle around the Commodities input network. * They will be sent to you by a Sender object, and passed to you * as a synchronous function call by a Custom object. * * The message port or function entry point is stored in the object, * and the ID field of the message will be set to what you arrange * issuing object. * * The Data field will point to the input event triggering the * message. } CXM_IEVENT = 32; { These messages are sent to a port attached to your Broker. * They are sent to you when the controller program wants your * program to do something. The ID field identifies the command. * * The Data field will be used later. } CXM_COMMAND = 64; { ID values } CXCMD_DISABLE = (15); { please disable yourself } CXCMD_ENABLE = (17); { please enable yourself } CXCMD_APPEAR = (19); { open your window, if you can } CXCMD_DISAPPEAR = (21); { go dormant } CXCMD_KILL = (23); { go away for good } CXCMD_UNIQUE = (25); { someone tried to create a broker * with your name. Suggest you Appear. } CXCMD_LIST_CHG = (27); { Used by Exchange program. Someone } { has changed the broker list } { return values for BrokerCommand(): } CMDE_OK = (0); CMDE_NOBROKER = (-1); CMDE_NOPORT = (-2); CMDE_NOMEM = (-3); { IMPORTANT NOTE: for V5: * Only CXM_IEVENT messages are passed through the input network. * * Other types of messages are sent to an optional port in your broker. * * This means that you must test the message type in your message handling, * if input messages and command messages come to the same port. * * Older programs have no broker port, so processing loops which * make assumptions about type won't encounter the new message types. * * The TypeFilter CxObject is hereby obsolete. * * It is less convenient for the application, but eliminates testing * for type of input messages. } { ********************************************************} { * CxObj Error Flags (return values from CxObjError()) *} { ********************************************************} COERR_ISNULL = 1; { you called CxError(NULL) } COERR_NULLATTACH = 2; { someone attached NULL to my list } COERR_BADFILTER = 4; { a bad filter description was given } COERR_BADTYPE = 8; { unmatched type-specific operation } { ****************************} { Input Expression structure } { ****************************} IX_VERSION = 2; Type pInputXpression = ^tInputXpression; tInputXpression = record ix_Version, { must be set to IX_VERSION } ix_Class : Byte; { class must match exactly } ix_Code : Word; { Bits that we want } ix_CodeMask : Word; { Set bits here to indicate } { which bits in ix_Code are } { don't care bits. } ix_Qualifier: Word; { Bits that we want } ix_QualMask : Word; { Set bits here to indicate } { which bits in ix_Qualifier } { are don't care bits } ix_QualSame : Word; { synonyms in qualifier } END; IX = tInputXpression; pIX = ^IX; CONST { QualSame identifiers } IXSYM_SHIFT = 1; { left- and right- shift are equivalent } IXSYM_CAPS = 2; { either shift or caps lock are equivalent } IXSYM_ALT = 4; { left- and right- alt are equivalent } { corresponding QualSame masks } IXSYM_SHIFTMASK = (IEQUALIFIER_LSHIFT + IEQUALIFIER_RSHIFT); IXSYM_CAPSMASK = (IXSYM_SHIFTMASK + IEQUALIFIER_CAPSLOCK); IXSYM_ALTMASK = (IEQUALIFIER_LALT + IEQUALIFIER_RALT); IX_NORMALQUALS = $7FFF; { for QualMask field: avoid RELATIVEMOUSE } VAR CxBase : pLibrary; const COMMODITIESNAME : PChar = 'commodities.library'; FUNCTION ActivateCxObj(co : pCxObj; tru : LONGINT) : LONGINT; PROCEDURE AddIEvents(events : pInputEvent); PROCEDURE AttachCxObj(headObj : pCxObj; co : pCxObj); PROCEDURE ClearCxObjError(co : pCxObj); FUNCTION CreateCxObj(typ : ULONG; arg1 : LONGINT; arg2 : LONGINT): pCxObj; FUNCTION CxBroker(nb : pNewBroker; error : pCxObj) : pCxObj; FUNCTION CxMsgData(cxm : pCxMsg) : POINTER; FUNCTION CxMsgID(cxm : pCxMsg) : LONGINT; FUNCTION CxMsgType(cxm : pCxMsg) : ULONG; FUNCTION CxObjError(co : pCxObj) : LONGINT; FUNCTION CxObjType(co : pCxObj) : ULONG; PROCEDURE DeleteCxObj(co : pCxObj); PROCEDURE DeleteCxObjAll(co : pCxObj); PROCEDURE DisposeCxMsg(cxm : pCxMsg); PROCEDURE DivertCxMsg(cxm : pCxMsg; headObj : pCxObj; returnObj : pCxObj); PROCEDURE EnqueueCxObj(headObj : pCxObj; co : pCxObj); PROCEDURE InsertCxObj(headObj : pCxObj; co : pCxObj; pred : pCxObj); FUNCTION InvertKeyMap(ansiCode : ULONG; event : pInputEvent; km : pKeyMap) : BOOLEAN; FUNCTION MatchIX(event : pInputEvent; ix : pInputXpression) : BOOLEAN; FUNCTION ParseIX(description : pCHAR; ix : pInputXpression) : LONGINT; PROCEDURE RemoveCxObj(co : pCxObj); PROCEDURE RouteCxMsg(cxm : pCxMsg; co : pCxObj); FUNCTION SetCxObjPri(co : pCxObj; pri : LONGINT) : LONGINT; PROCEDURE SetFilter(filter : pCxObj; text : pCHAR); PROCEDURE SetFilterIX(filter : pCxObj; ix : pInputXpression); PROCEDURE SetTranslate(translator : pCxObj; events : pInputEvent); { overlay functions} FUNCTION ParseIX(description : string; ix : pInputXpression) : LONGINT; PROCEDURE SetFilter(filter : pCxObj; text : string); IMPLEMENTATION uses pastoc,msgbox; FUNCTION ActivateCxObj(co : pCxObj; tru : LONGINT) : LONGINT; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L co,A0 MOVE.L tru,D0 MOVEA.L CxBase,A6 JSR -042(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; PROCEDURE AddIEvents(events : pInputEvent); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L events,A0 MOVEA.L CxBase,A6 JSR -180(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE AttachCxObj(headObj : pCxObj; co : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L headObj,A0 MOVEA.L co,A1 MOVEA.L CxBase,A6 JSR -084(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE ClearCxObjError(co : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L co,A0 MOVEA.L CxBase,A6 JSR -072(A6) MOVEA.L (A7)+,A6 END; END; FUNCTION CreateCxObj(typ : ULONG; arg1 : LONGINT; arg2 : LONGINT) : pCxObj; BEGIN ASM MOVE.L A6,-(A7) MOVE.L typ,D0 MOVEA.L arg1,A0 MOVEA.L arg2,A1 MOVEA.L CxBase,A6 JSR -030(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; FUNCTION CxBroker(nb : pNewBroker; error : pCxObj) : pCxObj; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L nb,A0 MOVE.L error,D0 MOVEA.L CxBase,A6 JSR -036(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; FUNCTION CxMsgData(cxm : pCxMsg) : POINTER; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L cxm,A0 MOVEA.L CxBase,A6 JSR -144(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; FUNCTION CxMsgID(cxm : pCxMsg) : LONGINT; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L cxm,A0 MOVEA.L CxBase,A6 JSR -150(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; FUNCTION CxMsgType(cxm : pCxMsg) : ULONG; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L cxm,A0 MOVEA.L CxBase,A6 JSR -138(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; FUNCTION CxObjError(co : pCxObj) : LONGINT; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L co,A0 MOVEA.L CxBase,A6 JSR -066(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; FUNCTION CxObjType(co : pCxObj) : ULONG; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L co,A0 MOVEA.L CxBase,A6 JSR -060(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; PROCEDURE DeleteCxObj(co : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L co,A0 MOVEA.L CxBase,A6 JSR -048(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE DeleteCxObjAll(co : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L co,A0 MOVEA.L CxBase,A6 JSR -054(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE DisposeCxMsg(cxm : pCxMsg); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L cxm,A0 MOVEA.L CxBase,A6 JSR -168(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE DivertCxMsg(cxm : pCxMsg; headObj : pCxObj; returnObj : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L cxm,A0 MOVEA.L headObj,A1 MOVEA.L returnObj,A2 MOVEA.L CxBase,A6 JSR -156(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE EnqueueCxObj(headObj : pCxObj; co : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L headObj,A0 MOVEA.L co,A1 MOVEA.L CxBase,A6 JSR -090(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE InsertCxObj(headObj : pCxObj; co : pCxObj; pred : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L headObj,A0 MOVEA.L co,A1 MOVEA.L pred,A2 MOVEA.L CxBase,A6 JSR -096(A6) MOVEA.L (A7)+,A6 END; END; FUNCTION InvertKeyMap(ansiCode : ULONG; event : pInputEvent; km : pKeyMap) : BOOLEAN; BEGIN ASM MOVE.L A6,-(A7) MOVE.L ansiCode,D0 MOVEA.L event,A0 MOVEA.L km,A1 MOVEA.L CxBase,A6 JSR -174(A6) MOVEA.L (A7)+,A6 TST.W D0 BEQ.B @end MOVEQ #1,D0 @end: MOVE.B D0,@RESULT END; END; FUNCTION MatchIX(event : pInputEvent; ix : pInputXpression) : BOOLEAN; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L event,A0 MOVEA.L ix,A1 MOVEA.L CxBase,A6 JSR -204(A6) MOVEA.L (A7)+,A6 TST.W D0 BEQ.B @end MOVEQ #1,D0 @end: MOVE.B D0,@RESULT END; END; FUNCTION ParseIX(description : pCHAR; ix : pInputXpression) : LONGINT; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L description,A0 MOVEA.L ix,A1 MOVEA.L CxBase,A6 JSR -132(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; PROCEDURE RemoveCxObj(co : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L co,A0 MOVEA.L CxBase,A6 JSR -102(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE RouteCxMsg(cxm : pCxMsg; co : pCxObj); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L cxm,A0 MOVEA.L co,A1 MOVEA.L CxBase,A6 JSR -162(A6) MOVEA.L (A7)+,A6 END; END; FUNCTION SetCxObjPri(co : pCxObj; pri : LONGINT) : LONGINT; BEGIN ASM MOVE.L A6,-(A7) MOVEA.L co,A0 MOVE.L pri,D0 MOVEA.L CxBase,A6 JSR -078(A6) MOVEA.L (A7)+,A6 MOVE.L D0,@RESULT END; END; PROCEDURE SetFilter(filter : pCxObj; text : pCHAR); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L filter,A0 MOVEA.L text,A1 MOVEA.L CxBase,A6 JSR -120(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE SetFilterIX(filter : pCxObj; ix : pInputXpression); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L filter,A0 MOVEA.L ix,A1 MOVEA.L CxBase,A6 JSR -126(A6) MOVEA.L (A7)+,A6 END; END; PROCEDURE SetTranslate(translator : pCxObj; events : pInputEvent); BEGIN ASM MOVE.L A6,-(A7) MOVEA.L translator,A0 MOVEA.L events,A1 MOVEA.L CxBase,A6 JSR -114(A6) MOVEA.L (A7)+,A6 END; END; FUNCTION ParseIX(description : string; ix : pInputXpression) : LONGINT; begin ParseIX := ParseIX(pas2c(description),ix); end; PROCEDURE SetFilter(filter : pCxObj; text : string); begin SetFilter(filter,pas2c(text)); end; {$I useautoopenlib.inc} {$ifdef use_auto_openlib} {$Info Compiling autoopening of commodities.library} var commodities_exit : Pointer; procedure ClosecommoditiesLibrary; begin ExitProc := commodities_exit; if CxBase <> nil then begin CloseLibrary(CxBase); CxBase := nil; end; end; const { Change VERSION and LIBVERSION to proper values } VERSION : string[2] = '0'; LIBVERSION : longword = 0; begin CxBase := nil; CxBase := OpenLibrary(COMMODITIESNAME,LIBVERSION); if CxBase <> nil then begin commodities_exit := ExitProc; ExitProc := @ClosecommoditiesLibrary end else begin MessageBox('FPC Pascal Error', 'Can''t open commodities.library version ' + VERSION + #10 + 'Deallocating resources and closing down', 'Oops'); halt(20); end; {$else} {$Warning No autoopening of commodities.library compiled} {$Info Make sure you open commodities.library yourself} {$endif use_auto_openlib} END. (* UNIT COMMODITIES *)