osevent.icl 5.69 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
implementation module osevent

//	Clean Object I/O library, version 1.2

import	StdBool, StdList, StdMisc, StdTuple
6
import	clCrossCall_12, ostime, ostoolbox, ostypes
Peter Achten's avatar
Peter Achten committed
7
from	commondef	import HdTl, FatalError
8
from	StdMaybe	import Maybe, Just, Nothing
Peter Achten's avatar
Peter Achten committed
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
//import	StdDebug, tracetypes


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"

43
44
45
46
47
48
49
50
OScopyEvents :: !OSEvents -> (!OSEvents,!OSEvents)
OScopyEvents []
	= ([],[])
OScopyEvents [e:es]
	= ([e:es1],[e:es2])
where
	(es1,es2)	= OScopyEvents es

Peter Achten's avatar
Peter Achten committed
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
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
93
			//	# (reply,state)	= handleOSEvent (trace_n ("CcRqDOMESSAGE-->"+++toCleanCrossCallInfoString osEvent) osEvent) state
Peter Achten's avatar
Peter Achten committed
94
95
96
97
98
				# (reply,state)	= handleOSEvent osEvent state
				= (setReplyInOSEvent reply,state,tb)
	| otherwise
		# (osEvent,osEvents)	= OSremoveEvent osEvents
		# state					= setOSEvents (osEvents,state)
99
	//	# (_,state)				= handleOSEvent (trace_n ("DelayedEvent-->"+++toCleanCrossCallInfoString osEvent) osEvent) state
Peter Achten's avatar
Peter Achten committed
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
		# (_,state)				= handleOSEvent osEvent state
		= OShandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)

setReplyInOSEvent :: ![Int] -> CrossCallInfo
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
126
		CcWmZEROTIMER		-> False
Peter Achten's avatar
Peter Achten committed
127
128
129
		_					-> True


130
/*	createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */
Peter Achten's avatar
Peter Achten committed
131
132
133
134
135
136
createOSActivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSActivateWindowEvent wPtr tb = (Rq1Cci CcWmACTIVATE wPtr,tb)

createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSDeactivateWindowEvent wPtr tb = (Rq1Cci CcWmDEACTIVATE wPtr,tb)

137
/*	createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */
Peter Achten's avatar
Peter Achten committed
138
139
140
141
142
143
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)

144
/*	createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */
Peter Achten's avatar
Peter Achten committed
145
146
147
148
149
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)
150
151
152
153
154
155
156
157
158
159
160
161
162

/*	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