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
|
implementation module osevent
import StdBool, StdList, StdMisc, StdTuple
import clCrossCall_12, ostime, ostoolbox, ostypes
from commondef import hdtl, fatalError
from StdMaybe import :: Maybe(..)
oseventFatalError :: String String -> .x
oseventFatalError function error
= fatalError function "osevent" error
/* The OSEvents environment keeps track of delayed events.
*/
:: *OSEvents
:== [OSEvent]
osAppendEvents :: !*[OSEvent] !OSEvents -> OSEvents
osAppendEvents newEvents osEvents
= osEvents ++ newEvents
osInsertEvents :: !*[OSEvent] !OSEvents -> OSEvents
osInsertEvents newEvents osEvents
= newEvents ++ osEvents
osIsEmptyEvents :: !OSEvents -> (!Bool,!OSEvents)
osIsEmptyEvents []
= (True, [])
osIsEmptyEvents osEvents
= (False, osEvents)
osRemoveEvent :: !OSEvents -> (!OSEvent,!OSEvents)
osRemoveEvent [osEvent:osEvents]
= (osEvent,osEvents)
osRemoveEvent []
= oseventFatalError "osRemoveEvent" "OSEvents argument is empty"
/* PA: does not seem to be used.
osCopyEvents :: !OSEvents -> (!OSEvents,!OSEvents)
osCopyEvents []
= ([],[])
osCopyEvents [e:es]
= ([e:es1],[e:es2])
where
(es1,es2) = osCopyEvents es
*/
osNewEvents :: OSEvents
osNewEvents = []
:: OSEvent
:== CrossCallInfo
:: OSSleepTime // The max time the process allows multi-tasking
:== Int
osNullEvent :: OSEvent
osNullEvent
= { ccMsg = CcWmIDLETIMER
, p1 = 0
, p2 = 0
, p3 = 0
, p4 = 0
, p5 = 0
, p6 = 0
}
// OSLongSleep :: OSSleepTime
OSLongSleep :== 2^15-1
// OSNoSleep :: OSSleepTime
OSNoSleep :== 0
osHandleEvents :: !(.s -> (Bool,.s)) !(.s -> (OSEvents,.s)) !((OSEvents,.s) -> .s) !(.s -> (Int,.s)) !(OSEvent -> .s -> ([Int],.s)) !(!.s,!*OSToolbox) -> (!.s,!*OSToolbox)
osHandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)
# (terminate,state) = isFinalState state
| terminate
= (state,tb)
# (osEvents,state) = getOSEvents state
# (noDelayEvents,osEvents) = osIsEmptyEvents osEvents
| noDelayEvents
# state = setOSEvents (osEvents,state)
# (sleep,state) = getSleepTime state
getEventCci = {ccMsg=CcRqDOMESSAGE,p1=toInt (sleep<>OSLongSleep),p2=sleep,p3=0,p4=0,p5=0,p6=0}
# (_,state,tb) = issueCleanRequest (rccitoevent handleOSEvent) getEventCci state tb
= osHandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)
with
rccitoevent :: !(OSEvent -> .s -> ([Int],.s)) !OSEvent !.s !*OSToolbox -> (!OSEvent,!.s,!*OSToolbox)
rccitoevent handleOSEvent osEvent=:{ccMsg} state tb
// # (reply,state) = handleOSEvent (trace_n ("CcRqDOMESSAGE-->"+++toCleanCrossCallInfoString osEvent) osEvent) state
# (reply,state) = handleOSEvent osEvent state
= (setReplyInOSEvent reply,state,tb)
| otherwise
# (osEvent,osEvents) = osRemoveEvent osEvents
# state = setOSEvents (osEvents,state)
// # (_,state) = handleOSEvent (trace_n ("DelayedEvent-->"+++toCleanCrossCallInfoString osEvent) osEvent) state
# (_,state) = handleOSEvent osEvent state
= osHandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)
setReplyInOSEvent :: ![Int] -> OSEvent
setReplyInOSEvent reply
| isEmpty reply = return0Cci
# (e1,reply) = hdtl reply
| isEmpty reply = return1Cci e1
# (e2,reply) = hdtl reply
| isEmpty reply = return2Cci e1 e2
# (e3,reply) = hdtl reply
| isEmpty reply = return3Cci e1 e2 e3
# (e4,reply) = hdtl reply
| isEmpty reply = return4Cci e1 e2 e3 e4
# (e5,reply) = hdtl reply
| isEmpty reply = return5Cci e1 e2 e3 e4 e5
# (e6,_) = hdtl reply
| isEmpty reply = return6Cci e1 e2 e3 e4 e5 e6
| otherwise = oseventFatalError "setReplyInOSEvent" "number of reply codes > 6"
osEventIsUrgent :: !OSEvent -> Bool
osEventIsUrgent {ccMsg}
= case ccMsg of
CcWmDRAWCLIPBOARD -> False // PA: in a future version, use this event to evaluate a clipboard callback function.
CcWmIDLETIMER -> False
CcWmTIMER -> False
CcWmZEROTIMER -> False
_ -> True
/* createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */
createOSActivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSActivateWindowEvent wPtr tb = (Rq1Cci CcWmACTIVATE wPtr,tb)
createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSDeactivateWindowEvent wPtr tb = (Rq1Cci CcWmDEACTIVATE wPtr,tb)
/* createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */
createOSActivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSActivateControlEvent wPtr cPtr tb = (Rq2Cci CcWmSETFOCUS wPtr cPtr,tb)
createOSDeactivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSDeactivateControlEvent wPtr cPtr tb = (Rq2Cci CcWmKILLFOCUS wPtr cPtr,tb)
/* createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */
createOSLooseMouseEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSLooseMouseEvent wPtr cPtr tb = (Rq2Cci CcWmLOSTMOUSE wPtr cPtr,tb)
createOSLooseKeyEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSLooseKeyEvent wPtr cPtr tb = (Rq2Cci CcWmLOSTKEY wPtr cPtr,tb)
/* createOSZeroTimerEvent creates the event for reporting continued zero timer (virtual event).
getOSZeroTimerStartTime returns the registered time in the virtual event. Zero if wrong argument.
*/
createOSZeroTimerEvent :: !OSTime -> OSEvent
createOSZeroTimerEvent zeroStart = Rq1Cci CcWmZEROTIMER (toInt zeroStart)
getOSZeroTimerStartTime :: !OSEvent -> Maybe OSTime
getOSZeroTimerStartTime {ccMsg,p1}
| ccMsg==CcWmZEROTIMER
= Just (fromInt p1)
| otherwise
= Nothing
|
