Skip to content
GitLab
Menu
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
dccad754
Commit
dccad754
authored
Jan 14, 2000
by
Peter Achten
Browse files
(PA) Bug fix in setControlPos;
function updateControl added (StdControl)
parent
47644197
Changes
15
Hide whitespace changes
Inline
Side-by-side
ObjectIO/ObjectIO/StdBitmap.dcl
View file @
dccad754
...
...
@@ -39,5 +39,6 @@ instance Drawables Bitmap
drawAt pos bitmap
draws the given bitmap with its left top at the given pen position.
undraw(At)
equals unfill(At) the box {box_w=w,box_h=h} with {w,h} the size of the bitmap.
equals unfill(At) the box {box_w=w,box_h=h} with {w,h} the size of the
bitmap.
*/
ObjectIO/ObjectIO/StdControl.dcl
View file @
dccad754
...
...
@@ -188,6 +188,25 @@ accControlPicture :: !Id !.(St *Picture .x) !(IOSt .l)
*/
updateControl
::
!
Id
!(
Maybe
ViewFrame
)
!(
IOSt
.
l
)
->
IOSt
.
l
/* updateControl applies the Look attribute function of the indicated
(Compound/Custom(Button))Control.
The Look attribute function is applied to the following arguments:
The current SelectState of the control, and
the UpdateState argument
{oldFrame=viewframe,newFrame=viewframe,updArea=[frame]}
where viewframe is the current ViewFrame of the control;
and frame depends on the optional ViewFrame argument:
in case of (Just rectangle):
the intersection of viewframe and rectangle.
in case of Nothing:
viewframe.
updateControl has no effect in case of unknown controls, or if the indicated
control is not a (Compound/Custom(Button))Control, or the optional viewframe
argument is an empty rectangle.
*/
/* Access functions on WState. To read the state of a control, a WState is
required which can be obtained by the getWindow function. The WState value
represents the state of a window or dialogue at that particular moment.
...
...
ObjectIO/ObjectIO/StdControl.icl
View file @
dccad754
...
...
@@ -12,10 +12,12 @@ from controllayout import calcControlsSize
from
receiverid
import
unbindRIds
from
StdPSt
import
appPIO
from
windowclipstate
import
invalidateWindowClipState`
,
forceValidWindowClipState`
from
windowupdate
import
updatewindow
from
wstateaccess
import
iswindowitemspace`
,
getwindowitemspace`
,
iswindowhmargin`
,
getwindowhmargin`
,
iswindowvmargin`
,
getwindowvmargin`
from
ostoolbox
import
OSNewToolbox
from
oswindow
import
OSscrollbarsAreVisible
StdControlFatalError
::
String
String
->
.
x
...
...
@@ -732,6 +734,107 @@ accControlPicture cId drawfun ioState
#
ioState
=
IOStSetDevice
(
WindowSystemState
windows
)
ioState
=
(
maybe_result
,
ioState
)
// Update a selection of a (Compound/Custom(Button))Control:
updateControl
::
!
Id
!(
Maybe
ViewFrame
)
!(
IOSt
.
l
)
->
IOSt
.
l
updateControl
cId
maybeViewFrame
ioState
#
(
idtable
,
ioState
)
=
IOStGetIdTable
ioState
#
(
ioId
,
ioState
)
=
IOStGetIOId
ioState
maybeParent
=
getIdParent
cId
idtable
|
not
(
fst
(
isOkControlId
ioId
(
cId
,
maybeParent
)))
=
ioState
#
(
found
,
wDevice
,
ioState
)
=
IOStGetDevice
WindowDevice
ioState
|
not
found
=
ioState
#
windows
=
WindowSystemStateGetWindowHandles
wDevice
wId
=
(
fromJust
maybeParent
).
idpId
(_,
wsH
,
windows
)
=
getWindowHandlesWindow
(
toWID
wId
)
windows
(
wKind
,
wsH
)
=
getWindowStateHandleWindowKind
wsH
|
wKind
<>
IsWindow
=
IOStSetDevice
(
WindowSystemState
(
setWindowHandlesWindow
wsH
windows
))
ioState
|
otherwise
#
(
wMetrics
,
ioState
)
=
IOStGetOSWindowMetrics
ioState
#
(
wsH
,
ioState
)
=
accIOToolbox
(
updateControlBackground
wMetrics
wKind
cId
maybeViewFrame
wsH
)
ioState
=
IOStSetDevice
(
WindowSystemState
(
setWindowHandlesWindow
wsH
windows
))
ioState
where
updateControlBackground
::
!
OSWindowMetrics
!
WindowKind
!
Id
!(
Maybe
ViewFrame
)
!(
WindowStateHandle
.
pst
)
!*
OSToolbox
->
(!
WindowStateHandle
.
pst
,
!*
OSToolbox
)
updateControlBackground
wMetrics
wKind
cId
maybeViewFrame
wsH
=:{
wshIds
,
wshHandle
=
Just
wlsH
=:{
wlsHandle
=
wH
=:{
whSize
=
whSize
,
whItems
=
itemHs
}}}
tb
#
(_,
updInfo
,
itemHs
)
=
getWElementHandlesUpdateInfo
wMetrics
cId
contentRect
itemHs
wH
=
{
wH
&
whItems
=
itemHs
}
#
(
wH
,
tb
)
=
updatewindow
wMetrics
updInfo
wH
tb
=
({
wsH
&
wshHandle
=
Just
{
wlsH
&
wlsHandle
=
wH
}},
tb
)
where
info
=
getWindowInfoWindowData
wH
.
whWindowInfo
(
domainRect
,
hasScrolls
)
=
case
wKind
of
IsWindow
->
(
info
.
windowDomain
,(
isJust
info
.
windowHScroll
,
isJust
info
.
windowVScroll
))
_
->
(
SizeToRect
whSize
,(
False
,
False
))
visScrolls
=
OSscrollbarsAreVisible
wMetrics
domainRect
(
toTuple
whSize
)
hasScrolls
contentRect
=
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
whSize
)
getWElementHandlesUpdateInfo
::
!
OSWindowMetrics
!
Id
!
Rect
![
WElementHandle
.
ls
.
pst
]
->
(!
Bool
,
UpdateInfo
,![
WElementHandle
.
ls
.
pst
])
getWElementHandlesUpdateInfo
wMetrics
cId
clipRect
itemHs
|
isEmpty
itemHs
=
(
False
,
undef
,
itemHs
)
#
(
itemH
,
itemHs
)
=
HdTl
itemHs
#
(
found
,
updInfo
,
itemH
)
=
getWElementHandleUpdateInfo
wMetrics
cId
clipRect
itemH
|
found
=
(
found
,
updInfo
,[
itemH
:
itemHs
])
|
otherwise
#
(
found
,
updInfo
,
itemHs
)=
getWElementHandlesUpdateInfo
wMetrics
cId
clipRect
itemHs
=
(
found
,
updInfo
,[
itemH
:
itemHs
])
where
getWElementHandleUpdateInfo
::
!
OSWindowMetrics
!
Id
!
Rect
!(
WElementHandle
.
ls
.
pst
)
->
(!
Bool
,
UpdateInfo
,!
WElementHandle
.
ls
.
pst
)
getWElementHandleUpdateInfo
wMetrics
cId
clipRect
(
WItemHandle
itemH
=:{
wItemId
,
wItemKind
,
wItemPos
,
wItemSize
,
wItems
})
|
isNothing
wItemId
||
cId
<>
fromJust
wItemId
|
not
(
isRecursiveControl
wItemKind
)
=
(
False
,
undef
,
WItemHandle
itemH
)
// otherwise
#
(
found
,
updInfo
,
itemHs
)
=
getWElementHandlesUpdateInfo
wMetrics
cId
visRect
wItems
=
(
found
,
updInfo
,
WItemHandle
{
itemH
&
wItems
=
itemHs
})
|
isMember
wItemKind
[
IsCompoundControl
,
IsCustomControl
,
IsCustomButtonControl
]
=
(
True
,
updInfo
,
WItemHandle
itemH
)
|
otherwise
=
(
False
,
undef
,
WItemHandle
itemH
)
where
itemRect
=
PosSizeToRect
wItemPos
wItemSize
wItemInfo
=
itemH
.
wItemInfo
compoundInfo
=
getWItemCompoundInfo
wItemInfo
origin
=
if
(
wItemKind
==
IsCompoundControl
)
compoundInfo
.
compoundOrigin
zero
domain
=
compoundInfo
.
compoundDomain
hasScrolls
=
(
isJust
compoundInfo
.
compoundHScroll
,
isJust
compoundInfo
.
compoundVScroll
)
visScrolls
=
OSscrollbarsAreVisible
wMetrics
domain
(
toTuple
wItemSize
)
hasScrolls
contentRect
=
if
(
wItemKind
==
IsCompoundControl
)
(
getCompoundContentRect
wMetrics
visScrolls
itemRect
)
itemRect
visRect
=
IntersectRects
contentRect
clipRect
updArea
=
case
maybeViewFrame
of
Nothing
->
visRect
Just
rect
->
IntersectRects
(
RectangleToRect
(
addVector
(
toVector
wItemPos
)
(
subVector
(
toVector
origin
)
rect
)
)
)
visRect
updInfo
=
{
updWIDS
=
wshIds
,
updWindowArea
=
zero
,
updControls
=
[
{
cuItemNr
=
itemH
.
wItemNr
,
cuItemPtr
=
itemH
.
wItemPtr
,
cuArea
=
updArea
}]
,
updGContext
=
Nothing
}
getWElementHandleUpdateInfo
wMetrics
cId
clipRect
(
WListLSHandle
itemHs
)
#
(
found
,
updInfo
,
itemHs
)=
getWElementHandlesUpdateInfo
wMetrics
cId
clipRect
itemHs
=
(
found
,
updInfo
,
WListLSHandle
itemHs
)
getWElementHandleUpdateInfo
wMetrics
cId
clipRect
(
WExtendLSHandle
wExH
=:{
wExtendItems
=
itemHs
})
#
(
found
,
updInfo
,
itemHs
)=
getWElementHandlesUpdateInfo
wMetrics
cId
clipRect
itemHs
=
(
found
,
updInfo
,
WExtendLSHandle
{
wExH
&
wExtendItems
=
itemHs
})
getWElementHandleUpdateInfo
wMetrics
cId
clipRect
(
WChangeLSHandle
wChH
=:{
wChangeItems
=
itemHs
})
#
(
found
,
updInfo
,
itemHs
)=
getWElementHandlesUpdateInfo
wMetrics
cId
clipRect
itemHs
=
(
found
,
updInfo
,
WChangeLSHandle
{
wChH
&
wChangeItems
=
itemHs
})
updateControlBackground
_
_
_
_
_
_
=
StdControlFatalError
"updateControl"
"unexpected window placeholder argument"
// Access operations on WState:
...
...
ObjectIO/ObjectIO/StdIOCommon.dcl
View file @
dccad754
...
...
@@ -125,8 +125,8 @@ viewFrameRange :== { corner1 = {x = 1-(2^31),y = 1-(2^31)}
}
/* Modifiers indicates the meta keys that have been pressed (True) or not (False).
*/
/* Modifiers indicates the meta keys that have been pressed (True) or not (False).
*/
::
Modifiers
=
{
shiftDown
::
!
Bool
// True iff shift down
,
optionDown
::
!
Bool
// True iff option down
...
...
@@ -337,16 +337,16 @@ stdUnfillUpdAreaLook :: SelectState !UpdateState !*Picture -> *Picture
/* Common error report types. */
::
ErrorReport
// Usual cause:
=
NoError
// Everything went allright
|
ErrorViolateDI
// Violation against DocumentInterface
|
ErrorIdsInUse
// Object contains Ids that are bound
|
ErrorUnknownObject
// Object can not be found
|
ErrorNotifierOpen
// It was tried to open a second send notifier
// MW11++
|
OtherError
!
String
// Other kind of error
::
ErrorReport
// Usual cause:
=
NoError
// Everything went allright
|
ErrorViolateDI
// Violation against DocumentInterface
|
ErrorIdsInUse
// Object contains Ids that are bound
|
ErrorUnknownObject
// Object can not be found
|
ErrorNotifierOpen
// It was tried to open a second send notifier
|
OtherError
!
String
// Other kind of error
instance
==
ErrorReport
// Constructor equality
instance
toString
ErrorReport
// Constructor as String
instance
==
ErrorReport
// Constructor equality
instance
toString
ErrorReport
// Constructor as String
::
OkBool
// iff
True
,
the operation was successful
::
OkBool
//
True
iff
the operation was successful
:==
Bool
ObjectIO/ObjectIO/StdId.dcl
View file @
dccad754
...
...
@@ -32,9 +32,9 @@ class Ids env where
is generated.
*/
instance
Ids
World
instance
Ids
(
IOSt
.
l
)
instance
Ids
(
PSt
.
l
)
instance
Ids
World
,
IOSt
.
l
,
PSt
.
l
getParentId
::
!
Id
!(
IOSt
.
l
)
->
(!
Maybe
Id
,!
IOSt
.
l
)
/* getParentId returns the Id of the parent top-level GUI object
...
...
ObjectIO/ObjectIO/StdMenuElementClass.dcl
View file @
dccad754
...
...
@@ -21,12 +21,12 @@ class MenuElements m where
getMenuElementType
::
(
m
.
ls
.
pst
)
->
MenuElementType
instance
MenuElements
(
AddLS
m
)
|
MenuElements
m
// getMenuElementType==""
instance
MenuElements
(
NewLS
m
)
|
MenuElements
m
// getMenuElementType==""
instance
MenuElements
(
ListLS
m
)
|
MenuElements
m
// getMenuElementType==""
instance
MenuElements
NilLS
// getMenuElementType==""
instance
MenuElements
(
AddLS
m
)
|
MenuElements
m
instance
MenuElements
(
NewLS
m
)
|
MenuElements
m
instance
MenuElements
(
ListLS
m
)
|
MenuElements
m
instance
MenuElements
NilLS
instance
MenuElements
((:+:)
m1
m2
)
|
MenuElements
m1
&
MenuElements
m2
// getMenuElementType==""
&
MenuElements
m2
instance
MenuElements
(
SubMenu
m
)
|
MenuElements
m
instance
MenuElements
RadioMenu
instance
MenuElements
MenuItem
...
...
@@ -40,12 +40,12 @@ class PopUpMenuElements m where
getPopUpMenuElementType
::
(
m
.
ls
.
pst
)
->
MenuElementType
instance
PopUpMenuElements
(
AddLS
m
)
|
PopUpMenuElements
m
// getPopUpMenuElementType==""
instance
PopUpMenuElements
(
NewLS
m
)
|
PopUpMenuElements
m
// getPopUpMenuElementType==""
instance
PopUpMenuElements
(
ListLS
m
)
|
PopUpMenuElements
m
// getPopUpMenuElementType==""
instance
PopUpMenuElements
NilLS
// getPopUpMenuElementType==""
instance
PopUpMenuElements
(
AddLS
m
)
|
PopUpMenuElements
m
instance
PopUpMenuElements
(
NewLS
m
)
|
PopUpMenuElements
m
instance
PopUpMenuElements
(
ListLS
m
)
|
PopUpMenuElements
m
instance
PopUpMenuElements
NilLS
instance
PopUpMenuElements
((:+:)
m1
m2
)
|
PopUpMenuElements
m1
&
PopUpMenuElements
m2
// getPopUpMenuElementType==""
&
PopUpMenuElements
m2
instance
PopUpMenuElements
RadioMenu
instance
PopUpMenuElements
MenuItem
instance
PopUpMenuElements
MenuSeparator
ObjectIO/ObjectIO/StdPrint.dcl
View file @
dccad754
...
...
@@ -11,9 +11,10 @@ definition module StdPrint
// ********************************************************************************
from
Std
Picture
import
Picture
,
Point2
from
StdIO
Common
import
Size
,
Rectangle
,
IdFun
,
UpdateState
,
ViewFrame
,
UpdateArea
from
Std
IOCommon
import
UpdateState
,
ViewFrame
,
UpdateArea
from
StdIO
Basic
import
IdFun
,
Size
,
Rectangle
,
Point2
from
StdOverloaded
import
==
from
ospicture
import
Picture
from
osprint
import
PrintSetup
,
JobInfo
,
PrintInfo
,
Alternative
,
Cancelled
,
StartedPrinting
,
PrintEnvironments
from
iostate
import
IOSt
,
PSt
...
...
ObjectIO/ObjectIO/StdProcessAttribute.dcl
View file @
dccad754
...
...
@@ -18,7 +18,7 @@ import StdProcessDef
*/
isProcessKindAttribute
::
!
DocumentInterface
!(
ProcessAttribute
.
st
)
->
Bool
/* (
y = valid, . = in
valid)
/* (
The document interface is given for which the attribute is
valid)
ProcessActivate NDI SDI MDI | ProcessToolbar SDI MDI
ProcessClose NDI SDI MDI | ProcessWindowPos SDI MDI
ProcessDeactivate NDI SDI MDI | ProcessWindowResize SDI MDI
...
...
@@ -48,8 +48,10 @@ isProcessWindowSize :: !(ProcessAttribute .st) -> Bool
getProcessActivateFun
::
!(
ProcessAttribute
.
st
)
->
IdFun
.
st
getProcessCloseFun
::
!(
ProcessAttribute
.
st
)
->
IdFun
.
st
getProcessDeactivateFun
::
!(
ProcessAttribute
.
st
)
->
IdFun
.
st
getProcessOpenFilesFun
::
!(
ProcessAttribute
.
st
)
->
ProcessOpenFilesFunction
.
st
getProcessOpenFilesFun
::
!(
ProcessAttribute
.
st
)
->
ProcessOpenFilesFunction
.
st
getProcessToolbarAtt
::
!(
ProcessAttribute
.
st
)
->
[
ToolbarItem
.
st
]
getProcessWindowPosAtt
::
!(
ProcessAttribute
.
st
)
->
ItemPos
getProcessWindowResizeFun
::
!(
ProcessAttribute
.
st
)
->
ProcessWindowResizeFunction
.
st
getProcessWindowResizeFun
::
!(
ProcessAttribute
.
st
)
->
ProcessWindowResizeFunction
.
st
getProcessWindowSizeAtt
::
!(
ProcessAttribute
.
st
)
->
Size
ObjectIO/ObjectIO/StdReceiverDef.dcl
View file @
dccad754
...
...
@@ -19,9 +19,9 @@ import StdIOCommon
::
ReceiverFunction
m
st
:==
m
->
st
->
st
::
Receiver2Function
m
r
st
:==
m
->
st
->
(
r
,
st
)
::
ReceiverAttribute
st
// Default:
=
ReceiverInit
(
IdFun
st
)
// no actions after opening receiver
|
ReceiverSelectState
SelectState
// receiver Able
|
ReceiverConnectedReceivers
[
Id
]
// []
// MW11++
::
ReceiverAttribute
st
// Default:
=
ReceiverInit
(
IdFun
st
)
// no actions after opening receiver
|
ReceiverSelectState
SelectState
// receiver Able
|
ReceiverConnectedReceivers
[
Id
]
// []
::
ReceiverType
:==
String
ObjectIO/ObjectIO/StdSound.dcl
View file @
dccad754
...
...
@@ -14,7 +14,8 @@ class playSoundFile env :: !String !*env -> (!Bool,!*env)
/* playSoundFile filename
opens the sound file at filename and plays it synchronously.
The Boolean result indicates whether the sound file could be succesfully played.
The Boolean result indicates whether the sound file could be succesfully
played.
*/
instance
playSoundFile
World
ObjectIO/ObjectIO/StdTimer.dcl
View file @
dccad754
...
...
@@ -8,7 +8,7 @@ definition module StdTimer
// ********************************************************************************
import
StdTimerDef
,
StdTimerElementClass
,
StdMaybe
import
StdTimerElementClass
,
StdMaybe
from
StdSystem
import
ticksPerSecond
from
iostate
import
PSt
,
IOSt
...
...
ObjectIO/ObjectIO/StdWindow.dcl
View file @
dccad754
...
...
@@ -84,13 +84,13 @@ getActiveWindow :: !(IOSt .l) -> (!Maybe Id,!IOSt .l)
setActiveControl
::
!
Id
!(
PSt
.
l
)
->
PSt
.
l
getActiveControl
::
!(
IOSt
.
l
)
->
(!(!
Bool
,!
Maybe
Id
),!
IOSt
.
l
)
/* setActiveControl makes the indicated (PopUp/Edit/Custom/Compound)Control the
active
control. This succeeds only if its parent window is already active.
/* setActiveControl makes the indicated (PopUp/Edit/Custom/Compound)Control the
active
control. This succeeds only if its parent window is already active.
getActiveControl returns the Id of the (PopUp/Edit/Custom/Compound)Control that
currently has the input focus.
The Boolean result is True only iff such a control could be found.
Nothing is returned if the control has no Id attribute or if the Boolean
result
is False.
Nothing is returned if the control has no Id attribute or if the Boolean
result
is False.
*/
...
...
@@ -190,18 +190,18 @@ accWindowPicture:: !Id !.(St *Picture .x) !(IOSt .l) -> (!Maybe .x,!IOSt .l)
updateWindow
::
!
Id
!(
Maybe
ViewFrame
)
!(
IOSt
.
l
)
->
IOSt
.
l
/* updateWindow applies the WindowLook attribute function of the indicated window.
The SelectState argument of the Look attribute is the current SelectState of the
window.
The UpdateState argument of the Look attribute is
{oldFrame=frame,newFrame=frame,updArea=[frame]}
where frame depends on the optional ViewFrame argument:
The Look attribute function is applied to the following arguments:
The current SelectState of the window, and
the UpdateState argument
{oldFrame=viewframe,newFrame=viewframe,updArea=[frame]}
where viewframe is the current ViewFrame of the window;
and frame depends on the optional ViewFrame argument:
in case of (Just rectangle):
the intersection of
the current V
iew
F
rame
of the window
and rectangle.
the intersection of
v
iew
f
rame and rectangle.
in case of Nothing:
the current V
iew
F
rame
of the window
.
v
iew
f
rame.
updateWindow has no effect in case of unknown windows, or if the indicated
window is a Dialog, or the window has no WindowLook attribute, or the optional
viewframe argument is empty.
window is a Dialog, or the optional viewframe argument is an empty rectangle.
*/
setWindowLook
::
!
Id
!
Bool
!(!
Bool
,!
Look
)
!(
IOSt
.
l
)
->
IOSt
.
l
...
...
ObjectIO/ObjectIO/StdWindow.icl
View file @
dccad754
...
...
@@ -993,10 +993,11 @@ where
#
(
wH
,
tb
)
=
updatewindow
wMetrics
updInfo
wH
tb
=
({
wsH
&
wshHandle
=
Just
{
wlsH
&
wlsHandle
=
wH
}},
tb
)
where
whSize
=
wH
.
whSize
info
=
getWindowInfoWindowData
wH
.
whWindowInfo
(
origin
,
domainRect
,
hasScrolls
)
=
(
info
.
windowOrigin
,
info
.
windowDomain
,(
isJust
info
.
windowHScroll
,
isJust
info
.
windowVScroll
))
visScrolls
=
OSscrollbarsAreVisible
wMetrics
domainRect
(
toTuple
wH
.
whSize
)
hasScrolls
contentRect
=
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
wH
.
whSize
)
visScrolls
=
OSscrollbarsAreVisible
wMetrics
domainRect
(
toTuple
whSize
)
hasScrolls
contentRect
=
getWindowContentRect
wMetrics
visScrolls
(
SizeToRect
whSize
)
updArea
=
case
maybeViewFrame
of
Nothing
->
contentRect
Just
rect
->
IntersectRects
(
RectangleToRect
(
subVector
(
toVector
origin
)
rect
))
contentRect
...
...
ObjectIO/ObjectIO/windowcontrols.dcl
View file @
dccad754
...
...
@@ -43,4 +43,5 @@ setcontrolpositions :: !OSWindowMetrics ![(Id,ItemPos)] !(WindowStateHandle .pst
->
(!
Bool
,!
WindowStateHandle
.
pst
,
!*
OSToolbox
)
/* setcontrolpositions sets the positions of the indicated controls to their new positions.
The Boolean result is True iff all controls could be found and their new positions are legal.
It is assumed that the argument WindowStateHandle is either a Window or a Dialog.
*/
ObjectIO/ObjectIO/windowcontrols.icl
View file @
dccad754
...
...
@@ -23,7 +23,7 @@ windowcontrolsFatalError function error
// Auxiliary functions:
/* PA: this function is not used anymore.
checkNewWindowSize :: !Size !Size !OSWindowPtr !OSDInfo !*OSToolbox -> *OSToolbox
checkNewWindowSize curSize newSize wPtr osdInfo tb
| curSize==newSize
...
...
@@ -41,7 +41,7 @@ checkNewWindowSize curSize newSize wPtr osdInfo tb
= tb
| otherwise
= OSsetWindowSize wPtr (toTuple newSize) True tb
*/
/* opencontrols adds the given controls to the window.
It is assumed that the new controls do not conflict with the current controls.
...
...
@@ -103,7 +103,7 @@ opencompoundcontrols osdInfo wMetrics compoundId ls newItems wsH=:{wshIds,wshHan
spaces
=
getWindowItemSpaces
whKind
wMetrics
whAtts
reqSize
=
{
w
=
curw
-
fst
hMargins
-
snd
hMargins
,
h
=
curh
-
fst
vMargins
-
snd
vMargins
}
#
(
derSize
,
newItemHs
,
tb
)=
layoutControls
wMetrics
hMargins
vMargins
spaces
reqSize
zero
[(
domain
,
origin
)]
oldItemHs
tb
#
tb
=
checkNewWindowSize
curSize
derSize
wPtr
osdInfo
tb
// PA: curSize might be bigger than domain, then you shouldn't resize!
//
# tb = checkNewWindowSize curSize derSize wPtr osdInfo tb // PA: curSize might be bigger than domain, then you shouldn't resize!
#
(
newItemHs
,
tb
)
=
createCompoundControls
wMetrics
compoundId
nrSkip
whDefaultId
whCancelId
whSelect
wPtr
newItemHs
tb
wH
=
{
wH
&
whItemNrs
=
itemNrs
,
whItems
=
newItemHs
}
#
(
wH
,
tb
)
=
forceValidWindowClipState
wMetrics
True
wPtr
wH
tb
...
...
@@ -337,6 +337,7 @@ closeallcontrols _ _
/* setcontrolpositions changes the position of the indicated controls.
It is assumed that the argument WindowStateHandle is either a Window or a Dialog.
*/
setcontrolpositions
::
!
OSWindowMetrics
![(
Id
,
ItemPos
)]
!(
WindowStateHandle
.
pst
)
!*
OSToolbox
->
(!
Bool
,!
WindowStateHandle
.
pst
,!*
OSToolbox
)
setcontrolpositions
wMetrics
newPoss
wsH
=:{
wshIds
,
wshHandle
=
Just
wlsH
=:{
wlsHandle
=
wH
=:{
whItems
=
oldItems
}}}
tb
...
...
@@ -355,7 +356,8 @@ setcontrolpositions wMetrics newPoss wsH=:{wshIds,wshHandle=Just wlsH=:{wlsHandl
#
(
wH
,
tb
)
=
forceValidWindowClipState
wMetrics
True
wPtr
wH
tb
viewFrame
=
PosSizeToRectangle
origin
{
w
=
curw
,
h
=
curh
}
updState
=
RectangleToUpdateState
viewFrame
#
(
wH
,
tb
)
=
drawwindowlook
wMetrics
wPtr
id
updState
wH
tb
drawbackground
=
if
(
whKind
==
IsDialog
)
(\
x
y
->(
x
,
y
))
(
drawwindowlook
wMetrics
wPtr
id
updState
)
#
(
wH
,
tb
)
=
drawbackground
wH
tb
#
(
updRgn
,
tb
)
=
relayoutControls
wMetrics
whSelect
whShow
wFrame
wFrame
zero
zero
wPtr
whDefaultId
oldItems
wH
.
whItems
tb
#
(
wH
,
tb
)
=
updatewindowbackgrounds
wMetrics
updRgn
wshIds
wH
tb
#
tb
=
OSvalidateWindowRect
wPtr
(
SizeToRect
whSize
)
tb
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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