1 {
2 This file is part of the Free Pascal run time library.
3
4 A file in Amiga system run time library.
5 Copyright (c) 1998-2002 by Nils Sjoholm
6 member of the Amiga RTL development team.
7
8 See the file COPYING.FPC, included in this distribution,
9 for details about the copyright.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
14
15 **********************************************************************}
16 {
17 History:
18 Added overlay functions for Pchar->Strings, functions
19 and procedures.
20 14 Jul 2000.
21
22 Added the defines use_amiga_smartlink and
23 use_auto_openlib. Implemented autoopening
24 of the library.
25 13 Jan 2003.
26
27 changed integer > smallint,
28 cardinal > longword.
29 09 Feb 2003.
30
31 nils.sjoholm@mailbox.swipnet.se
32 }
33 {$PACKRECORDS 2}
34 unit commodities;
35
36 INTERFACE
37
38
39 uses exec, inputevent, keymap;
40
41
42
43 { **************
44 * Broker stuff
45 **************}
46
47 CONST
48 { buffer sizes }
49 CBD_NAMELEN = 24;
50 CBD_TITLELEN = 40;
51 CBD_DESCRLEN = 40;
52
53 { CxBroker errors }
54 CBERR_OK = 0; { No error }
55 CBERR_SYSERR = 1; { System error , no memory, etc }
56 CBERR_DUP = 2; { uniqueness violation }
57 CBERR_VERSION = 3; { didn't understand nb_VERSION }
58
59 NB_VERSION = 5; { Version of NewBroker structure }
60
61 Type
62 pNewBroker = ^tNewBroker;
63 tNewBroker = record
64 nb_Version : Shortint; { set to NB_VERSION }
65 nb_Name,
66 nb_Title,
67 nb_Descr : STRPTR;
68 nb_Unique,
69 nb_Flags : smallint;
70 nb_Pri : Shortint;
71 { new in V5 }
72 nb_Port : pMsgPort;
73 nb_ReservedChannel : smallint; { plans for later port sharing }
74 END;
75
76 CONST
77 { Flags for nb_Unique }
78 NBU_DUPLICATE = 0;
79 NBU_UNIQUE = 1; { will not allow duplicates }
80 NBU_NOTIFY = 2; { sends CXM_UNIQUE to existing broker }
81
82 { Flags for nb_Flags }
83 COF_SHOW_HIDE = 4;
84
85 { *******
86 * cxusr
87 *******}
88
89 { * Fake data types for system private objects }
90 Type
91 CxObj = Longint;
92 pCxObj = ^CxObj;
93 CxMsg = Longint;
94 pCXMsg = ^CxMsg;
95
96
97 CONST
98 { ******************************}
99 { * Commodities Object Types *}
100 { ******************************}
101 CX_INVALID = 0; { not a valid object (probably null) }
102 CX_FILTER = 1; { input event messages only }
103 CX_TYPEFILTER = 2; { filter on message type }
104 CX_SEND = 3; { sends a message }
105 CX_SIGNAL = 4; { sends a signal }
106 CX_TRANSLATE = 5; { translates IE into chain }
107 CX_BROKER = 6; { application representative }
108 CX_DEBUG = 7; { dumps kprintf to serial port }
109 CX_CUSTOM = 8; { application provids function }
110 CX_ZERO = 9; { system terminator node }
111
112 { ***************}
113 { * CxMsg types *}
114 { ***************}
115 CXM_UNIQUE = 16; { sent down broker by CxBroker() }
116 { Obsolete: subsumed by CXM_COMMAND (below) }
117
118 { Messages of this type rattle around the Commodities input network.
119 * They will be sent to you by a Sender object, and passed to you
120 * as a synchronous function call by a Custom object.
121 *
122 * The message port or function entry point is stored in the object,
123 * and the ID field of the message will be set to what you arrange
124 * issuing object.
125 *
126 * The Data field will point to the input event triggering the
127 * message.
128 }
129 CXM_IEVENT = 32;
130
131 { These messages are sent to a port attached to your Broker.
132 * They are sent to you when the controller program wants your
133 * program to do something. The ID field identifies the command.
134 *
135 * The Data field will be used later.
136 }
137 CXM_COMMAND = 64;
138
139 { ID values }
140 CXCMD_DISABLE = (15); { please disable yourself }
141 CXCMD_ENABLE = (17); { please enable yourself }
142 CXCMD_APPEAR = (19); { open your window, if you can }
143 CXCMD_DISAPPEAR = (21); { go dormant }
144 CXCMD_KILL = (23); { go away for good }
145 CXCMD_UNIQUE = (25); { someone tried to create a broker
146 * with your name. Suggest you Appear.
147 }
148 CXCMD_LIST_CHG = (27); { Used by Exchange program. Someone }
149 { has changed the broker list }
150
151 { return values for BrokerCommand(): }
152 CMDE_OK = (0);
153 CMDE_NOBROKER = (-1);
154 CMDE_NOPORT = (-2);
155 CMDE_NOMEM = (-3);
156
157 { IMPORTANT NOTE: for V5:
158 * Only CXM_IEVENT messages are passed through the input network.
159 *
160 * Other types of messages are sent to an optional port in your broker.
161 *
162 * This means that you must test the message type in your message handling,
163 * if input messages and command messages come to the same port.
164 *
165 * Older programs have no broker port, so processing loops which
166 * make assumptions about type won't encounter the new message types.
167 *
168 * The TypeFilter CxObject is hereby obsolete.
169 *
170 * It is less convenient for the application, but eliminates testing
171 * for type of input messages.
172 }
173
174 { ********************************************************}
175 { * CxObj Error Flags (return values from CxObjError()) *}
176 { ********************************************************}
177 COERR_ISNULL = 1; { you called CxError(NULL) }
178 COERR_NULLATTACH = 2; { someone attached NULL to my list }
179 COERR_BADFILTER = 4; { a bad filter description was given }
180 COERR_BADTYPE = 8; { unmatched type-specific operation }
181
182
183 { ****************************}
184 { Input Expression structure }
185 { ****************************}
186
187 IX_VERSION = 2;
188
189 Type
190 pInputXpression = ^tInputXpression;
191 tInputXpression = record
192 ix_Version, { must be set to IX_VERSION }
193 ix_Class : Byte; { class must match exactly }
194
195 ix_Code : Word; { Bits that we want }
196
197 ix_CodeMask : Word; { Set bits here to indicate }
198 { which bits in ix_Code are }
199 { don't care bits. }
200
201 ix_Qualifier: Word; { Bits that we want }
202
203 ix_QualMask : Word; { Set bits here to indicate }
204 { which bits in ix_Qualifier }
205 { are don't care bits }
206
207 ix_QualSame : Word; { synonyms in qualifier }
208 END;
209
210 IX = tInputXpression;
211 pIX = ^IX;
212
213 CONST
214 { QualSame identifiers }
215 IXSYM_SHIFT = 1; { left- and right- shift are equivalent }
216 IXSYM_CAPS = 2; { either shift or caps lock are equivalent }
217 IXSYM_ALT = 4; { left- and right- alt are equivalent }
218
219 { corresponding QualSame masks }
220 IXSYM_SHIFTMASK = (IEQUALIFIER_LSHIFT + IEQUALIFIER_RSHIFT);
221 IXSYM_CAPSMASK = (IXSYM_SHIFTMASK + IEQUALIFIER_CAPSLOCK);
222 IXSYM_ALTMASK = (IEQUALIFIER_LALT + IEQUALIFIER_RALT);
223
224 IX_NORMALQUALS = $7FFF; { for QualMask field: avoid RELATIVEMOUSE }
225
226
227 VAR CxBase : pLibrary = nil;
228
229 const
230 COMMODITIESNAME : PChar = 'commodities.library';
231
232
ActivateCxObjnull233 FUNCTION ActivateCxObj(co : pCxObj location 'a0'; tru : LONGINT location 'd0') : LONGINT; syscall CxBase 042;
234 PROCEDURE AddIEvents(events : pInputEvent location 'a0'); syscall CxBase 180;
235 PROCEDURE AttachCxObj(headObj : pCxObj location 'a0'; co : pCxObj location 'a1'); syscall CxBase 084;
236 PROCEDURE ClearCxObjError(co : pCxObj location 'a0'); syscall CxBase 072;
CreateCxObjnull237 FUNCTION CreateCxObj(typ : ULONG location 'd0'; arg1 : LONGINT location 'a0'; arg2 : LONGINT location 'a1') : pCxObj; syscall CxBase 030;
CxBrokernull238 FUNCTION CxBroker(nb : pNewBroker location 'a0'; error : PLongInt location 'd0') : pCxObj; syscall CxBase 036;
CxMsgDatanull239 FUNCTION CxMsgData(cxm : pCxMsg location 'a0') : POINTER; syscall CxBase 144;
CxMsgIDnull240 FUNCTION CxMsgID(cxm : pCxMsg location 'a0') : LONGINT; syscall CxBase 150;
CxMsgTypenull241 FUNCTION CxMsgType(cxm : pCxMsg location 'a0') : ULONG; syscall CxBase 138;
CxObjErrornull242 FUNCTION CxObjError(co : pCxObj location 'a0') : LONGINT; syscall CxBase 066;
CxObjTypenull243 FUNCTION CxObjType(co : pCxObj location 'a0') : ULONG; syscall CxBase 060;
244 PROCEDURE DeleteCxObj(co : pCxObj location 'a0'); syscall CxBase 048;
245 PROCEDURE DeleteCxObjAll(co : pCxObj location 'a0'); syscall CxBase 054;
246 PROCEDURE DisposeCxMsg(cxm : pCxMsg location 'a0'); syscall CxBase 168;
247 PROCEDURE DivertCxMsg(cxm : pCxMsg location 'a0'; headObj : pCxObj location 'a1'; returnObj : pCxObj location 'a2'); syscall CxBase 156;
248 PROCEDURE EnqueueCxObj(headObj : pCxObj location 'a0'; co : pCxObj location 'a1'); syscall CxBase 090;
249 PROCEDURE InsertCxObj(headObj : pCxObj location 'a0'; co : pCxObj location 'a1'; pred : pCxObj location 'a2'); syscall CxBase 096;
InvertKeyMapnull250 FUNCTION InvertKeyMap(ansiCode : ULONG location 'd0'; event : pInputEvent location 'a0'; km : pKeyMap location 'a1') : LongBool; syscall CxBase 174;
MatchIXnull251 FUNCTION MatchIX(event : pInputEvent location 'a0'; ix : pInputXpression location 'a1') : LongBool; syscall CxBase 204;
ParseIXnull252 FUNCTION ParseIX(description : pCHAR location 'a0'; ix : pInputXpression location 'a1') : LONGINT; syscall CxBase 132;
253 PROCEDURE RemoveCxObj(co : pCxObj location 'a0'); syscall CxBase 102;
254 PROCEDURE RouteCxMsg(cxm : pCxMsg location 'a0'; co : pCxObj location 'a1'); syscall CxBase 162;
SetCxObjPrinull255 FUNCTION SetCxObjPri(co : pCxObj location 'a0'; pri : LONGINT location 'd0') : LONGINT; syscall CxBase 078;
256 PROCEDURE SetFilter(filter : pCxObj location 'a0'; text : pCHAR location 'a1'); syscall CxBase 120;
257 PROCEDURE SetFilterIX(filter : pCxObj location 'a0'; ix : pInputXpression location 'a1'); syscall CxBase 126;
258 PROCEDURE SetTranslate(translator : pCxObj location 'a0'; events : pInputEvent location 'a1'); syscall CxBase 114;
259
260 { overlay functions}
261
ParseIXnull262 FUNCTION ParseIX(description : rawbytestring; ix : pInputXpression) : LONGINT;
263 PROCEDURE SetFilter(filter : pCxObj; text : rawbytestring);
264
265 procedure FreeIEvents(Events: PInputEvent);
CxCustomnull266 function CxCustom(Action: Pointer; Id: LongInt): PCxObj;
CxDebugnull267 function CxDebug(Id: LongInt): PCxObj;
CxFilternull268 function CxFilter(d: STRPTR): PCxObj;
CxSendernull269 function CxSender(Port: PMsgPort; Id: LongInt): PCxObj;
CxSignalnull270 function CxSignal(Task: PTask; Sig: Byte): PCxObj;
CxTranslatenull271 function CxTranslate(Ie: PInputEvent): PCxObj;
272
273 IMPLEMENTATION
274
275
ParseIXnull276 FUNCTION ParseIX(description : rawbytestring; ix : pInputXpression) : LONGINT;
277 begin
278 ParseIX := ParseIX(pchar(description),ix);
279 end;
280
281 PROCEDURE SetFilter(filter : pCxObj; text : rawbytestring);
282 begin
283 SetFilter(filter,pchar(text));
284 end;
285
286 procedure FreeIEvents(Events: PInputEvent);
287 begin
288 while Events <> nil do
289 begin
290 FreeMem(Events, SizeOf(TInputEvent));
291 Events := Events^.ie_NextEvent;
292 end
293 end;
294
CxCustomnull295 function CxCustom(Action: Pointer; Id: LongInt): PCxObj;
296 begin
297 CxCustom := CreateCxObj(CX_CUSTOM, LongInt(Action), Id);
298 end;
299
CxDebugnull300 function CxDebug(Id: LongInt): PCxObj;
301 begin
302 CxDebug := CreateCxObj(CX_DEBUG, Id, 0);
303 end;
304
CxFilternull305 function CxFilter(d: STRPTR): PCxObj;
306 begin
307 CxFilter := CreateCxObj(CX_FILTER, LongInt(d), 0);
308 end;
309
CxSendernull310 function CxSender(Port: PMsgPort; Id: LongInt): PCxObj;
311 begin
312 CxSender := CreateCxObj(CX_SEND, LongInt(Port), Id);
313 end;
314
CxSignalnull315 function CxSignal(Task: PTask; Sig: Byte): PCxObj;
316 begin
317 CxSignal:= CreateCxObj(CX_SIGNAL, LongInt(Task), Sig);
318 end;
319
CxTranslatenull320 function CxTranslate(Ie: PInputEvent): PCxObj;
321 begin
322 CxTranslate := CreateCxObj(CX_TRANSLATE, LongInt(Ie), 0);
323 end;
324
325 const
326 { Change VERSION and LIBVERSION to proper values }
327 VERSION : string[2] = '0';
328 LIBVERSION : longword = 0;
329
330 initialization
331 CxBase := OpenLibrary(COMMODITIESNAME,LIBVERSION);
332 finalization
333 if Assigned(CxBase) then
334 CloseLibrary(CxBase);
335 END. (* UNIT COMMODITIES *)
336
337
338
339