diff options
Diffstat (limited to 'osevent.icl')
| -rw-r--r-- | osevent.icl | 161 |
1 files changed, 161 insertions, 0 deletions
diff --git a/osevent.icl b/osevent.icl new file mode 100644 index 0000000..85eb066 --- /dev/null +++ b/osevent.icl @@ -0,0 +1,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
|