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. */
CcRqSETWINDOWSIZE :== 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
