Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-libraries
Commits
05711b8d
Commit
05711b8d
authored
Mar 21, 2000
by
Peter Achten
Browse files
(PA) Improved performance of zero timers.
parent
87693c9d
Changes
15
Hide whitespace changes
Inline
Side-by-side
libraries/ObjectIO/ObjectIO/OS Windows/Clean System Files/cCrossCall_12.obj
View file @
05711b8d
No preview for this file type
libraries/ObjectIO/ObjectIO/OS Windows/clCrossCall_12.dcl
View file @
05711b8d
...
...
@@ -224,6 +224,7 @@ CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
///
CcWmINETEVENT
:==
140
/* MW11 */
CcWmZEROTIMER
:==
136
/* PA: new constant for sequence of zero timer events (generated only by Clean). */
CcWmLOSTKEY
:==
135
/* PA: new constant for loosing keyboard input (generated only by Clean). */
CcWmLOSTMOUSE
:==
134
/* PA: new constant for loosing mouse input (generated only by Clean). */
CcWmSPECIALBUTTON
:==
133
/* PA: new constant for info about OK/CANCEL button selected. */
...
...
libraries/ObjectIO/ObjectIO/OS Windows/clCrossCall_12.icl
View file @
05711b8d
...
...
@@ -373,6 +373,7 @@ CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
///
CcWmINETEVENT
:==
140
/* MW11 */
CcWmZEROTIMER
:==
136
/* PA: new constant for sequence of zero timer events (generated only by Clean). */
CcWmLOSTKEY
:==
135
/* PA: new constant for loosing keyboard input (generated only by Clean). */
CcWmLOSTMOUSE
:==
134
/* PA: new constant for loosing mouse input (generated only by Clean). */
CcWmSPECIALBUTTON
:==
133
/* PA: new constant for info about OK/CANCEL button selected. */
...
...
libraries/ObjectIO/ObjectIO/OS Windows/osevent.dcl
View file @
05711b8d
...
...
@@ -5,14 +5,19 @@ definition module osevent
from
StdInt
import
^,-
from
clCrossCall_12
import
CrossCallInfo
from
ostoolbox
import
OSToolbox
from
ostime
import
OSTime
// PA: new
from
ostypes
import
OSWindowPtr
from
StdMaybe
import
Maybe
,
Just
,
Nothing
::
*
OSEvents
OSnewEvents
::
OSEvents
OScopyEvents
::
!
OSEvents
->
(!
OSEvents
,!
OSEvents
)
OSappendEvents
::
!*[
OSEvent
]
!
OSEvents
->
OSEvents
// OSappendEvents adds events at the end of the queue
OSinsertEvents
::
!*[
OSEvent
]
!
OSEvents
->
OSEvents
// OSinsertEvents adds events at the front of the queue
OSisEmptyEvents
::
!
OSEvents
->
(!
Bool
,!
OSEvents
)
OSremoveEvent
::
!
OSEvents
->
(!
OSEvent
,!
OSEvents
)
::
OSEvent
...
...
@@ -31,14 +36,20 @@ OShandleEvents :: !(.s -> (Bool,.s)) !(.s -> (OSEvents,.s)) !((OSEvents,.s) ->
OSEventIsUrgent
::
!
OSEvent
->
Bool
setReplyInOSEvent
::
![
Int
]
->
CrossCallInfo
/*
createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */
/*
createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */
createOSActivateWindowEvent
::
!
OSWindowPtr
!*
OSToolbox
->
(!
OSEvent
,!*
OSToolbox
)
createOSDeactivateWindowEvent
::
!
OSWindowPtr
!*
OSToolbox
->
(!
OSEvent
,!*
OSToolbox
)
/*
createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */
/*
createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */
createOSActivateControlEvent
::
!
OSWindowPtr
!
OSWindowPtr
!*
OSToolbox
->
(!
OSEvent
,!*
OSToolbox
)
createOSDeactivateControlEvent
::
!
OSWindowPtr
!
OSWindowPtr
!*
OSToolbox
->
(!
OSEvent
,!*
OSToolbox
)
/*
createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */
/*
createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */
createOSLooseMouseEvent
::
!
OSWindowPtr
!
OSWindowPtr
!*
OSToolbox
->
(!
OSEvent
,!*
OSToolbox
)
createOSLooseKeyEvent
::
!
OSWindowPtr
!
OSWindowPtr
!*
OSToolbox
->
(!
OSEvent
,!*
OSToolbox
)
/* createOSZeroTimerEvent creates the event for reporting continued zero timer (virtual event).
getOSZeroTimerStartTime returns the registered time in the virtual event. Nothing is returned if wrong argument.
*/
createOSZeroTimerEvent
::
!
OSTime
->
OSEvent
// PA: new
getOSZeroTimerStartTime
::
!
OSEvent
->
Maybe
OSTime
// PA: new
libraries/ObjectIO/ObjectIO/OS Windows/osevent.icl
View file @
05711b8d
...
...
@@ -3,8 +3,9 @@ implementation module osevent
// Clean Object I/O library, version 1.2
import
StdBool
,
StdList
,
StdMisc
,
StdTuple
import
clCrossCall_12
,
ostoolbox
,
ostypes
import
clCrossCall_12
,
ostime
,
ostoolbox
,
ostypes
from
commondef
import
HdTl
,
FatalError
from
StdMaybe
import
Maybe
,
Just
,
Nothing
//import StdDebug, tracetypes
...
...
@@ -39,6 +40,14 @@ OSremoveEvent [osEvent:osEvents]
OSremoveEvent
[]
=
oseventFatalError
"OSremoveEvent"
"OSEvents argument is empty"
OScopyEvents
::
!
OSEvents
->
(!
OSEvents
,!
OSEvents
)
OScopyEvents
[]
=
([],[])
OScopyEvents
[
e
:
es
]
=
([
e
:
es1
],[
e
:
es2
])
where
(
es1
,
es2
)
=
OScopyEvents
es
OSnewEvents
::
OSEvents
OSnewEvents
=
[]
...
...
@@ -81,13 +90,13 @@ OShandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (
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 (trace_n ("CcRqDOMESSAGE-->"+++to
CleanCrossCallInfo
String 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 (trace_n ("DelayedEvent-->"+++to
CleanCrossCallInfo
String osEvent) osEvent) state
#
(_,
state
)
=
handleOSEvent
osEvent
state
=
OShandleEvents
isFinalState
getOSEvents
setOSEvents
getSleepTime
handleOSEvent
(
state
,
tb
)
...
...
@@ -114,26 +123,40 @@ OSEventIsUrgent {ccMsg}
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. */
/*
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. */
/*
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). */
/*
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
libraries/ObjectIO/ObjectIO/OS Windows/ostime.dcl
View file @
05711b8d
...
...
@@ -25,5 +25,6 @@ OSGetCurrentDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
// OSGetCurrentTime returns current (year,month,day,day_of_week).
instance
-
OSTime
// Calculate difference between arg 1 and arg 2
instance
<
OSTime
// True iff arg 1 < arg 2
instance
toInt
OSTime
// Coerce OSTime to Integer (always positive or zero)
instance
fromInt
OSTime
// Coerce Int to OSTime (Integer will be made zero if negative)
libraries/ObjectIO/ObjectIO/OS Windows/ostime.icl
View file @
05711b8d
...
...
@@ -44,6 +44,11 @@ instance - OSTime where
=
OSTime
(
new
-
old
)
=
OSTime
(
OSMaxTickCount
-
old
+
new
)
instance
<
OSTime
where
(<)
::
!
OSTime
!
OSTime
->
Bool
(<)
(
OSTime
t1
)
(
OSTime
t2
)
=
t1
<
t2
instance
toInt
OSTime
where
toInt
::
!
OSTime
->
Int
toInt
(
OSTime
t
)
=
t
...
...
libraries/ObjectIO/ObjectIO/OS Windows/oswindow.dcl
View file @
05711b8d
...
...
@@ -6,7 +6,7 @@ definition module oswindow
import
StdMaybe
,
StdOverloaded
,
StdString
from
osdocumentinterface
import
OSDInfo
,
OSMDInfo
,
OSSDInfo
,
OSInfo
,
OSToolbar
,
OSToolbarHandle
,
HMENU
,
HWND
from
osevent
import
OSEvent
,
CrossCallInfo
from
osevent
import
OSEvents
,
OSEvent
,
CrossCallInfo
from
osfont
import
Font
from
osrgn
import
OSRgnHandle
from
ossystem
import
OSWindowMetrics
...
...
@@ -122,9 +122,11 @@ OScreateWindow :: !OSWindowMetrics !Bool !ScrollbarInfo !ScrollbarInfo !(!Int,!I
!(
OSWindowPtr
->
OSWindowPtr
->
OSPictContext
->
u
:
s
->
u
:(*
OSToolbox
->*(
u
:
s
,*
OSToolbox
)))
!
OSDInfo
!
OSWindowPtr
!
u
:
s
!*
OSToolbox
->
(![
DelayActivationInfo
],!
OSWindowPtr
,!
OSWindowPtr
,!
OSWindowPtr
,!
OSDInfo
,!
u
:
s
,!*
OSToolbox
)
OScreateModalDialog
::
!
Bool
!
String
!
OSDInfo
!(
Maybe
OSWindowPtr
)
!(
OSEvent
->
u
:
s
->
*([
Int
],
u
:
s
))
!
u
:
s
!*
OSToolbox
->
(!
Bool
,!
u
:
s
,!*
OSToolbox
)
OScreateModalDialog
::
!
Bool
!
String
!
OSDInfo
!(
Maybe
OSWindowPtr
)
!(
u
:
s
->
(
OSEvents
,
u
:
s
))
!((
OSEvents
,
u
:
s
)->
u
:
s
)
!(
OSEvent
->
u
:
s
->
*([
Int
],
u
:
s
))
!
u
:
s
!*
OSToolbox
->
(!
Bool
,!
u
:
s
,!*
OSToolbox
)
// Mike //
OScreateGameWindow
::
!
Bool
!(!
Int
,!
Int
)
!
Int
!*
OSToolbox
->
(![
DelayActivationInfo
],!
OSWindowPtr
,!*
OSToolbox
)
...
...
libraries/ObjectIO/ObjectIO/OS Windows/oswindow.icl
View file @
05711b8d
...
...
@@ -306,12 +306,13 @@ OScreateWindowCallback _ _ _ _ _ {ccMsg} s tb
/* PA: new function that creates modal dialog and handles events until termination.
The Bool result is True iff no error occurred.
*/
OScreateModalDialog
::
!
Bool
!
String
!
OSDInfo
!(
Maybe
OSWindowPtr
)
!(
OSEvent
->
u
:
s
->
*([
Int
],
u
:
s
))
!
u
:
s
!*
OSToolbox
->
(!
Bool
,!
u
:
s
,!*
OSToolbox
)
OScreateModalDialog
isClosable
title
osdinfo
currentActiveModal
handleOSEvents
s
tb
OScreateModalDialog
::
!
Bool
!
String
!
OSDInfo
!(
Maybe
OSWindowPtr
)
!(
u
:
s
->
(
OSEvents
,
u
:
s
))
!((
OSEvents
,
u
:
s
)->
u
:
s
)
!(
OSEvent
->
u
:
s
->
*([
Int
],
u
:
s
))
!
u
:
s
!*
OSToolbox
->
(!
Bool
,!
u
:
s
,!*
OSToolbox
)
OScreateModalDialog
isClosable
title
osdinfo
currentActiveModal
getOSEvents
setOSEvents
handleOSEvents
s
tb
#
(
textPtr
,
tb
)
=
WinMakeCString
title
tb
createcci
=
Rq2Cci
CcRqCREATEMODALDIALOG
textPtr
parentptr
#
(
returncci
,
s
,
tb
)
=
IssueCleanRequest
(
OScreateModalDialogCallback
handleOSEvents
)
createcci
s
tb
#
(
returncci
,
s
,
tb
)
=
IssueCleanRequest
(
OScreateModalDialogCallback
getOSEvents
setOSEvents
handleOSEvents
)
createcci
s
tb
#
tb
=
WinReleaseCString
textPtr
tb
ok
=
case
returncci
.
ccMsg
of
CcRETURN1
->
returncci
.
p1
==
0
...
...
@@ -326,11 +327,19 @@ where
)
(
fromJust
currentActiveModal
)
OScreateModalDialogCallback
::
!(
OSEvent
->
u
:
s
->
*([
Int
],
u
:
s
))
!
CrossCallInfo
!
u
:
s
!*
OSToolbox
->
(!
CrossCallInfo
,!
u
:
s
,!*
OSToolbox
)
OScreateModalDialogCallback
handleOSEvents
osEvent
s
tb
// # (replyToOS,s) = handleOSEvents (if (osEvent.ccMsg==CcWmIDLETIMER) osEvent (trace_n ("OScreateModalDialogCallback-->"+++toString osEvent) osEvent)) s
#
(
replyToOS
,
s
)
=
handleOSEvents
osEvent
s
=
(
setReplyInOSEvent
replyToOS
,
s
,
tb
)
OScreateModalDialogCallback
::
!(
u
:
s
->
(
OSEvents
,
u
:
s
))
!((
OSEvents
,
u
:
s
)->
u
:
s
)
!(
OSEvent
->
u
:
s
->
*([
Int
],
u
:
s
))
!
CrossCallInfo
!
u
:
s
!*
OSToolbox
->
(!
CrossCallInfo
,!
u
:
s
,!*
OSToolbox
)
OScreateModalDialogCallback
getOSEvents
setOSEvents
handleOSEvents
osEvent
s
tb
#
(
replyToOS
,
s
)
=
handleOSEvents
osEvent
s
#
(
osEvents
,
s
)
=
getOSEvents
s
#
(
noDelayEvents
,
osEvents
)
=
OSisEmptyEvents
osEvents
|
noDelayEvents
=
(
setReplyInOSEvent
replyToOS
,
setOSEvents
(
osEvents
,
s
),
tb
)
|
otherwise
#
(
osEvent
,
osEvents
)
=
OSremoveEvent
osEvents
#
s
=
setOSEvents
(
osEvents
,
s
)
=
OScreateModalDialogCallback
getOSEvents
setOSEvents
handleOSEvents
osEvent
s
tb
// Mike //
OScreateGameWindow
::
!
Bool
!(!
Int
,!
Int
)
!
Int
!*
OSToolbox
->
(![
DelayActivationInfo
],!
OSWindowPtr
,!*
OSToolbox
)
...
...
libraries/ObjectIO/ObjectIO/iostate.icl
View file @
05711b8d
...
...
@@ -8,7 +8,7 @@ import StdBool, StdFunc, StdList, StdMisc
import
commondef
,
devicefunctions
,
devicesystemstate
,
processstack
,
receivertable
,
timertable
import
osdocumentinterface
,
ostime
from
osactivaterequests
import
OSActivateRequest
from
osevent
import
OSEvents
,
OSnewEvents
from
osevent
import
OSEvents
,
OScopyEvents
,
OSnewEvents
from
osguishare
import
OSGUIShare
from
osmouse
import
OSGetDoubleClickTime
from
ossystem
import
OSWindowMetrics
,
OSDefaultWindowMetrics
...
...
@@ -36,7 +36,7 @@ from roundrobin import RR, emptyRR, notodoRR
::
*
IOUnique
l
=
{
ioevents
::
!*
OSEvents
// The event stream environment
,
ioworld
::
!*[*
World
]
// The world environment
,
ioprocesses
::
*
CProcesses
// All other processes
,
ioprocesses
::
!
*
CProcesses
// All other processes
,
ioinit
::
!
IdFun
(
PSt
l
)
// The initialisation functions of the process
,
iotoolbox
::
!*
OSToolbox
// The Mac continuation value
}
...
...
@@ -291,7 +291,10 @@ IOStSetActivateRequests ioReqs ioState=:{ioshare} = {ioState & ioshare={ioshare
// Access rules to the OSEvents environment:
IOStGetEvents
::
!(
IOSt
.
l
)
->
(!*
OSEvents
,
!
IOSt
.
l
)
IOStGetEvents
ioState
=:{
iounique
=
unique
=:{
ioevents
}}
=
(
ioevents
,{
ioState
&
iounique
={
unique
&
ioevents
=
OSnewEvents
}})
//IOStGetEvents ioState=:{iounique=unique=:{ioevents}} = (ioevents,{ioState & iounique={unique & ioevents=OSnewEvents}})
IOStGetEvents
ioState
=:{
iounique
=
unique
=:{
ioevents
=
es
}}
#
(
es1
,
es2
)
=
OScopyEvents
es
=
(
es1
,{
ioState
&
iounique
={
unique
&
ioevents
=
es2
}})
IOStSetEvents
::
!*
OSEvents
!(
IOSt
.
l
)
->
IOSt
.
l
IOStSetEvents
es
ioState
=
{
ioState
&
iounique
={
ioState
.
iounique
&
ioevents
=
es
}}
...
...
libraries/ObjectIO/ObjectIO/scheduler.dcl
View file @
05711b8d
...
...
@@ -34,15 +34,15 @@ from StdProcessDef import ProcessInit, DocumentInterface, NDI, SDI, MDI
}
::
*
Context
=
{
cEnvs
::
!*
Environs
// The global environments
,
cProcessStack
::
ProcessStack
// The global process stack
,
cMaxIONr
::
SystemId
// The global maximum system number
,
cProcesses
::
*
CProcesses
// All processes
,
cModalProcess
::
Maybe
SystemId
// The SystemId of the interactive process that has a modal window
,
cReceiverTable
::
ReceiverTable
// The global receiver-process table
,
cTimerTable
::
TimerTable
// The table of all currently active timers
,
cIdTable
::
IdTable
// The table of all bound Ids
,
cOSTime
::
OSTime
// The current OSTime
,
cIdSeed
::
Int
// The global id generating number (actually the World)
,
cProcessStack
::
!
ProcessStack
// The global process stack
,
cMaxIONr
::
!
SystemId
// The global maximum system number
,
cProcesses
::
!
*
CProcesses
// All processes
,
cModalProcess
::
!
Maybe
SystemId
// The SystemId of the interactive process that has a modal window
,
cReceiverTable
::
!
ReceiverTable
// The global receiver-process table
,
cTimerTable
::
!
TimerTable
// The table of all currently active timers
,
cIdTable
::
!
IdTable
// The table of all bound Ids
,
cOSTime
::
!
OSTime
// The current OSTime
,
cIdSeed
::
!
Int
// The global id generating number (actually the World)
,
cOSToolbox
::
!*
OSToolbox
// The toolbox environment
}
...
...
libraries/ObjectIO/ObjectIO/scheduler.icl
View file @
05711b8d
...
...
@@ -6,6 +6,7 @@ implementation module scheduler
import
StdBool
,
StdList
,
StdTuple
import
osevent
,
ostime
from
ossystem
import
OStickspersecond
from
ostoolbox
import
OSNewToolbox
,
OSInitToolbox
import
commondef
,
devicefunctions
,
iostate
,
processstack
,
roundrobin
,
timertable
,
world
from
StdProcessDef
import
ProcessInit
...
...
@@ -19,15 +20,15 @@ from StdProcessAttribute import isProcessKindAttribute
}
::
*
Context
=
{
cEnvs
::
!*
Environs
// The global environments
,
cProcessStack
::
ProcessStack
// The global process stack
,
cMaxIONr
::
SystemId
// The global maximum system number
,
cProcesses
::
*
CProcesses
// All processes
,
cModalProcess
::
Maybe
SystemId
// The SystemId of the interactive process that has a modal window
,
cReceiverTable
::
ReceiverTable
// The global receiver-process table
,
cTimerTable
::
TimerTable
// The table of all currently active timers
,
cIdTable
::
IdTable
// The table of all bound Ids
,
cOSTime
::
OSTime
// The current OSTime
,
cIdSeed
::
Int
// The global id generating number (actually the World)
,
cProcessStack
::
!
ProcessStack
// The global process stack
,
cMaxIONr
::
!
SystemId
// The global maximum system number
,
cProcesses
::
!
*
CProcesses
// All processes
,
cModalProcess
::
!
Maybe
SystemId
// The SystemId of the interactive process that has a modal window
,
cReceiverTable
::
!
ReceiverTable
// The global receiver-process table
,
cTimerTable
::
!
TimerTable
// The table of all currently active timers
,
cIdTable
::
!
IdTable
// The table of all bound Ids
,
cOSTime
::
!
OSTime
// The current OSTime
,
cIdSeed
::
!
Int
// The global id generating number (actually the World)
,
cOSToolbox
::
!*
OSToolbox
// The toolbox environment
}
...
...
@@ -52,14 +53,15 @@ ContextGetSleepTime :: !Context -> (!Int,!Context)
ContextGetSleepTime
context
=:{
cTimerTable
,
cReceiverTable
}
#
maybe_sleep
=
getTimeIntervalFromTimerTable
cTimerTable
#
maybe_receiver
=
getActiveReceiverTableEntry
cReceiverTable
sleep
=
if
(
isJust
maybe_receiver
)
0
// a receiver with a non-empty message queue exists
(
if
(
isJust
maybe_sleep
)
(
fromJust
maybe_sleep
)
// a timer with given interval is waiting
OSLongSleep
)
// neither a receiver nor timer
sleep
=
if
(
isJust
maybe_receiver
)
0
// a receiver with a non-empty message queue exists
(
if
(
isJust
maybe_sleep
)
(
snd
(
fromJust
maybe_sleep
)
)
// a timer with given interval is waiting
OSLongSleep
)
// neither a receiver nor timer
=
(
sleep
,
context
)
ContextGetOSEvents
::
!
Context
->
(!
OSEvents
,!
Context
)
ContextGetOSEvents
context
=:{
cEnvs
=
envs
=:{
envsEvents
}}
=
(
envsEvents
,{
context
&
cEnvs
={
envs
&
envsEvents
=
OSnewEvents
}})
ContextGetOSEvents
context
=:{
cEnvs
=
envs
=:{
envsEvents
=
es
}}
#
(
es1
,
es2
)
=
OScopyEvents
es
=
(
es1
,{
context
&
cEnvs
={
envs
&
envsEvents
=
es2
}})
ContextSetOSEvents
::
!(!
OSEvents
,!
Context
)
->
Context
ContextSetOSEvents
(
osEvents
,
context
=:{
cEnvs
=
envs
})
...
...
@@ -171,16 +173,22 @@ where
=
(
not
continue
,
context
)
handleContextOSEvent
::
!
OSEvent
!
Context
->
(![
Int
],!
Context
)
handleContextOSEvent
osEvent
context
=:{
cProcessStack
,
cProcesses
,
cReceiverTable
,
cTimerTable
,
cOSTime
,
cOSToolbox
}
handleContextOSEvent
osEvent
context
=:{
cEnvs
=
envs
=:{
envsEvents
=
osEvents
},
cProcessStack
,
cProcesses
,
cReceiverTable
,
cTimerTable
,
cOSTime
,
cOSToolbox
}
// PA: shift the time in the timertable.
#
(
ostime
,
tb
)
=
OSGetTime
cOSToolbox
timeshift
=
toInt
(
ostime
-
cOSTime
)
timertable
=
shiftTimeInTimerTable
timeshift
cTimerTable
// PA: determine whether a TimerEvent or ASyncMessage can be generated
(
schedulerEvent
,
receivertable
,
timertable
)
=
toSchedulerEvent
osEvent
cReceiverTable
timertable
cOSTime
(
schedulerEvent
,
receivertable
,
timertable
,
osEvents
)
=
toSchedulerEvent
osEvent
cReceiverTable
timertable
cOSTime
osEvents
processes
=
resetRR
cProcesses
#
context
=
{
context
&
cProcesses
=
processes
,
cReceiverTable
=
receivertable
,
cTimerTable
=
timertable
,
cOSTime
=
ostime
,
cOSToolbox
=
tb
}
#
context
=
{
context
&
cEnvs
=
{
envs
&
envsEvents
=
osEvents
}
,
cProcesses
=
processes
,
cReceiverTable
=
receivertable
,
cTimerTable
=
timertable
,
cOSTime
=
ostime
,
cOSToolbox
=
tb
}
#
(
schedulerEvent
,
context
)
=
handleEventForContext
False
schedulerEvent
context
replyToOS
=
case
schedulerEvent
of
(
ScheduleOSEvent
_
reply
)
->
reply
...
...
@@ -201,46 +209,76 @@ handleContextOSEvent osEvent context=:{cProcessStack,cProcesses,cReceiverTable,c
can be generated instead. If both a TimerEvent and an ASyncMessage are available, use the OSTime to
decide which one to choose.
*/
toSchedulerEvent
::
!
OSEvent
!
ReceiverTable
!
TimerTable
!
OSTime
->
(!
SchedulerEvent
,!
ReceiverTable
,!
TimerTable
)
toSchedulerEvent
osevent
receivertable
timertable
osTime
|
OSEventIsUrgent
osevent
=
(
schedulerEvent
,
receivertable
,
timertable
)
|
not
sure_timer
&&
not
sure_receiver
=
(
schedulerEvent
,
receivertable
,
timertable
)
zerotimelimit
::
OSTime
zerotimelimit
=:
fromInt
(
max
1
(
OStickspersecond
/
20
))
toSchedulerEvent
::
!
OSEvent
!
ReceiverTable
!
TimerTable
!
OSTime
!*
OSEvents
->
(!
SchedulerEvent
,!
ReceiverTable
,!
TimerTable
,!*
OSEvents
)
toSchedulerEvent
osevent
receivertable
timertable
osTime
osEvents
|
eventIsUrgent
=
(
schedulerEvent
,
receivertable
,
timertable
,
osEvents
)
|
(
not
sure_timer
)
&&
not
sure_receiver
=
(
schedulerEvent
,
receivertable
,
timertable
,
osEvents
)
|
sure_timer
&&
sure_receiver
|
isEven
(
toInt
osTime
)
=
(
timerEvent
,
receivertable
,
timertable`
)
=
(
timerEvent
,
receivertable
,
timertable`
,
osEvents`
)
// otherwise
=
(
asyncEvent
,
receivertable`
,
timertable
)
=
(
asyncEvent
,
receivertable`
,
timertable
,
osEvents`
)
|
sure_timer
=
(
timerEvent
,
receivertable
,
timertable`
)
=
(
timerEvent
,
receivertable
,
timertable`
,
osEvents`
)
|
otherwise
=
(
asyncEvent
,
receivertable`
,
timertable
)
=
(
asyncEvent
,
receivertable`
,
timertable
,
osEvents
)
where
eventIsUrgent
=
OSEventIsUrgent
osevent
maybe_timer
=
getTimeIntervalFromTimerTable
timertable
(
zerotimer
,
interval
)
=
fromJust
maybe_timer
maybe_receiver
=
getActiveReceiverTableEntry
receivertable
sure_timer
=
isJust
maybe_timer
&&
fromJust
maybe_timer
<=
0
sure_timer
=
isJust
maybe_timer
&&
interval
<=
0
sure_receiver
=
isJust
maybe_receiver
schedulerEvent
=
ScheduleOSEvent
osevent
[]
(
asyncEvent
,
receivertable`
)
=
toASyncEvent
(
fromJust
maybe_receiver
)
receivertable
(
timerEvent
,
timertable`
)
=
toTimerEvent
timertable
// osEvents` = checkOSZeroTimerEvent zerotimer osTime osevent osEvents
osEvents`
=
checkOSZeroTimerEvent
maybe_timer
osTime
osevent
osEvents
// In case the original event is a virtual zero timer event:
// check if another should be inserted in the OSEvents to circumvent the event system call.
// In case the original event is a non urgent event:
// check if an initial virtual zero timer event must be inserted to start circumventing event system calls.
// checkOSZeroTimerEvent :: !Bool !OSTime !OSEvent !*OSEvents -> *OSEvents
checkOSZeroTimerEvent
::
!(
Maybe
(
Bool
,
Int
))
!
OSTime
!
OSEvent
!*
OSEvents
->
*
OSEvents
// checkOSZeroTimerEvent zerotimer osTime osevent osEvents
checkOSZeroTimerEvent
maybe_timer
osTime
osevent
osEvents
|
isJust
maybe_zerotimer_start
&&
zerotimer
|
osTime
-
zerotimer_start
<=
zerotimelimit
=
OSinsertEvents
[
osevent
]
osEvents
// otherwise
=
osEvents
|
isNothing
maybe_zerotimer_start
&&
zerotimer
=
OSinsertEvents
[
createOSZeroTimerEvent
osTime
]
osEvents
|
otherwise
=
osEvents
where
(
zerotimer
,_)
=
fromJust
maybe_timer
maybe_zerotimer_start
=
getOSZeroTimerStartTime
osevent
zerotimer_start
=
fromJust
maybe_zerotimer_start
// The receiver for which an ASyncMessage is generated is placed behind all other receivers,
// creating a round-robin order. Its asynchronous message queue length field is decreased.
// The receiver for which an ASyncMessage is generated is placed behind all other receivers,
// creating a round-robin order. Its asynchronous message queue length field is decreased.
toASyncEvent
::
!
Id
!
ReceiverTable
->
(!
SchedulerEvent
,!
ReceiverTable
)
toASyncEvent
rid
receivertable
#!
rte
=
fromJust
(
getReceiverTableEntry
rid
receivertable
)
#!
rte
=
{
rte
&
rteASMCount
=
rte
.
rteASMCount
-1
}
#!
receivertable
=
setReceiverTableEntry
rte
(
snd
(
removeReceiverFromReceiverTable
rid
receivertable
))
#!
rte
=
fromJust
(
getReceiverTableEntry
rid
receivertable
)
#!
rte
=
{
rte
&
rteASMCount
=
rte
.
rteASMCount
-1
}
#!
receivertable
=
setReceiverTableEntry
rte
(
snd
(
removeReceiverFromReceiverTable
rid
receivertable
))
=
(
ScheduleMsgEvent
(
ASyncMessage
{
asmRecLoc
=
rte
.
rteLoc
}),
receivertable
)
// The timer for which a TimerEvent is generated is determined by getActiveTimerInTable.
// This function already takes care of fairness using a round robin scheme.
// The timer for which a TimerEvent is generated is determined by getActiveTimerInTable.
// This function already takes care of fairness using a round robin scheme.
toTimerEvent
::
!
TimerTable
->
(!
SchedulerEvent
,!
TimerTable
)
toTimerEvent
timertable
#
(
maybeTimerEvent
,
timertable
)
=
getActiveTimerInTimerTable
timertable
=
(
ScheduleTimerEvent
(
fromJust
maybeTimerEvent
),
timertable
)
handleEventForContext
::
!
Bool
!
SchedulerEvent
!
Context
->
(!
SchedulerEvent
,!
Context
)
handleEventForContext
eventDone
schedulerEvent
context
=:{
cProcesses
=
processes
}
#
(
notodo
,
processes
)
=
notodoRR
processes
...
...
libraries/ObjectIO/ObjectIO/timertable.dcl
View file @
05711b8d
...
...
@@ -52,8 +52,9 @@ shiftTimeInTimerTable :: !Int !TimerTable -> TimerTable
*/
getActiveTimerInTimerTable
::
!
TimerTable
->
(!
Maybe
TimerEvent
,!
TimerTable
)
/* getTimeIntervalFromTimerTable returns the (Just time) interval that can be waited for the next timer to
become active.
/* getTimeIntervalFromTimerTable returns the (Just (zerotimer,time)) interval that can be
waited for the next timer to become active. The Boolean zerotimer holds iff the time
returned belongs to a zero timer.
If there are no timers, then Nothing is returned.
*/
getTimeIntervalFromTimerTable
::
!
TimerTable
->
Maybe
Int
getTimeIntervalFromTimerTable
::
!
TimerTable
->
Maybe
(
Bool
,
Int
)
libraries/ObjectIO/ObjectIO/timertable.icl
View file @
05711b8d
...
...
@@ -128,22 +128,23 @@ getActiveTimerInTimerTable [tte=:{tteElapse,tteInterval,tteLoc}:ttes]
getActiveTimerInTimerTable
_
=
(
Nothing
,[])
/* getTimeIntervalFromTimerTable returns the (Just time) interval that can be waited for the next timer to
become active.
/* getTimeIntervalFromTimerTable returns the (Just (zerotimer,time)) interval that can be
waited for the next timer to become active. The Boolean zerotimer holds iff the time
returned belongs to a zero timer.
If there are no timers, then Nothing is returned.
*/
getTimeIntervalFromTimerTable
::
!
TimerTable
->
Maybe
Int
getTimeIntervalFromTimerTable
::
!
TimerTable
->
Maybe
(
Bool
,
Int
)
getTimeIntervalFromTimerTable
timers
=:[]
=
Nothing
getTimeIntervalFromTimerTable
timers
#!
wait
=
getSleepTime
(
2
^
31-1
)
timers
=
Just
wait
where
getSleepTime
::
!
Int
![
TimerTableEntry
]
->
Int
getSleepTime
sleep
[
tte
=:{
tteElapse
}:
ttes
]
getSleepTime
::
!
Int
![
TimerTableEntry
]
->
(
Bool
,
Int
)
getSleepTime
sleep
[
tte
=:{
tteElapse
,
tteInterval
}:
ttes
]
|
tteElapse
<=
0
=
0
=
(
tteInterval
==
0
,
0
)
|
otherwise
=
getSleepTime
(
min
sleep
tteElapse
)
ttes
getSleepTime
sleep
_
=
sleep
=
(
False
,
sleep
)
libraries/ObjectIO/ObjectIO/windowcreate.icl
View file @
05711b8d
...
...
@@ -10,7 +10,7 @@ import StdBool, StdFunc, StdList, StdMisc, StdTuple
import
osevent
,
ostypes
,
oswindow
from
ostoolbox
import
OSNewToolbox
from
StdMenu
import
enableMenuSystem
,
disableMenuSystem
from
StdPSt
import
accPIO
from
StdPSt
import
accPIO
,
appPIO
from
StdWindowAttribute
import
isWindowInit
,
getWindowInitFun
,
isWindowClose
,
isWindowCursor
,
getWindowCursorAtt
import
commondef
,
controlpos
,
iostate
,
scheduler
,
windowaccess
from
controlcreate
import
createControls
...
...
@@ -50,7 +50,8 @@ openmodalwindow wId {wlsState,wlsHandle} pState=:{io=ioState}
#
(
inputTrack
,
ioState
)
=
IOStGetInputTrack
ioState
#
ioState
=
IOStSetInputTrack
Nothing
ioState
// clear input track information
#
pState
=
{
pState
&
io
=
ioState
}
#
(
noError
,
pState
,_)
=
OScreateModalDialog
closable
title
osdinfo
(
mapMaybe
(\{
wPtr
}->
wPtr
)
modalWIDS
)
handleOSEvent
pState
OSNewToolbox
#
(
noError
,
pState
,_)
=
OScreateModalDialog
closable
title
osdinfo
(
mapMaybe
(\{
wPtr
}->
wPtr
)
modalWIDS
)
getOSEvent
setOSEvent
handleOSEvent
pState
OSNewToolbox
(
delayMouse
,
delayKey
)
=
case
inputTrack
of
// after handling modal dialog, generate proper (Mouse/Key)Lost events
Nothing
->
([],[])
Just
it
=:{
itWindow
,
itControl
,
itKind
}
...
...
@@ -67,6 +68,12 @@ where
handleOSEvent
::
!
OSEvent
!(
PSt
.
l
)
->
(![
Int
],!
PSt
.
l
)
handleOSEvent
osEvent
pState
=
accContext
(
handleContextOSEvent
osEvent
)
pState
getOSEvent
::
!(
PSt
.
l
)
->
(!
OSEvents
,!
PSt
.
l
)
getOSEvent
pState
=
accPIO
IOStGetEvents
pState
setOSEvent
::
!(!
OSEvents
,!
PSt
.
l
)
->
PSt
.
l
setOSEvent
(
osEvents
,
pState
)
=
appPIO
(
IOStSetEvents
osEvents
)
pState
/* getFinalModalDialogLS retrieves the final local state of the modal dialog. This value has been stored in the window handles.
This MUST have been done by disposeWindow (windowdispose).
*/
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment