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-compiler-and-rts
stdenv
Commits
86e750ec
Commit
86e750ec
authored
Nov 30, 1999
by
Peter Achten
Browse files
(PA) public state component removed from PSt/IOSt
parent
8fb27ad6
Changes
82
Hide whitespace changes
Inline
Side-by-side
ObjectIO/GameLib/StdGame.dcl
View file @
86e750ec
...
...
@@ -18,7 +18,7 @@ SK_FOREVER :== (~1)
::
NoState
=
NoState
OpenGame
::
gs
(
Game
gs
)
[
GameAttribute
gs
]
!(
PSt
.
l
.
p
)
->
(
ErrorReport
,
!
PSt
.
l
.
p
)
OpenGame
::
gs
(
Game
gs
)
[
GameAttribute
gs
]
!(
PSt
.
l
)
->
(
ErrorReport
,
!
PSt
.
l
)
CreateGameBitmap
::
!
GameBitmap
!(
GSt
.
gs
)
->
(!
GRESULT
,
!
GSt
.
gs
)
...
...
ObjectIO/GameLib/StdGame.icl
View file @
86e750ec
...
...
@@ -23,7 +23,7 @@ SK_FOREVER :== (~1)
=
NoState
OpenGame
::
gs
(
Game
gs
)
[
GameAttribute
gs
]
!(
PSt
.
l
.
p
)
->
(
ErrorReport
,
!(
PSt
.
l
.
p
))
OpenGame
::
gs
(
Game
gs
)
[
GameAttribute
gs
]
!(
PSt
.
l
)
->
(
ErrorReport
,
!(
PSt
.
l
))
OpenGame
gs
gdef
attr
ps
#
(
wId
,
ps
)
=
accPIO
openId
ps
#
size
=
findSize
attr
{
w
=
320
,
h
=
240
}
...
...
@@ -47,7 +47,7 @@ where
findBPP
[
x
:
xs
]
s
=
findBPP
xs
s
// always full screen, game in a window not implemented yet
OpenGameWindow
::
!
Id
!
Size
!
Int
!
Bool
!(
PSt
.
l
.
p
)
->
(!
ErrorReport
,
!
PSt
.
l
.
p
)
OpenGameWindow
::
!
Id
!
Size
!
Int
!
Bool
!(
PSt
.
l
)
->
(!
ErrorReport
,
!
PSt
.
l
)
OpenGameWindow
id
gamewindowsize
bitsperpixel
fullscreen
pState
#
pState
=
WindowFunctions
.
dOpen
pState
#
(
isZero
,
pState
)
=
accPIO
checkZeroWindowBound
pState
...
...
ObjectIO/ObjectIO/OS Windows/menuevent.dcl
View file @
86e750ec
...
...
@@ -12,7 +12,7 @@ import deviceevents, devicesystemstate, menuhandle
from
iostate
import
PSt
,
IOSt
menuEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
menuEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
MenuHandlesGetMenuStateHandles
::
!(
MenuHandles
.
pst
)
->
(![
MenuStateHandle
.
pst
],
!
MenuHandles
.
pst
)
// PA: moved from menudevice
ObjectIO/ObjectIO/OS Windows/menuevent.icl
View file @
86e750ec
...
...
@@ -29,7 +29,7 @@ menueventFatalError function error
menuEvent assumes that it is not applied to an empty IOSt and that its device is
present.
*/
menuEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
menuEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
menuEvent
schedulerEvent
pState
#
(
hasMenuDevice
,
pState
)
=
accPIO
(
IOStHasDevice
MenuDevice
)
pState
|
not
hasMenuDevice
// This condition should never hold
...
...
@@ -37,7 +37,7 @@ menuEvent schedulerEvent pState
|
otherwise
=
menuEvent
schedulerEvent
pState
where
menuEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
menuEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
menuEvent
schedulerEvent
=:(
ScheduleOSEvent
osEvent
=:{
ccMsg
}
_)
pState
=:{
io
=
ioState
}
|
isToolbarOSEvent
ccMsg
#
(
osdInfo
,
ioState
)
=
IOStGetOSDInfo
ioState
...
...
@@ -102,7 +102,7 @@ where
/* filterToolbarEvent filters the OSEvents that can be handled by this menu device.
*/
filterToolbarEvent
::
!
OSDInfo
!
OSEvent
!(
IOSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
[
Int
],!
Maybe
DeviceEvent
,!
IOSt
.
l
.
p
)
filterToolbarEvent
::
!
OSDInfo
!
OSEvent
!(
IOSt
.
l
)
->
(!
Bool
,!
Maybe
[
Int
],!
Maybe
DeviceEvent
,!
IOSt
.
l
)
/* CcWmBUTTONCLICKED is a menu event in case of a toolbar selection.
*/
...
...
ObjectIO/ObjectIO/OS Windows/osprint.dcl
View file @
86e750ec
...
...
@@ -53,7 +53,7 @@ class PrintEnvironments printEnv
->
(
Alternative
.
x
.
state
,!*
printEnv
)
instance
PrintEnvironments
Files
instance
PrintEnvironments
(
PSt
.
l
.
p
)
instance
PrintEnvironments
(
PSt
.
l
)
os_printsetuptostring
::
!
PrintSetup
->
String
...
...
ObjectIO/ObjectIO/OS Windows/osprint.icl
View file @
86e750ec
...
...
@@ -4,7 +4,7 @@ implementation module osprint
// MW11 was import StdEnv,intrface,clCrossCall_12, iostate, scheduler
import
StdEnv
,
clCCall_12
,
clCrossCall_12
,
iostate
,
scheduler
import
ospicture
,
osevent
,
StdPicture
,
StdWindow
,
StdPSt
import
ospicture
,
osevent
/*
, StdPicture
*/
,
StdWindow
,
StdPSt
::
PrintSetup
=
{
devmode
::
!
String
...
...
@@ -85,7 +85,7 @@ class PrintEnvironments printEnv
->
(
Alternative
.
x
.
state
,!*
printEnv
)
instance
PrintEnvironments
(
PSt
.
l
.
p
)
instance
PrintEnvironments
(
PSt
.
l
)
where
os_printpageperpage
doDialog
emulateScreen
x
initFun
transFun
printSetup
pSt
=:{
io
}
#!
(
windowStack
,
io
)
=
getWindowStack
io
...
...
@@ -102,7 +102,7 @@ where
#
(
x
,
mb_context
,
os
)
=
printPagePerPageBothSemaphor
doDialog
emulateScreen
x
initFun
transFun
printSetup
(
Just
context
)
os
=
(
x
,
EnvSetOS
os
(
fromJust
mb_context
))
zipWithSelectState
::
.
Id
*(
IOSt
.
a
.
b
)
->
*(.(
Maybe
SelectState
,
Id
),*
IOSt
.
a
.
b
)
zipWithSelectState
::
.
Id
*(
IOSt
.
a
)
->
*(.(
Maybe
SelectState
,
Id
),*
IOSt
.
a
)
zipWithSelectState
id
io
#!
(
mbSelectState
,
io
)
=
getWindowSelectState
id
io
=
((
mbSelectState
,
id
),
io
)
...
...
ObjectIO/ObjectIO/OS Windows/processevent.dcl
View file @
86e750ec
...
...
@@ -11,4 +11,4 @@ import deviceevents
from
iostate
import
PSt
,
IOSt
processEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
processEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
ObjectIO/ObjectIO/OS Windows/processevent.icl
View file @
86e750ec
...
...
@@ -25,7 +25,7 @@ processeventFatalError function error
/* processEvent filters the scheduler events that can be handled by this process device.
processEvent assumes that it is not applied to an empty IOSt.
*/
processEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
processEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
processEvent
schedulerEvent
=:(
ScheduleOSEvent
osEvent
=:{
ccMsg
}
_)
pState
=:{
io
=
ioState
}
|
isProcessOSEvent
ccMsg
...
...
ObjectIO/ObjectIO/OS Windows/receiverevent.dcl
View file @
86e750ec
...
...
@@ -11,4 +11,4 @@ import deviceevents
from
iostate
import
PSt
,
IOSt
receiverEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
receiverEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
ObjectIO/ObjectIO/OS Windows/receiverevent.icl
View file @
86e750ec
...
...
@@ -13,7 +13,7 @@ from StdPSt import accPIO
These are only the message events (as long as receivers do not contain timers).
receiverEvent assumes that it is not applied to an empty IOSt.
*/
receiverEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
receiverEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
receiverEvent
schedulerEvent
=:(
ScheduleMsgEvent
msgEvent
)
pState
#
(
ioid
,
pState
)
=
accPIO
IOStGetIOId
pState
recloc
=
case
msgEvent
of
...
...
ObjectIO/ObjectIO/OS Windows/timerevent.dcl
View file @
86e750ec
...
...
@@ -12,4 +12,4 @@ import deviceevents
from
iostate
import
PSt
,
IOSt
timerEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
timerEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
ObjectIO/ObjectIO/OS Windows/timerevent.icl
View file @
86e750ec
...
...
@@ -22,7 +22,7 @@ timereventFatalError function error
* ScheduleMsgEvent: the message event belongs to this process and device
timerEvent assumes that it is not applied to an empty IOSt.
*/
timerEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
timerEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
timerEvent
schedulerEvent
pState
#
(
hasDevice
,
pState
)
=
accPIO
(
IOStHasDevice
TimerDevice
)
pState
|
not
hasDevice
// This condition should never occur: TimerDevice must have been 'installed'
...
...
@@ -30,7 +30,7 @@ timerEvent schedulerEvent pState
|
otherwise
=
timerEvent
schedulerEvent
pState
where
timerEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
timerEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
timerEvent
schedulerEvent
=:(
ScheduleTimerEvent
te
=:{
teLoc
})
pState
=:{
io
=
ioState
}
#
(
ioid
,
ioState
)
=
IOStGetIOId
ioState
|
teLoc
.
tlIOId
<>
ioid
||
teLoc
.
tlDevice
<>
TimerDevice
...
...
ObjectIO/ObjectIO/OS Windows/windowevent.dcl
View file @
86e750ec
...
...
@@ -12,4 +12,4 @@ import deviceevents
from
iostate
import
PSt
,
IOSt
windowEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
windowEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
ObjectIO/ObjectIO/OS Windows/windowevent.icl
View file @
86e750ec
...
...
@@ -31,7 +31,7 @@ windoweventFatalError function error
For the time being no timer controls are added, so these events are ignored.
windowEvent assumes that it is not applied to an empty IOSt.
*/
windowEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
windowEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
windowEvent
schedulerEvent
pState
#
(
hasDevice
,
pState
)
=
accPIO
(
IOStHasDevice
WindowDevice
)
pState
|
not
hasDevice
// This condition should never occur: WindowDevice must have been 'installed'
...
...
@@ -39,7 +39,7 @@ windowEvent schedulerEvent pState
|
otherwise
=
windowEvent
schedulerEvent
pState
where
windowEvent
::
!
SchedulerEvent
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
.
p
)
windowEvent
::
!
SchedulerEvent
!(
PSt
.
l
)
->
(!
Bool
,!
Maybe
DeviceEvent
,!
SchedulerEvent
,!
PSt
.
l
)
windowEvent
schedulerEvent
=:(
ScheduleOSEvent
osEvent
_)
pState
=:{
io
=
ioState
}
|
not
(
isWindowOSEvent
osEvent
.
ccMsg
)
=
(
False
,
Nothing
,
schedulerEvent
,
pState
)
...
...
@@ -96,8 +96,8 @@ where
/* filterOSEvent filters the OSEvents that can be handled by this window device.
*/
filterOSEvent
::
!
OSWindowMetrics
!
OSEvent
!(
WindowHandles
(
PSt
.
l
.
p
))
!(
IOSt
.
l
.
p
)
->
(!
Bool
,!
Maybe
[
Int
],!
Maybe
DeviceEvent
,!
WindowHandles
(
PSt
.
l
.
p
),!
IOSt
.
l
.
p
)
filterOSEvent
::
!
OSWindowMetrics
!
OSEvent
!(
WindowHandles
(
PSt
.
l
))
!(
IOSt
.
l
)
->
(!
Bool
,!
Maybe
[
Int
],!
Maybe
DeviceEvent
,!
WindowHandles
(
PSt
.
l
),
!
IOSt
.
l
)
filterOSEvent
_
{
ccMsg
=
CcWmBUTTONCLICKED
,
p1
=
wPtr
,
p2
=
cPtr
,
p3
=
mods
,
p4
=
toolbarIndex
}
windows
ioState
#
(
found
,
wsH
,
windows
)
=
getWindowHandlesWindow
(
toWID
wPtr
)
windows
...
...
ObjectIO/ObjectIO/StdClipboard.dcl
View file @
86e750ec
...
...
@@ -31,8 +31,8 @@ instance Clipboard {#Char}
// Access to the current content of the clipboard:
setClipboard
::
![
ClipboardItem
]
!(
PSt
.
l
.
p
)
->
PSt
.
l
.
p
getClipboard
::
!(
PSt
.
l
.
p
)
->
(![
ClipboardItem
],!
PSt
.
l
.
p
)
setClipboard
::
![
ClipboardItem
]
!(
PSt
.
l
)
->
PSt
.
l
getClipboard
::
!(
PSt
.
l
)
->
(![
ClipboardItem
],!
PSt
.
l
)
/* setClipboard
replaces the current content of the clipboard with the argument list.
Of the list only the first occurence of a ClipboardItem of the same type
...
...
@@ -43,7 +43,7 @@ getClipboard :: !(PSt .l .p) -> (![ClipboardItem],!PSt .l .p)
*/
clipboardHasChanged
::
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
PSt
.
l
.
p
)
clipboardHasChanged
::
!(
PSt
.
l
)
->
(!
Bool
,!
PSt
.
l
)
/* clipboardHasChanged holds if the current content of the clipboard is different
from the last access to the clipboard.
*/
ObjectIO/ObjectIO/StdClipboard.icl
View file @
86e750ec
...
...
@@ -36,7 +36,7 @@ instance Clipboard {#Char} where
// Reading and writing the value of the selection to the clipboard:
setClipboard
::
![
ClipboardItem
]
!(
PSt
.
l
.
p
)
->
PSt
.
l
.
p
setClipboard
::
![
ClipboardItem
]
!(
PSt
.
l
)
->
PSt
.
l
setClipboard
clipItems
pState
=:{
io
}
#
(
tb
,
ioState
)
=
getIOToolbox
io
#
tb
=
StrictSeq
(
map
clipboardItemToScrap
singleItems
)
tb
...
...
@@ -61,7 +61,7 @@ where
clipboardItemToScrap
(
ClipboardString
text
)
tb
=
OSsetClipboardText
text
tb
getClipboard
::
!(
PSt
.
l
.
p
)
->
(![
ClipboardItem
],!
PSt
.
l
.
p
)
getClipboard
::
!(
PSt
.
l
)
->
(![
ClipboardItem
],!
PSt
.
l
)
getClipboard
pState
#
(
tb
,
ioState
)
=
getIOToolbox
pState
.
io
#
(
contents
,
tb
)
=
OSgetClipboardContent
tb
...
...
@@ -80,7 +80,7 @@ where
scrapToClipboardItem
type
tb
=
StdClipboardFatalError
"getClipboard"
(
"unimplemented clipboard content of type: "
+++
toString
type
)
clipboardHasChanged
::
!(
PSt
.
l
.
p
)
->
(!
Bool
,!
PSt
.
l
.
p
)
clipboardHasChanged
::
!(
PSt
.
l
)
->
(!
Bool
,!
PSt
.
l
)
clipboardHasChanged
pState
#
(
cbs
,
ioState
)
=
IOStGetClipboardState
pState
.
io
oldCount
=
cbs
.
cbsCount
...
...
ObjectIO/ObjectIO/StdControl.dcl
View file @
86e750ec
...
...
@@ -18,53 +18,53 @@ from StdPSt import PSt, IOSt
process are used to change the corresponding controls.
*/
showControls
::
![
Id
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
showControl
::
!
Id
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
hideControls
::
![
Id
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
hideControl
::
!
Id
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
showControls
::
![
Id
]
!(
IOSt
.
l
)
->
IOSt
.
l
showControl
::
!
Id
!(
IOSt
.
l
)
->
IOSt
.
l
hideControls
::
![
Id
]
!(
IOSt
.
l
)
->
IOSt
.
l
hideControl
::
!
Id
!(
IOSt
.
l
)
->
IOSt
.
l
/* (show/hide)Control(s) makes the indicated control(s) visible/invisible.
Hiding a control overrides the visibility of its elements, which become
invisible.
Showing a hidden control re-establishes the visibility state of its elements.
*/
enableControls
::
![
Id
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
enableControl
::
!
Id
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
disableControls
::
![
Id
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
disableControl
::
!
Id
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
enableControls
::
![
Id
]
!(
IOSt
.
l
)
->
IOSt
.
l
enableControl
::
!
Id
!(
IOSt
.
l
)
->
IOSt
.
l
disableControls
::
![
Id
]
!(
IOSt
.
l
)
->
IOSt
.
l
disableControl
::
!
Id
!(
IOSt
.
l
)
->
IOSt
.
l
/* (en/dis)ableControl(s) (en/dis)ables the indicated control(s).
Disabling a control overrides the SelectStates of its elements, which become
unselectable.
Enabling a disabled control re-establishes the SelectStates of its elements.
*/
markCheckControlItems
::
!
Id
![
Index
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
unmarkCheckControlItems
::
!
Id
![
Index
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
markCheckControlItems
::
!
Id
![
Index
]
!(
IOSt
.
l
)
->
IOSt
.
l
unmarkCheckControlItems
::
!
Id
![
Index
]
!(
IOSt
.
l
)
->
IOSt
.
l
/* (unm/m)arkCheckControlItems unmarks/marks the indicated check items of the given
CheckControl. Indices range from 1 to the number of check items. Illegal indices
are ignored.
*/
selectRadioControlItem
::
!
Id
!
Index
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
selectRadioControlItem
::
!
Id
!
Index
!(
IOSt
.
l
)
->
IOSt
.
l
/* selectRadioControlItem marks the indicated radio item of a RadioControl, causing
the mark of the previously marked radio item to disappear. The item is given by
the Id of the RadioControl and its index position (counted from 1).
*/
selectPopUpControlItem
::
!
Id
!
Index
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
selectPopUpControlItem
::
!
Id
!
Index
!(
IOSt
.
l
)
->
IOSt
.
l
/* selectPopUpControlItem marks the indicated popup item of a PopUpControl, causing
the mark of the previously marked popup item to disappear. The item is given by
the Id of the PopUpControl and its index position (counted from 1).
*/
moveControlViewFrame
::
!
Id
Vector2
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
moveControlViewFrame
::
!
Id
Vector2
!(
IOSt
.
l
)
->
IOSt
.
l
/* moveControlViewFrame moves the orientation of the CompoundControl over the given
vector, and updates the control if necessary. The control frame is not moved
outside the ViewDomain of the control. MoveControlViewFrame has no effect if the
indicated control has no ControlDomain attribute.
*/
setControlViewDomain
::
!
Id
ViewDomain
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlViewDomain
::
!
Id
ViewDomain
!(
IOSt
.
l
)
->
IOSt
.
l
/* setControlViewDomain sets the view domain of the indicated CompoundControl as
given. The control view frame is moved such that a maximum portion of the view
domain is visible. The control is not resized.
...
...
@@ -72,21 +72,21 @@ setControlViewDomain :: !Id ViewDomain !(IOSt .l .p) -> IOSt .l .p
effect.
*/
setControlScrollFunction
::
!
Id
Direction
ScrollFunction
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlScrollFunction
::
!
Id
Direction
ScrollFunction
!(
IOSt
.
l
)
->
IOSt
.
l
/* setControlScrollFunction set the ScrollFunction of the indicated CompoundControl
in the given Direction if it has one.
In all other cases, setControlScrollFunction has no effect.
*/
setControlTexts
::
![(
Id
,
String
)]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlText
::
!
Id
!
String
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlTexts
::
![(
Id
,
String
)]
!(
IOSt
.
l
)
->
IOSt
.
l
setControlText
::
!
Id
!
String
!(
IOSt
.
l
)
->
IOSt
.
l
/* setControlText(s) sets the text of the indicated (Text/Edit/Button)Control(s).
If the indicated control is a (Text/Button)Control, then AltKey are interpreted
by the system.
If the indicated control is an EditControl, then the text is taken as it is.
*/
setEditControlCursor
::
!
Id
!
Int
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setEditControlCursor
::
!
Id
!
Int
!(
IOSt
.
l
)
->
IOSt
.
l
/* setEditControlCursor sets the cursor at position @2 of the current content of
the EditControl.
In case @2<0, then the cursor is set at the start of the current content.
...
...
@@ -94,18 +94,18 @@ setEditControlCursor :: !Id !Int !(IOSt .l .p) -> IOSt .l .p
content.
*/
setControlLooks
::
![(
Id
,
Bool
,(
Bool
,
Look
))]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlLook
::
!
Id
!
Bool
(
Bool
,
Look
)
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlLooks
::
![(
Id
,
Bool
,(
Bool
,
Look
))]
!(
IOSt
.
l
)
->
IOSt
.
l
setControlLook
::
!
Id
!
Bool
(
Bool
,
Look
)
!(
IOSt
.
l
)
->
IOSt
.
l
/* setControlLook(s) sets the (render,look) attribute of the indicated
(Custom(Button)/Compound)Control(s). If this concerns a transparant
CompoundControl then it becomes non-transparant.
An indicated control is only redrawn if the first Boolean is True.
*/
setSliderStates
::
![(
Id
,
IdFun
SliderState
)]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setSliderState
::
!
Id
(
IdFun
SliderState
)
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setSliderThumbs
::
![(
Id
,
Int
)]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setSliderThumb
::
!
Id
Int
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setSliderStates
::
![(
Id
,
IdFun
SliderState
)]
!(
IOSt
.
l
)
->
IOSt
.
l
setSliderState
::
!
Id
(
IdFun
SliderState
)
!(
IOSt
.
l
)
->
IOSt
.
l
setSliderThumbs
::
![(
Id
,
Int
)]
!(
IOSt
.
l
)
->
IOSt
.
l
setSliderThumb
::
!
Id
Int
!(
IOSt
.
l
)
->
IOSt
.
l
/* setSliderState(s)
applies the function to the current SliderState of the indicated
SliderControl(s) and redraws the settings if necessary.
...
...
@@ -114,9 +114,9 @@ setSliderThumb :: !Id Int !(IOSt .l .p) -> IOSt .l .p
settings if necessary.
*/
appControlPicture
::
!
Id
!.(
IdFun
*
Picture
)
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
accControlPicture
::
!
Id
!.(
St
*
Picture
.
x
)
!(
IOSt
.
l
.
p
)
->
(!
Maybe
.
x
,!
IOSt
.
l
.
p
)
appControlPicture
::
!
Id
!.(
IdFun
*
Picture
)
!(
IOSt
.
l
)
->
IOSt
.
l
accControlPicture
::
!
Id
!.(
St
*
Picture
.
x
)
!(
IOSt
.
l
)
->
(!
Maybe
.
x
,!
IOSt
.
l
)
/* (app/acc)ControlPicture applies the given drawing function to the Picture of
the indicated (Custom(Button)/Compound)Control. If the CompoundControl is
transparant, or the indicated control could not be found then this operation
...
...
@@ -131,8 +131,8 @@ accControlPicture :: !Id !.(St *Picture .x) !(IOSt .l .p)
::
WState
getWindow
::
!
Id
!(
IOSt
.
l
.
p
)
->
(!
Maybe
WState
,
!
IOSt
.
l
.
p
)
getParentWindow
::
!
Id
!(
IOSt
.
l
.
p
)
->
(!
Maybe
WState
,
!
IOSt
.
l
.
p
)
getWindow
::
!
Id
!(
IOSt
.
l
)
->
(!
Maybe
WState
,
!
IOSt
.
l
)
getParentWindow
::
!
Id
!(
IOSt
.
l
)
->
(!
Maybe
WState
,
!
IOSt
.
l
)
/* getWindow returns a read-only WState for the indicated window.
In case the indicated window does not exist Nothing is returned.
getParentWindow returns a read-only WState for the parent window/dialogue
...
...
ObjectIO/ObjectIO/StdControl.icl
View file @
86e750ec
...
...
@@ -73,7 +73,7 @@ gatherWindowIds` []
}
getWindow
::
!
Id
!(
IOSt
.
l
.
p
)
->
(!
Maybe
WState
,
!
IOSt
.
l
.
p
)
getWindow
::
!
Id
!(
IOSt
.
l
)
->
(!
Maybe
WState
,
!
IOSt
.
l
)
getWindow
windowId
ioState
#
(
found
,
wDevice
,
ioState
)
=
IOStGetDevice
WindowDevice
ioState
|
not
found
...
...
@@ -92,7 +92,7 @@ getWindow windowId ioState
#
(
wMetrics
,
ioState
)
=
IOStGetOSWindowMetrics
ioState
=
(
Just
{
wIds
=
wids
,
wRep
=
wsH`
,
wTb
=
OSNewToolbox
,
wMetrics
=
wMetrics
},
ioState
)
getParentWindow
::
!
Id
!(
IOSt
.
l
.
p
)
->
(!
Maybe
WState
,
!
IOSt
.
l
.
p
)
getParentWindow
::
!
Id
!(
IOSt
.
l
)
->
(!
Maybe
WState
,
!
IOSt
.
l
)
getParentWindow
controlId
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
maybeParent
=
getIdParent
controlId
idtable
...
...
@@ -105,7 +105,7 @@ getParentWindow controlId ioState
|
otherwise
=
(
Nothing
,
ioState
)
setWindow
::
!
Id
!(
IdFun
*
WState
)
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setWindow
::
!
Id
!(
IdFun
*
WState
)
!(
IOSt
.
l
)
->
IOSt
.
l
setWindow
windowId
f
ioState
#
(
found
,
wDevice
,
ioState
)
=
IOStGetDevice
WindowDevice
ioState
|
not
found
...
...
@@ -129,7 +129,7 @@ setWindow windowId f ioState
// Show/Hide controls.
showControls
::
![
Id
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
showControls
::
![
Id
]
!(
IOSt
.
l
)
->
IOSt
.
l
showControls
ids
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -138,10 +138,10 @@ showControls ids ioState
|
isEmpty
cIds_wIds
=
ioState
|
otherwise
=
StrictSeq
[
setWindow
wId
(
setControlsShowState`
True
cIds
)
\\
(
cIds
,
wId
)<-
cIds_wIds
]
ioState
showControl
::
!
Id
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
showControl
::
!
Id
!(
IOSt
.
l
)
->
IOSt
.
l
showControl
id
ioState
=
showControls
[
id
]
ioState
hideControls
::
![
Id
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
hideControls
::
![
Id
]
!(
IOSt
.
l
)
->
IOSt
.
l
hideControls
ids
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -150,7 +150,7 @@ hideControls ids ioState
|
isEmpty
cIds_wIds
=
ioState
|
otherwise
=
StrictSeq
[
setWindow
wId
(
setControlsShowState`
False
cIds
)
\\
(
cIds
,
wId
)<-
cIds_wIds
]
ioState
hideControl
::
!
Id
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
hideControl
::
!
Id
!(
IOSt
.
l
)
->
IOSt
.
l
hideControl
id
ioState
=
hideControls
[
id
]
ioState
setControlsShowState`
::
!
Bool
![
Id
]
!*
WState
->
*
WState
...
...
@@ -162,7 +162,7 @@ setControlsShowState` show ids wState=:{wIds={wPtr},wRep,wTb,wMetrics}
/* Enabling/Disabling of controls.
*/
enableControls
::
![
Id
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
enableControls
::
![
Id
]
!(
IOSt
.
l
)
->
IOSt
.
l
enableControls
ids
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -176,10 +176,10 @@ where
#
(
wH
,
tb
)
=
enablecontrols
ids
False
wMetrics
wPtr
wRep
wTb
=
{
wState
&
wRep
=
wH
,
wTb
=
tb
}
enableControl
::
!
Id
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
enableControl
::
!
Id
!(
IOSt
.
l
)
->
IOSt
.
l
enableControl
id
ioState
=
enableControls
[
id
]
ioState
disableControls
::
![
Id
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
disableControls
::
![
Id
]
!(
IOSt
.
l
)
->
IOSt
.
l
disableControls
ids
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -193,21 +193,21 @@ where
#
(
wH
,
tb
)
=
disablecontrols
ids
False
wMetrics
wPtr
wRep
wTb
=
{
wState
&
wRep
=
wH
,
wTb
=
tb
}
disableControl
::
!
Id
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
disableControl
::
!
Id
!(
IOSt
.
l
)
->
IOSt
.
l
disableControl
id
ioState
=
disableControls
[
id
]
ioState
// Marking/Unmarking of check controls.
markCheckControlItems
::
!
Id
![
Index
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
markCheckControlItems
::
!
Id
![
Index
]
!(
IOSt
.
l
)
->
IOSt
.
l
markCheckControlItems
cId
indexs
ioState
=
setControlsMarkState
Mark
cId
indexs
ioState
unmarkCheckControlItems
::
!
Id
![
Index
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
unmarkCheckControlItems
::
!
Id
![
Index
]
!(
IOSt
.
l
)
->
IOSt
.
l
unmarkCheckControlItems
cId
indexs
ioState
=
setControlsMarkState
NoMark
cId
indexs
ioState
setControlsMarkState
::
!
MarkState
!
Id
![
Index
]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlsMarkState
::
!
MarkState
!
Id
![
Index
]
!(
IOSt
.
l
)
->
IOSt
.
l
setControlsMarkState
mark
cId
indexs
ioState
|
isEmpty
indexs
=
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
...
...
@@ -225,7 +225,7 @@ where
// Selecting/Unselecting a radio control.
selectRadioControlItem
::
!
Id
!
Index
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
selectRadioControlItem
::
!
Id
!
Index
!(
IOSt
.
l
)
->
IOSt
.
l
selectRadioControlItem
cId
index
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -242,7 +242,7 @@ where
// Select a pop up menu item.
selectPopUpControlItem
::
!
Id
!
Index
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
selectPopUpControlItem
::
!
Id
!
Index
!(
IOSt
.
l
)
->
IOSt
.
l
selectPopUpControlItem
cId
index
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -259,7 +259,7 @@ where
// Move the orientation of a CompoundControl.
moveControlViewFrame
::
!
Id
Vector2
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
moveControlViewFrame
::
!
Id
Vector2
!(
IOSt
.
l
)
->
IOSt
.
l
moveControlViewFrame
cId
v
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -277,7 +277,7 @@ where
// Set a new view domain of a CompoundControl.
setControlViewDomain
::
!
Id
ViewDomain
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlViewDomain
::
!
Id
ViewDomain
!(
IOSt
.
l
)
->
IOSt
.
l
setControlViewDomain
cId
newDomain
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -294,7 +294,7 @@ where
// Set the ScrollFunction of a CompoundControl.
setControlScrollFunction
::
!
Id
Direction
ScrollFunction
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlScrollFunction
::
!
Id
Direction
ScrollFunction
!(
IOSt
.
l
)
->
IOSt
.
l
setControlScrollFunction
cId
direction
scrollFun
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -312,7 +312,7 @@ where
// Change the text of (Text/Edit/Button)Control.
setControlTexts
::
![(
Id
,
String
)]
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p
setControlTexts
::
![(
Id
,
String
)]
!(
IOSt
.
l
)
->
IOSt
.
l
setControlTexts
cid_texts
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
...
...
@@ -327,13 +327,13 @@ where
#
(
wH
,
tb
)
=
setcontroltexts
texts
wMetrics
wPtr
wRep
wTb
=
{
wState
&
wRep
=
wH
,
wTb
=
tb
}
setControlText
::
!
Id
!
String
!(
IOSt
.
l
.
p
)
->
IOSt
.
l
.
p