Skip to content

GitLab

Commit dccad754 authored by Peter Achten's avatar Peter Achten
Browse files

(PA) Bug fix in setControlPos; 

function updateControl added (StdControl)
parent 47644197
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 StdPicture import Picture, Point2
from StdIOCommon import Size, Rectangle, IdFun, UpdateState, ViewFrame, UpdateArea
from StdIOCommon import UpdateState, ViewFrame, UpdateArea
from StdIOBasic 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, . = invalid)
/* (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 ViewFrame of the window and rectangle.
the intersection of viewframe and rectangle.
in case of Nothing:
the current ViewFrame of the window.
viewframe.
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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment