osevent.icl 4.96 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
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
implementation module osevent

//	Clean Object I/O library, version 1.2

import	StdBool, StdList, StdMisc, StdTuple
import	clCrossCall_12, ostoolbox, ostypes
from	commondef	import HdTl, FatalError
//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"

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-->"+++toString 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-->"+++toString osEvent) osEvent) state
		# (_,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
		_					-> 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)