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

