1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
|
implementation module clCrossCall_12
import StdBool, StdClass, StdInt, StdMisc, StdString, StdTuple
import ostoolbox
import code from //"cAcceleratorTable_121.o",
"cCCallWindows_121.o",
"cCCallSystem_121.o",
"cCrossCall_121.o",
//"cCrossCallCursor_121.o",
"cCrossCallProcedureTable_121.o",
"cCrossCallWindows_121.o"
/*
import code from library "advapi32_library",
library "comctl32_library",
library "kernel32_library",
library "ole32_library",
library "shell32_library",
library "winmm_library",
library "winspool_library",
// library "wsock_library", // PA: should not be necessary
library "kernelExt_library",
library "gdiExt_library",
library "userExt_library"
*/
//import StdDebug, tracetypes
//----------------------------------------------//
// Crosscall infrastructure //
//----------------------------------------------//
// CrossCallInfo is the basic record that is passed between the Clean thread and the OS thread:
:: CrossCallInfo
= { ccMsg :: !Int // The message nr: Clean->OS use CcRq...; OS->Clean use CcWm...
, p1 :: !Int
, p2 :: !Int
, p3 :: !Int
, p4 :: !Int
, p5 :: !Int
, p6 :: !Int
}
// PA: restructured issueCleanRequest for readability.
// 2 versions: first without Iprint statements, second with Iprint statements.
// In both cases the Bool result has also been eliminated as it is never used.
issueCleanRequest :: !(CrossCallInfo -> .(.s -> .(*OSToolbox -> *(.CrossCallInfo,.s,*OSToolbox))))
!.CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
issueCleanRequest callback cci s tb
// # tb = trace_n ("issueCleanRequest :"+++toOSCrossCallInfoString cci) tb
# (reply,tb) = winKickOsThread cci tb
= handleCallBacks callback reply s tb
where
handleCallBacks :: !(CrossCallInfo -> .(.s -> .(*OSToolbox -> *(.CrossCallInfo,.s,*OSToolbox))))
!CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo,!.s,!*OSToolbox)
handleCallBacks callback cci=:{ccMsg} s tb
| ccMsg>2000
= abort ("handleCallBacks "+++toString ccMsg)
// # tb = trace_n ("issueCleanRequest <-- "+++toCleanCrossCallInfoString cci) tb
| isReturnOrQuitCci ccMsg
// # tb = trace_n "issueCleanRequest." tb
= (cci,s,tb)
| otherwise
# (returnCci,s,tb) = callback cci s tb
// # tb = trace_n ("issueCleanRequest --> "+++toOSCrossCallInfoString returnCci) tb
# (replyCci,tb) = winKickOsThread returnCci tb
= handleCallBacks callback replyCci s tb
/* PA: version of issueCleanRequest that has no state parameter.
*/
issueCleanRequest2 :: !(CrossCallInfo -> .(*OSToolbox -> *(.CrossCallInfo,*OSToolbox))) !.CrossCallInfo !*OSToolbox
-> (!CrossCallInfo,!*OSToolbox)
issueCleanRequest2 callback cci tb
// # tb = trace_n ("issueCleanRequest2 :"+++toOSCrossCallInfoString cci) tb
# (reply,tb) = winKickOsThread cci tb
= handleCallBacks callback reply tb
where
handleCallBacks :: !(CrossCallInfo -> .(*OSToolbox -> *(.CrossCallInfo,*OSToolbox))) !CrossCallInfo !*OSToolbox
-> (!CrossCallInfo,!*OSToolbox)
handleCallBacks callback cci=:{ccMsg} tb
| ccMsg>2000
= abort ("HandleCallBacks "+++toString ccMsg)
// # tb = trace_n ("issueCleanRequest2 <-- "+++toCleanCrossCallInfoString cci) tb
| isReturnOrQuitCci ccMsg
// # tb = trace_n "issueCleanRequest2." tb
= (cci,tb)
| otherwise
# (returnCci,tb) = callback cci tb
// # tb = trace_n ("issueCleanRequest2 --> "+++toOSCrossCallInfoString returnCci) tb
# (replyCci, tb) = winKickOsThread returnCci tb
= handleCallBacks callback replyCci tb
// PA: macros for returning proper number of arguments within a CrossCallInfo.
Rq0Cci msg :== {ccMsg=msg,p1=0, p2=0, p3=0, p4=0, p5=0, p6=0 }
Rq1Cci msg v1 :== {ccMsg=msg,p1=v1,p2=0, p3=0, p4=0, p5=0, p6=0 }
Rq2Cci msg v1 v2 :== {ccMsg=msg,p1=v1,p2=v2,p3=0, p4=0, p5=0, p6=0 }
Rq3Cci msg v1 v2 v3 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=0, p5=0, p6=0 }
Rq4Cci msg v1 v2 v3 v4 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=0, p6=0 }
Rq5Cci msg v1 v2 v3 v4 v5 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=v5,p6=0 }
Rq6Cci msg v1 v2 v3 v4 v5 v6 :== {ccMsg=msg,p1=v1,p2=v2,p3=v3,p4=v4,p5=v5,p6=v6}
return0Cci :: CrossCallInfo
return0Cci = Rq0Cci CcRETURN0
return1Cci :: !Int -> CrossCallInfo
return1Cci v = Rq1Cci CcRETURN1 v
return2Cci :: !Int !Int -> CrossCallInfo
return2Cci v1 v2 = Rq2Cci CcRETURN2 v1 v2
return3Cci :: !Int !Int !Int -> CrossCallInfo
return3Cci v1 v2 v3 = Rq3Cci CcRETURN3 v1 v2 v3
return4Cci :: !Int !Int !Int !Int -> CrossCallInfo
return4Cci v1 v2 v3 v4 = Rq4Cci CcRETURN4 v1 v2 v3 v4
return5Cci :: !Int !Int !Int !Int !Int -> CrossCallInfo
return5Cci v1 v2 v3 v4 v5 = Rq5Cci CcRETURN5 v1 v2 v3 v4 v5
return6Cci :: !Int !Int !Int !Int !Int !Int -> CrossCallInfo
return6Cci v1 v2 v3 v4 v5 v6 = Rq6Cci CcRETURN6 v1 v2 v3 v4 v5 v6
isReturnOrQuitCci :: !Int -> Bool
isReturnOrQuitCci mess
= mess==CcWASQUIT || (mess<=CcRETURNmax && mess>=CcRETURNmin)
instance toInt Bool where
toInt :: !Bool -> Int
toInt True = -1
toInt _ = 0
errorCallback :: !String !CrossCallInfo !.s !*OSToolbox -> (!CrossCallInfo, !.s, !*OSToolbox)
errorCallback source cci s tb
= (return0Cci, s, iprint msgtext tb)
where
msgtext = " *** [" +++ source +++ "] did not expect a callback: " +++ toString cci.ccMsg
// PA: version of errorCallback without state parameter (use with IssueCleanRequest2).
errorCallback2 :: !String !CrossCallInfo !*OSToolbox -> (!CrossCallInfo,!*OSToolbox)
errorCallback2 source cci tb
= (return0Cci,iprint msgtext tb)
where
msgtext = " *** [" +++ source +++ "] did not expect a callback: " +++ toString cci.ccMsg
iprint :: !String !.a -> .a
iprint s a
| not (printresult == 0) = a
= abort ("Print failed: " +++ s)
where
printresult = consolePrint ("## " +++ s +++ "\n") 999
iprint` :: !String !.a -> .a
iprint` s a
| not (printresult == 0) = a
= abort ("Print failed: " +++ s)
where
printresult = consolePrint s 999
consolePrint :: !{#Char} !*OSToolbox -> *OSToolbox
consolePrint _ _
= code
{
.inline ConsolePrint
ccall ConsolePrint "SI-I"
.end
}
//---------------------------------------------------------------------//
// Synchronisation operations between the Clean thread and OS thread //
//---------------------------------------------------------------------//
winKickOsThread :: !CrossCallInfo !*OSToolbox -> ( !CrossCallInfo, !*OSToolbox)
winKickOsThread _ _
= code
{
.inline WinKickOsThread
ccall WinKickOsThread "pppppppp-pppppppp"
.end
}
winKillOsThread :: !*OSToolbox -> *OSToolbox
winKillOsThread _
= code
{
.inline WinKillOsThread
ccall WinKillOsThread "I-I"
.end
}
winStartOsThread :: !*OSToolbox -> *OSToolbox
winStartOsThread _
= code
{
.inline WinStartOsThread
ccall WinStartOsThread "I-I"
.end
}
winCloseOs :: !*OSToolbox -> Bool
winCloseOs _
= code
{
.inline WinCloseOs
ccall WinCloseOs "I-I"
.end
}
winInitOs :: ( !Bool, !*OSToolbox)
winInitOs
= code
{
.inline WinInitOs
ccall WinInitOs "-II"
.end
}
//------------------------------------------------------------------------//
// The message numbers for communication from Clean to OS (ccMsg field) //
//------------------------------------------------------------------------//
// Mike //
CcRqUSERGAMEEVENT :== 1905
CcRqCREATEGAMEOBJECT :== 1904
CcRqPLAYSOUNDSAMPLE :== 1903
CcRqRUNGAME :== 1901
CcRqCREATEGAMEWINDOW :== 1900
///
// MW...
CcRqDO_PRINT_SETUP :== 1828 // MW11++
CcRqDO_HTML_HELP :== 1827
CcRqGET_PRINTER_DC :== 1824
CcRqDISPATCH_MESSAGES_WHILE_PRINTING
:== 1823
CcRqENDDOC :== 1822
CcRqSTARTDOC :== 1821
// ... MW
CcRqCREATETCPWINDOW :== 1820 /* create TCP window */
CcRqDESTROYMDIDOCWINDOW :== 1817 // PA: added to destroy MDI document window
CcRqCREATESDIDOCWINDOW :== 1816 // PA: added to create SDI document window
CcRqCREATEMDIDOCWINDOW :== 1815 // PA: added to create MDI document window
CcRqCREATEMDIFRAMEWINDOW :== 1814 // PA: added to create MDI frame window
CcRqCREATESDIFRAMEWINDOW :== 1813 // PA: added to create SDI frame window
CcRqCLIPBOARDHASTEXT :== 1812
CcRqGETCLIPBOARDTEXT :== 1811
CcRqSETCLIPBOARDTEXT :== 1810
CcRqGETCLIPBOARDCOUNT :== 1809 /* PA: added to retrieve clipboard count. */
CcRqDIRECTORYDIALOG :== 1802 /* PA: added to create directory selector dialog. */
CcRqFILESAVEDIALOG :== 1801
CcRqFILEOPENDIALOG :== 1800
CcRqSHOWCONTROL :== 1755 /* PA: added */
CcRqSELECTPOPUPITEM :== 1754
CcRqENABLEPOPUPITEM :== 1753
CcRqADDTOPOPUP :== 1752
CcRqSETITEMCHECK :== 1751
CcRqENABLECONTROL :== 1750
CcRqCREATECOMPOUND :== 1729 /* PA: added */
CcRqCREATESCROLLBAR :== 1728 /* PA: added */
CcRqCREATECUSTOM :== 1727
CcRqCREATEICONBUT :== 1726
CcRqCREATEPOPUP :== 1725
CcRqCREATECHECKBOX :== 1724
CcRqCREATERADIOBUT :== 1723
CcRqCREATEEDITTXT :== 1722
CcRqCREATESTATICTXT :== 1721
CcRqCREATEBUTTON :== 1720
CcRqCREATEMODALDIALOG :== 1701 /* PA: added to create modal dialog. */
CcRqCREATEDIALOG :== 1700
CcRqCREATETOOLBARSEPARATOR :== 1603 /* PA: added to create a toolbar separator item. */
CcRqCREATETOOLBARITEM :== 1602 /* PA: added to create a toolbar bitmap item. */
CcRqCREATEMDITOOLBAR :== 1601 /* PA: added to create a toolbar for a MDI process. */
CcRqCREATESDITOOLBAR :== 1600 /* PA: added to create a toolbar. */
CcCbFONTSIZE :== 1530
CcCbFONTNAME :== 1520
CcRqGETFONTSIZES :== 1510
CcRqGETFONTNAMES :== 1500
CcRqSETCLIENTSIZE :== 1438 /* PA: added to set client size. */
CcRqDELCONTROLTIP :== 1437 /* PA: added to remove controls from tooltip areas. */
CcRqADDCONTROLTIP :== 1436 /* PA: added to add controls to tooltip areas. */
CcRqGETWINDOWSIZE :== 1435 /* PA: added to retrieve bounding size of windows. */
CcRqRESTACKWINDOW :== 1434 /* PA: added to restack windows. */
CcRqSHOWWINDOW :== 1433 /* PA: added to (hide/show) windows. */
CcRqSETWIDGETSIZE :== 1432 /* PA: added to resize windows/controls. */
CcRqSETSELECTWINDOW :== 1431 /* PA: added to (en/dis)able windows. */
CcRqSETWINDOWPOS :== 1430 /* PA: added to move windows/controls. */
CcRqSETEDITSELECTION :== 1428 /* PA: added for handling edit control selections. */
CcRqSETSCROLLSIZE :== 1427 /* PA: added for setting thumb size of scrollbar. */
CcRqSETSCROLLPOS :== 1426 /* PA: added for setting thumb of scrollbar. */
CcRqSETSCROLLRANGE :== 1425 /* PA: added for setting range of scrollbar. */
CcRqRESETCURSOR :== 1424
CcRqSETGLOBALCURSOR :== 1423
CcRqOBSCURECURSOR :== 1422
CcRqCHANGEWINDOWCURSOR :== 1421
CcRqACTIVATEWINDOW :== 1420 /* PA: added for activating window. */
CcRqACTIVATECONTROL :== 1419 /* PA: added for activating controls. */
CcRqGETWINDOWPOS :== 1416
CcRqGETCLIENTSIZE :== 1415
CcRqUPDATEWINDOWRECT :== 1412 /* PA: added for updating rect part of a window/control. */
CcRqGETWINDOWTEXT :== 1411
CcRqSETWINDOWTITLE :== 1410
CcRqFAKEPAINT :== 1405 /* PA: added combination of BeginPaint; EndPaint; InvalidateRect; */
CcRqENDPAINT :== 1404
CcRqBEGINPAINT :== 1403
CcRqDESTROYWINDOW :== 1402
CcRqDESTROYMODALDIALOG :== 1401 /* PA: added to destroy modal dialog. */
CcRqDRAWMBAR :== 1265
CcRqTRACKPOPMENU :== 1256 /* PA: added for handling pop up menu. */
CcRqCREATEPOPMENU :== 1255
CcRqINSERTSEPARATOR :== 1245
CcRqMENUENABLE :== 1235
CcRqMODIFYMENU :== 1230
CcRqINSERTMENU :== 1226 // PA: new constant for inserting a new menu into the menu bar
CcRqITEMENABLE :== 1220
CcRqREMOVEMENUSHORTKEY :== 1217 // PA: new constant for removing a shortkey of a menu item
CcRqADDMENUSHORTKEY :== 1216 // PA: new constant for adding a shortkey of a menu item
CcRqMODIFYMENUITEM :== 1215
CcRqDESTROYMENU :== 1214 // PA: new constant for destroying a menu 'physically'
CcRqDELETEMENU :== 1213 // PA: new constant for deleting a menu logically
CcRqREMOVEMENUITEM :== 1212
CcRqCHECKMENUITEM :== 1210
CcRqINSERTMENUITEM :== 1205
CcRqDOMESSAGE :== 1100
//------------------------------------------------------------------------//
// The message numbers for communication from OS to Clean (CcMsg field) //
//------------------------------------------------------------------------//
CcWINMESSmax :== 999
// Mike: Convention for OS to Clean requests: 500-599 //
CcWmCHECKQUIT :== 513 /* Mike: check user's quit function */
CcWmUSEREVENT :== 512 /* Mike: user defined event */
CcWmSTATISTICS :== 511 /* Mike: request for statistics */
CcWmOBJECTKEYUP :== 510 /* Mike: key released */
CcWmOBJECTKEYDOWN :== 509 /* Mike: key pressed for object */
CcWmOBJECTTIMER :== 508 /* Mike: framecounter reached 0 */
CcWmANIMATION :== 507 /* Mike: animation sequence ended */
CcWmCOLLISION :== 506 /* Mike: collision of two objects */
CcWmTOUCHBOUND :== 505 /* Mike: object touches bound or code */
CcWmOBJECTDONE :== 504 /* Mike: object is destroyed */
CcWmMOVEOBJECT :== 503 /* Mike: move object */
CcWmINITOBJECT :== 502 /* Mike: initialize new object */
CcWmSCROLL :== 501 /* Mike: calculate layer position */
CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
///
CcWmINETEVENT :== 140 /* MW11 */
CcWmZEROTIMER :== 136 /* PA: new constant for sequence of zero timer events (generated only by Clean). */
CcWmLOSTKEY :== 135 /* PA: new constant for loosing keyboard input (generated only by Clean). */
CcWmLOSTMOUSE :== 134 /* PA: new constant for loosing mouse input (generated only by Clean). */
CcWmSPECIALBUTTON :== 133 /* PA: new constant for info about OK/CANCEL button selected. */
CcWmPROCESSDROPFILES :== 132 /* PA: new constant for requesting opening of files. */
CcWmGETTOOLBARTIPTEXT :== 131 /* PA: new constant for getting tooltip text. */
CcWmSETFOCUS :== 130 /* PA: new constant for notifying obtaining keyboard input focus. */
CcWmKILLFOCUS :== 129 /* PA: new constant for notifying loss of keyboard input focus. */
CcWmPROCESSCLOSE :== 127 /* PA: new constant for requesting closing of process. */
CcWmDRAWCLIPBOARD :== 126 /* PA: new constant for clipboard handling. Copied from Ronny. */
CcWmGETSCROLLBARINFO :== 125 /* PA: new constant for info about scrollbars. */
CcWmSCROLLBARACTION :== 124 /* PA: new constant for scrollbar handling. */
CcWmDDEEXECUTE :== 123
CcWmIDLEDIALOG :== 121 /* PA: old constant reused for initialising modal dialogues. */
CcWmDRAWCONTROL :== 120
CcWmCOMBOSELECT :== 119
CcWmBUTTONCLICKED :== 118
CcWmINITDIALOG :== 117
CcWmIDLETIMER :== 116
CcWmTIMER :== 115
CcWmNEWVTHUMB :== 114
CcWmNEWHTHUMB :== 113
CcWmGETVSCROLLVAL :== 112
CcWmGETHSCROLLVAL :== 111
CcWmSIZE :== 110 /* PA: old constant reused for passing resize information. */
CcWmMOUSE :== 109
CcWmKEYBOARD :== 108
CcWmDEACTIVATE :== 107
CcWmACTIVATE :== 106
CcWmCLOSE :== 105
CcWmCOMMAND :== 103
CcWmCHAR :== 102
CcWmCREATE :== 101
CcWmPAINT :== 100
CcWINMESSmin :== 100
CcWmNOTIFY :== 78
CcRETURNmax :== 19
CcRETURN6 :== 16
CcRETURN5 :== 15
CcRETURN4 :== 14
CcRETURN3 :== 13
CcRETURN2 :== 12
CcRETURN1 :== 11
CcRETURN0 :== 10
CcRETURNmin :== 10
CcWASQUIT :== 1
|
