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

(PA): (1) hiding/showing layout control in window bug fixed.

(2) activate bug of zoomed windows fixed.
parent c468bdfd
......@@ -8,10 +8,10 @@ implementation module StdControl
import StdBool, StdFunc, StdList, StdMisc, StdTuple
import commondef, controlaccess, controlinternal, controlvalidate, id, iostate, StdControlClass, windowaccess, windowcontrols, wstate
from controllayout import layoutControls
from controllayout import calcControlsSize
from receiverid import unbindRIds
from StdPSt import appPIO
from windowclipstate import invalidateWindowClipState`
from windowclipstate import invalidateWindowClipState`, forceValidWindowClipState`
from wstateaccess import iswindowitemspace`, getwindowitemspace`,
iswindowhmargin`, getwindowhmargin`,
iswindowvmargin`, getwindowvmargin`
......@@ -153,7 +153,8 @@ controlSize cdef isWindow hMargins vMargins itemSpaces pState
(Just (hor,vert)) -> (max 0 hor,max 0 vert)
_ -> (wMetrics.osmHorItemSpace,wMetrics.osmVerItemSpace)
domain = {viewDomainRange & corner1=zero}
# (derSize,_,tb) = layoutControls wMetrics hMargins vMargins itemSpaces zero zero [(domain,zero)] itemHs tb
// # (derSize,_,tb) = layoutControls wMetrics hMargins vMargins itemSpaces zero zero [(domain,zero)] itemHs tb
# (derSize,tb) = calcControlsSize wMetrics hMargins vMargins itemSpaces zero zero [(domain,zero)] itemHs tb
# ioState = setIOToolbox tb ioState
# pState = {pState & io=ioState}
= (derSize,pState)
......@@ -451,7 +452,8 @@ hideControl id ioState = hideControls [id] ioState
setControlsShowState` :: !Bool ![Id] !*WState -> *WState
setControlsShowState` show ids wState=:{wIds,wRep,wTb,wMetrics}
# (wH,tb) = setcontrolsshowstate ids show wMetrics wIds wRep wTb
wH = invalidateWindowClipState` wH
// wH = invalidateWindowClipState` wH
# (wH,tb) = forceValidWindowClipState` wMetrics True wIds.wPtr wH tb
= {wState & wRep=wH,wTb=tb}
......
......@@ -94,7 +94,7 @@ getActiveControl:: !(IOSt .l) -> (!(!Bool,!Maybe Id),!IOSt .l)
*/
stackWindow :: !Id !Id !(IOSt .l) -> IOSt .l
stackWindow :: !Id !Id !(PSt .l) -> PSt .l
/* stackWindow id1 id2 places the window with id1 behind the window with id2.
If id1 or id2 is unknown, or id1 indicates a modal window, stackWindow does
nothing.
......
......@@ -210,7 +210,12 @@ setActiveWindow wId pState
activatePtr = if (isSDI && modelessWIDS.wPtr==clientPtr) framePtr modelessWIDS.wPtr // Do not activate SDI client, but SDI frame
showAction = if shown id (snd o OSshowWindow activatePtr True)
# ioState = IOStSetDevice (WindowSystemState {windows & whsWindows=befModals++[lastModal,wsH:others]}) ioState
# ioState = appIOToolbox (showAction o OSstackWindow activatePtr modalWIDS.wPtr) ioState
// # ioState = appIOToolbox (showAction o OSstackWindow activatePtr modalWIDS.wPtr) ioState
# (tb,ioState) = getIOToolbox ioState
# pState = {pState & io=ioState}
# (delayinfo,pState,tb) = OSstackWindow activatePtr modalWIDS.wPtr handleOSEvent pState (showAction tb)
# ioState = setIOToolbox tb pState.io
# ioState = bufferDelayedEvents delayinfo ioState
= {pState & io=ioState}
where
wid = toWID wId
......@@ -220,11 +225,6 @@ where
# (mode,wsH) = getWindowStateHandleWindowMode wsH
= (mode==Modal,wsH)
// handleOSEvent turns handleOneEventForDevices into the form required by OSactivateWindow.
handleOSEvent :: !OSEvent !(!PSt .l,!*OSToolbox) -> (!PSt .l,!*OSToolbox)
handleOSEvent osEvent (pState,tb)
= (thd3 (handleOneEventForDevices (ScheduleOSEvent osEvent []) pState),tb)
/* getActiveWindow returns the Id of the currently active window.
*/
......@@ -374,24 +374,27 @@ where
/* stackWindow changes the stacking order of the current windows.
*/
stackWindow :: !Id !Id !(IOSt .l) -> IOSt .l
stackWindow windowId behindId ioState
PA: previous implementation.
stackWindow :: !Id !Id !(PSt .l) -> PSt .l
stackWindow windowId behindId pState=:{io=ioState}
| windowId==behindId // Don't stack a window behind itself
= ioState
= pState
# (found,wDevice,ioState) = IOStGetDevice WindowDevice ioState
| not found
= ioState
= {pState & io=ioState}
# windows = WindowSystemStateGetWindowHandles wDevice
# (hasBehind,windows) = hasWindowHandlesWindow (toWID behindId) windows
| not hasBehind // Behind window does not exist
= IOStSetDevice (WindowSystemState windows) ioState
# ioState = IOStSetDevice (WindowSystemState windows) ioState
= {pState & io=ioState}
# (hasWindow,wsH,windows) = getWindowHandlesWindow (toWID windowId) windows
| not hasWindow // Stack window does not exist
= IOStSetDevice (WindowSystemState windows) ioState
# ioState = IOStSetDevice (WindowSystemState windows) ioState
= {pState & io=ioState}
# (mode,wsH) = getWindowStateHandleWindowMode wsH
| mode==Modal // Stack window is modal, skip
= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
# ioState = IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
= {pState & io=ioState}
| otherwise
# (_,_,windows) = removeWindowHandlesWindow (toWID windowId) windows // remove placeholder window
# (wids,wsH) = getWindowStateHandleWIDS wsH
......@@ -404,7 +407,8 @@ stackWindow windowId behindId ioState
# (tb,ioState) = getIOToolbox ioState
# (windows,tb) = stackwindows wsH wPtr behindId windows tb
# ioState = setIOToolbox tb ioState
= IOStSetDevice (WindowSystemState windows) ioState
# ioState = IOStSetDevice (WindowSystemState windows) ioState
= {pState & io=ioState}
where
/* stackwindows stackwindow stackptr behindId
places stackwindow behind the window identified by behindId.
......@@ -443,6 +447,50 @@ where
= ([wsH`,wsH:wsHs],OSstackWindow wPtr wids`.wPtr tb)
stackBehind _ _ _ _ _
= StdWindowFatalError "stackBehind" "this alternative should not be reached"
*/
/* PA: new implementation of stackWindow. Uses new windowaccess function, improved OSstackWindow.
*/
stackWindow :: !Id !Id !(PSt .l) -> PSt .l
stackWindow windowId behindId pState=:{io=ioState}
| windowId==behindId // Don't stack a window behind itself
= pState
# (found,wDevice,ioState) = IOStGetDevice WindowDevice ioState
| not found
= {pState & io=ioState}
# windows = WindowSystemStateGetWindowHandles wDevice
# (hasBehind,windows) = hasWindowHandlesWindow behindWID windows
| not hasBehind // Behind window does not exist
# ioState = IOStSetDevice (WindowSystemState windows) ioState
= {pState & io=ioState}
# (hasWindow,wsH,windows) = getWindowHandlesWindow windowWID windows
| not hasWindow // Stack window does not exist
# ioState = IOStSetDevice (WindowSystemState windows) ioState
= {pState & io=ioState}
# (mode,wsH) = getWindowStateHandleWindowMode wsH
| mode==Modal // Stack window is modal, skip
# ioState = IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
= {pState & io=ioState}
| otherwise
# (_,_,windows) = removeWindowHandlesWindow windowWID windows // remove placeholder window
# (wids,wsH) = getWindowStateHandleWIDS wsH
# (behindWIDS,windows) = addBehindWindowHandlesWindow behindWID wsH windows
# ioState = IOStSetDevice (WindowSystemState windows) ioState
# (tb,ioState) = getIOToolbox ioState
# pState = {pState & io=ioState}
# (delayinfo,pState,tb) = OSstackWindow wids.wPtr behindWIDS.wPtr handleOSEvent pState tb
# ioState = setIOToolbox tb pState.io
# ioState = bufferDelayedEvents delayinfo ioState
= {pState & io=ioState}
where
windowWID = toWID windowId
behindWID = toWID behindId
/* handleOSEvent turns handleOneEventForDevices into the form required by OSactivateWindow and OSstackWindow.
(Used by stackWindow, setActiveWindow.)
*/
handleOSEvent :: !OSEvent !(!PSt .l,!*OSToolbox) -> (!PSt .l,!*OSToolbox)
handleOSEvent osEvent (pState,tb)
= (thd3 (handleOneEventForDevices (ScheduleOSEvent osEvent []) pState),tb)
getWindowStack :: !(IOSt .l) -> (![(Id,WindowType)],!IOSt .l)
getWindowStack ioState
......@@ -1315,48 +1363,70 @@ setWindowViewDomain wId newDomain ioState
= IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
setwindowviewdomain :: !OSWindowMetrics !ViewDomain !(WindowStateHandle .pst) !*OSToolbox -> (!WindowStateHandle .pst,!*OSToolbox)
setwindowviewdomain wMetrics domain wsH=:{wshIds,wshHandle=Just wlsH=:{wlsHandle=wH}} tb
# domain = validateViewDomain domain
domainSize = rectangleSize domain
domainRect = RectangleToRect domain
newOrigin = { x = if (w>=domainSize.w) domain.corner1.x (SetBetween oldOrigin.x domain.corner1.x (domain.corner2.x-w))
, y = if (h>=domainSize.h) domain.corner1.y (SetBetween oldOrigin.y domain.corner1.y (domain.corner2.y-h))
setwindowviewdomain wMetrics newDomain wsH=:{wshIds,wshHandle=Just wlsH=:{wlsHandle=wH}} tb
# newDomain = validateViewDomain newDomain
newDomainSize = rectangleSize newDomain
newDomainRect = RectangleToRect newDomain
newOrigin = { x = if (w>=newDomainSize.w) newDomainRect.rleft (SetBetween oldOrigin.x newDomainRect.rleft (newDomainRect.rright -w))
, y = if (h>=newDomainSize.h) newDomainRect.rtop (SetBetween oldOrigin.y newDomainRect.rtop (newDomainRect.rbottom-h))
}
visScrolls = OSscrollbarsAreVisible wMetrics domainRect (toTuple wSize) (hasHScroll,hasVScroll)
wFrame = getWindowContentRect wMetrics visScrolls (SizeToRect wSize)
{rright=w`,rbottom=h`}= wFrame
osHState = toOSscrollbarRange (domain.corner1.x,newOrigin.x,domain.corner2.x) w`
osVState = toOSscrollbarRange (domain.corner1.y,newOrigin.y,domain.corner2.y) h`
# tb = setwindowslider hasHScroll wMetrics wPtr True osHState (toTuple wSize) tb
# tb = setwindowslider hasVScroll wMetrics wPtr False osVState (toTuple wSize) tb
windowInfo = WindowInfo {windowInfo & windowDomain=domainRect,windowOrigin=newOrigin}
hMargins = getWindowHMargins IsWindow wMetrics atts
vMargins = getWindowVMargins IsWindow wMetrics atts
spaces = getWindowItemSpaces IsWindow wMetrics atts
reqSize = {w=w`-fst hMargins-snd hMargins,h=h`-fst vMargins-snd vMargins}
# (_,newItems,tb) = layoutControls wMetrics hMargins vMargins spaces reqSize minSize [(domain,newOrigin)] oldItems tb
wH = {wH & whWindowInfo=windowInfo,whItems=newItems}
# (wH,tb) = forceValidWindowClipState wMetrics True wPtr wH tb
# (updRgn,tb) = relayoutControls wMetrics whSelect whShow wFrame wFrame zero zero wPtr whDefaultId oldItems wH.whItems tb
viewFrame = PosSizeToRectangle newOrigin {w=w`,h=h`}
updState = RectangleToUpdateState viewFrame
# (wH,tb) = drawwindowlook wMetrics wPtr id updState wH tb
# (wH,tb) = updatewindowbackgrounds wMetrics updRgn wshIds wH tb
# tb = OSvalidateWindowRect wPtr (SizeToRect wSize) tb
= ({wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
newVisScrolls = OSscrollbarsAreVisible wMetrics newDomainRect wSize` hasScrolls
newContentRect = getWindowContentRect wMetrics newVisScrolls (SizeToRect wSize)
{rright=w`,rbottom=h`}= newContentRect
osHState = toOSscrollbarRange (newDomainRect.rleft,newOrigin.x,newDomainRect.rright) w`
osVState = toOSscrollbarRange (newDomainRect.rtop, newOrigin.y,newDomainRect.rbottom) h`
# tb = setwindowslider hasHScroll wMetrics wPtr True osHState wSize` tb
# tb = setwindowslider hasVScroll wMetrics wPtr False osVState wSize` tb
windowInfo = WindowInfo {windowInfo & windowDomain=newDomainRect,windowOrigin=newOrigin}
newViewFrameRect = PosSizeToRect newOrigin {w=w`,h=h`}
newViewFrame = RectToRectangle newViewFrameRect
oldViewFrame = RectToRectangle oldViewFrameRect
oldDomainViewMax = getdomainviewmax oldDomainRect oldViewFrameRect
newDomainViewMax = getdomainviewmax newDomainRect newViewFrameRect
updArea = if (sysLook && oldOrigin==newOrigin && oldDomainViewMax==newDomainViewMax)
[]
[newViewFrame]
updState = {oldFrame=oldViewFrame,newFrame=newViewFrame,updArea=updArea}
| isEmpty oldItems // window has no controls
# wH = {wH & whWindowInfo=windowInfo}
// # tb = OSvalidateWindowRect wPtr (SizeToRect wSize) tb
| isEmpty updArea // nothing has to updated
= ({wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
// otherwise
# (wH,tb) = drawwindowlook wMetrics wPtr id updState wH tb
= ({wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
| otherwise // window has controls
# hMargins = getWindowHMargins IsWindow wMetrics atts
vMargins = getWindowVMargins IsWindow wMetrics atts
spaces = getWindowItemSpaces IsWindow wMetrics atts
reqSize = {w=w`-fst hMargins-snd hMargins,h=h`-fst vMargins-snd vMargins}
# (_,newItems,tb) = layoutControls wMetrics hMargins vMargins spaces reqSize minSize [(newDomain,newOrigin)] oldItems tb
wH = {wH & whWindowInfo=windowInfo,whItems=newItems}
# (wH,tb) = forceValidWindowClipState wMetrics True wPtr wH tb
# (updRgn,tb) = relayoutControls wMetrics whSelect whShow newContentRect newContentRect zero zero wPtr whDefaultId oldItems wH.whItems tb
# (wH,tb) = drawwindowlook wMetrics wPtr id updState wH tb
# (wH,tb) = updatewindowbackgrounds wMetrics updRgn wshIds wH tb
// # tb = OSvalidateWindowRect wPtr (SizeToRect wSize) tb
= ({wsH & wshHandle=Just {wlsH & wlsHandle=wH}},tb)
where
wPtr = wshIds.wPtr
atts = wH.whAtts
wSize = wH.whSize
(w,h) = toTuple wSize
wSize` = toTuple wSize
(w,h) = wSize`
whSelect = wH.whSelect
whShow = wH.whShow
whDefaultId = wH.whDefaultId
// windowInfo = fromJust wH.whWindowInfo Mike: fromJust changed to getWindowInfoWindowData
windowInfo = getWindowInfoWindowData wH.whWindowInfo
oldDomainRect = windowInfo.windowDomain
oldOrigin = windowInfo.windowOrigin
sysLook = windowInfo.windowLook.lookSysUpdate
oldItems = wH.whItems
(hasHScroll,hasVScroll) = (isJust windowInfo.windowHScroll,isJust windowInfo.windowVScroll)
hasScrolls = (isJust windowInfo.windowHScroll,isJust windowInfo.windowVScroll)
(hasHScroll,hasVScroll) = hasScrolls
oldVisScrolls = OSscrollbarsAreVisible wMetrics oldDomainRect wSize` hasScrolls
oldContentRect = getWindowContentRect wMetrics oldVisScrolls (SizeToRect wSize)
oldViewFrameRect = PosSizeToRect oldOrigin (RectSize oldContentRect)
(defMinW,defMinH) = OSMinWindowSize
minSize = {w=defMinW,h=defMinH}
......@@ -1364,6 +1434,10 @@ where
setwindowslider hasScroll wMetrics wPtr isHorizontal state maxcoords tb
| hasScroll = OSsetWindowSlider wMetrics wPtr isHorizontal state maxcoords tb
| otherwise = tb
getdomainviewmax :: !Rect !Rect -> Point2
getdomainviewmax domainRect viewframeRect
= {x=min domainRect.rright viewframeRect.rright,y=min domainRect.rbottom viewframeRect.rbottom}
setwindowviewdomain _ _ _ _
= StdWindowFatalError "setWindowViewDomain" "unexpected window placeholder argument"
......
......@@ -16,7 +16,7 @@ from controllayout import layoutControls`
from controlrelayout import relayoutControls`
from controlvalidate import validateControlTitle, validateSliderState
from windowaccess import identifyMaybeId, getWItemPopUpInfo, getWindowInfoWindowData, getCompoundContentRect, getWindowContentRect
from windowclipstate import validateCompoundClipState`, forceValidCompoundClipState`
from windowclipstate import validateCompoundClipState`, forceValidCompoundClipState`, invalidateCompoundClipState`
from windowupdate import updatewindowbackgrounds`
from windowvalidate import validateViewDomain
......@@ -298,70 +298,57 @@ where
*/
setcontrolsshowstate :: ![Id] !Bool !OSWindowMetrics !WIDS !WindowHandle` !*OSToolbox -> (!WindowHandle`,!*OSToolbox)
setcontrolsshowstate ids itemsShow wMetrics wids=:{wPtr} wH=:{whItems`,whSelect`,whSize`,whWindowInfo`} tb
# (itemHs,(_,(updRect,tb)))
= setWElements (setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect) whItems` (ids,(zero,tb))
wH = {wH & whItems`=itemHs}
# tb = OSinvalidateWindowRect wPtr updRect tb
= (wH,tb)
# (itemHs,(_,tb)) = setWElements (setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect) whItems` (ids,tb)
= ({wH & whItems`=itemHs},tb)
where
clipRect = getContentRect wMetrics whWindowInfo` whSize`
overrule = False
contextShow = True
contextSelect = if whSelect` Able Unable
unionRect :: !Rect !Rect -> Rect
unionRect r1 r2
| IsEmptyRect r1 = r2
| IsEmptyRect r2 = r1
| otherwise = {rleft=min r1.rleft r2.rleft,rtop=min r1.rtop r2.rtop,rright=max r1.rright r2.rright,rbottom=max r1.rbottom r2.rbottom}
clipRect = getContentRect wMetrics whWindowInfo` whSize`
overrule = False
contextShow = True
contextSelect = if whSelect` Able Unable
setWItemShowStates :: !OSWindowMetrics !OSWindowPtr !Bool !Bool !Bool !SelectState !Rect !WItemHandle` !(![Id],(!Rect,!*OSToolbox))
-> (!WItemHandle`,!(![Id],(!Rect,!*OSToolbox)))
setWItemShowStates :: !OSWindowMetrics !OSWindowPtr !Bool !Bool !Bool !SelectState !Rect !WItemHandle` !(![Id],!*OSToolbox)
-> (!WItemHandle`,!(![Id],!*OSToolbox))
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`=IsRadioControl} (ids,updRect_tb)
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`=IsRadioControl} (ids,tb)
# (found,ids) = maybeRemoveCheck itemH.wItemId` ids
| not found && not overrule
= (itemH,(ids,updRect_tb))
= (itemH,(ids,tb))
| otherwise
# osShow = if overrule contextShow (contextShow && itemsShow)
itemH = if found {itemH & wItemShow`=itemsShow} itemH
info = getWItemRadioInfo` itemH.wItemInfo`
# updRect_tb = StateMap2 (setradio osShow clipRect) info.radioItems` updRect_tb
= (itemH,(ids,updRect_tb))
# tb = StateMap2 (setradio osShow clipRect) info.radioItems` tb
= (itemH,(ids,tb))
where
setradio :: !Bool !Rect !RadioItemInfo` !(!Rect,!*OSToolbox) -> (!Rect,!*OSToolbox)
setradio osShow clipRect {radioItemPtr`,radioItemPos`,radioItemSize`} (updRect,tb)
# tb = OSsetRadioControlShow wPtr radioItemPtr` clipRect osShow tb
= (unionRect updRect (PosSizeToRect radioItemPos` radioItemSize`),tb)
setradio :: !Bool !Rect !RadioItemInfo` !*OSToolbox -> *OSToolbox
setradio osShow clipRect {radioItemPtr`,radioItemPos`,radioItemSize`} tb
= OSsetRadioControlShow wPtr radioItemPtr` clipRect osShow tb
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`=IsCheckControl} (ids,updRect_tb)
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`=IsCheckControl} (ids,tb)
# (found,ids) = maybeRemoveCheck itemH.wItemId` ids
| not found && not overrule
= (itemH,(ids,updRect_tb))
= (itemH,(ids,tb))
| otherwise
# osShow = if overrule contextShow (contextShow && itemsShow)
itemH = if found {itemH & wItemShow`=itemsShow} itemH
info = getWItemCheckInfo` itemH.wItemInfo`
# updRect_tb = StateMap2 (setcheck osShow clipRect) info.checkItems` updRect_tb
= (itemH,(ids,updRect_tb))
# tb = StateMap2 (setcheck osShow clipRect) info.checkItems` tb
= (itemH,(ids,tb))
where
setcheck :: !Bool !Rect !CheckItemInfo` !(!Rect,!*OSToolbox) -> (!Rect,!*OSToolbox)
setcheck osShow clipRect {checkItemPtr`,checkItemPos`,checkItemSize`} (updRect,tb)
# tb = OSsetRadioControlShow wPtr checkItemPtr` clipRect osShow tb
= (unionRect updRect (PosSizeToRect checkItemPos` checkItemSize`),tb)
setcheck :: !Bool !Rect !CheckItemInfo` !*OSToolbox -> *OSToolbox
setcheck osShow clipRect {checkItemPtr`,checkItemPos`,checkItemSize`} tb
= OSsetRadioControlShow wPtr checkItemPtr` clipRect osShow tb
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`} (ids,updRect_tb)
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`} (ids,tb)
| osControl
# (found,ids) = maybeRemoveCheck itemH.wItemId` ids
| not found && not overrule
= (itemH,(ids,updRect_tb))
= (itemH,(ids,tb))
// otherwise
# osShow = if overrule contextShow (contextShow && itemsShow)
itemH = if found {itemH & wItemShow`=itemsShow} itemH
# (updRect,tb) = updRect_tb
# tb = osAction wPtr itemH.wItemPtr` clipRect osShow tb
# updRect = unionRect (PosSizeToRect itemH.wItemPos` itemH.wItemSize`) updRect
= (itemH,(ids,(updRect,tb)))
= (itemH,(ids,tb))
where
(osControl,osAction) = case wItemKind` of
IsPopUpControl -> (True,OSsetPopUpControlShow)
......@@ -371,20 +358,18 @@ where
IsButtonControl -> (True,OSsetButtonControlShow)
_ -> (False,undef)
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`} (ids,updRect_tb)
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`} (ids,tb)
| isCustom
# (found,ids) = maybeRemoveCheck itemH.wItemId` ids
| not found && not overrule
= (itemH,(ids,updRect_tb))
= (itemH,(ids,tb))
// otherwise
# osShow = if overrule contextShow (contextShow && itemsShow)
itemH = if found {itemH & wItemShow`=itemsShow} itemH
customDraw = if osShow customDraw (\_ _ _ itemH tb -> (itemH,tb))
# (updRect,tb) = updRect_tb
# tb = osAction wPtr itemH.wItemPtr` clipRect osShow tb
# (itemH,tb) = customDraw itemH.wItemSelect` wPtr clipRect itemH tb
# updRect = unionRect (PosSizeToRect itemH.wItemPos` itemH.wItemSize`) updRect
= (itemH,(ids,(updRect,tb)))
= (itemH,(ids,tb))
where
(isCustom,customDraw,osAction)
= case wItemKind` of
......@@ -392,44 +377,42 @@ where
IsCustomControl -> (True,drawCustomLook`, OSsetCustomControlShow)
_ -> (False,undef,undef)
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`=IsCompoundControl} (ids,updRect_tb)
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`=IsCompoundControl} (ids,tb)
# (found,ids) = maybeRemoveCheck itemH.wItemId` ids
contextShow1 = contextShow && (if found itemsShow itemH.wItemShow`)
overrule1 = overrule || found && itemH.wItemShow`<>itemsShow
# (itemHs,(ids,updRect_tb))
= setAllWElements (setWItemShowStates wMetrics wPtr overrule1 itemsShow contextShow1 contextSelect1 clipRect1) itemH.wItems` (ids,updRect_tb)
# (itemHs,(ids,tb)) = setAllWElements (setWItemShowStates wMetrics wPtr overrule1 itemsShow contextShow1 contextSelect1 clipRect1) itemH.wItems` (ids,tb)
// PA: setAllWElements was setWElements
itemH = {itemH & wItems`=itemHs}
| not found && not overrule
= (itemH,(ids,updRect_tb))
= (itemH,(ids,tb))
| otherwise
# itemH = if found {itemH & wItemShow`=itemsShow} itemH
# (updRect,tb) = updRect_tb
# tb = OSsetCompoundShow wPtr itemH.wItemPtr` clipRect itemsShow tb
= (itemH,(ids,(updRect,tb)))
# itemH = invalidateCompoundClipState` itemH // PA: added
= (itemH,(ids,tb))
where
contextSelect1 = if (enabled contextSelect) (if itemH.wItemSelect` Able Unable) contextSelect
info = getWItemCompoundInfo` itemH.wItemInfo`
itemSize = itemH.wItemSize`
clipRect1 = intersectRectContent wMetrics clipRect info itemH.wItemPos` itemSize
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`=IsLayoutControl} (ids,updRect_tb)
setWItemShowStates wMetrics wPtr overrule itemsShow contextShow contextSelect clipRect itemH=:{wItemKind`=IsLayoutControl} (ids,tb)
# (found,ids) = maybeRemoveCheck itemH.wItemId` ids
contextShow1 = contextShow && (if found itemsShow itemShow)
overrule1 = overrule || found && itemShow<>itemsShow
# (itemHs,(ids,updRect_tb))
= setAllWElements (setWItemShowStates wMetrics wPtr overrule1 itemsShow contextShow1 contextSelect1 clipRect1) itemH.wItems` (ids,updRect_tb)
# (itemHs,(ids,tb)) = setAllWElements (setWItemShowStates wMetrics wPtr overrule1 itemsShow contextShow1 contextSelect1 clipRect1) itemH.wItems` (ids,tb)
// PA: setAllWElements was setWElements
itemH = {itemH & wItemShow`=if found itemsShow itemShow,wItems`=itemHs}
= (itemH,(ids,updRect_tb))
= (itemH,(ids,tb))
where
itemShow = itemH.wItemShow`
contextSelect1 = if (enabled contextSelect) (if itemH.wItemSelect` Able Unable) contextSelect
clipRect1 = clipRect//IntersectRects clipRect (PosSizeToRect itemH.wItemPos` itemH.wItemSize`)
setWItemShowStates _ _ _ _ _ _ _ itemH=:{wItemKind`=IsOtherControl _} (ids,updRect_tb)
setWItemShowStates _ _ _ _ _ _ _ itemH=:{wItemKind`=IsOtherControl _} (ids,tb)
# (_,ids) = maybeRemoveCheck itemH.wItemId` ids
= (itemH,(ids,updRect_tb))
= (itemH,(ids,tb))
// Set the MarkState of the controls and provide proper feedback.
......@@ -934,7 +917,8 @@ where
= OScreateEmptyPopUpControl wPtr (0,0) itemH.wItemShow ableContext
(toTuple popUpPos) (toTuple popUpSize) (length newItems) isEditable tb
# (_,tb) = StateMap2 (appendPopUp newPopUpPtr newIndex) newItems (1,tb)
# tb = OSstackWindow newPopUpPtr popUpPtr tb
// # tb = OSstackWindow newPopUpPtr popUpPtr tb
# (_,_,tb) = OSstackWindow newPopUpPtr popUpPtr K` 0 tb // PA: for control delayinfo can be ignored
# tb = OSdestroyPopUpControl popUpPtr tb
newPopUpInfo = { popUpInfoItems = newItems
, popUpInfoIndex = newIndex
......@@ -1021,7 +1005,8 @@ where
= OScreateEmptyPopUpControl wPtr (0,0) itemH.wItemShow ableContext
(toTuple popUpPos) (toTuple popUpSize) (length newItems) isEditable tb
# (_,tb) = StateMap2 (appendPopUp newPopUpPtr newIndex) newItems (1,tb)
# tb = OSstackWindow newPopUpPtr popUpPtr tb
// # tb = OSstackWindow newPopUpPtr popUpPtr tb
# (_,_,tb) = OSstackWindow newPopUpPtr popUpPtr K` 0 tb // PA: for control delayinfo can be ignored
# tb = OSdestroyPopUpControl popUpPtr tb
newPopUpInfo = { popUpInfoItems = newItems
, popUpInfoIndex = newIndex
......@@ -1263,26 +1248,34 @@ where
= (done,{itemH & wItems`=itemHs},updRgn_tb)
| newDomain==oldDomain
= (True,itemH,updRgn_tb)
# (updRgn,tb) = updRgn_tb
# (minx,maxx,viewx) = (newDomainRect.rleft,newDomainRect.rright, newContentSize.w)
(miny,maxy,viewy) = (newDomainRect.rtop, newDomainRect.rbottom,newContentSize.h)
newOrigin = {x=SetBetween oldOrigin.x minx (max minx (maxx-viewx)),y=SetBetween oldOrigin.y miny (max miny (maxy-viewy))}
# tb = setsliderthumb hasHScroll miOSMetrics itemPtr True (minx,newOrigin.x,maxx) viewx itemSize` tb
# tb = setsliderthumb hasVScroll miOSMetrics itemPtr False (miny,newOrigin.y,maxy) viewy itemSize` tb
oldItems` = itemH.wItems`
orientation` = [(newDomain,newOrigin):miOrientation]
# (_,newItems`,tb) = layoutControls` miOSMetrics hMargins` vMargins` spaces` itemSize itemSize orientation` oldItems` tb
newItems` = shiftControls` (toVector itemPos) newItems`
info = {info & compoundOrigin=newOrigin,compoundDomain=newDomainRect}
itemH = {itemH & wItems`=newItems`,wItemInfo`=CompoundInfo` info}
# tb = case updRgn of
Just rgn -> osdisposergn rgn tb
nothing -> tb
# (itemH, tb) = forceValidCompoundClipState` miOSMetrics True wPtr defaultId shownContext itemH tb
# (updRgn,tb) = relayoutControls` miOSMetrics ableContext1 shownContext1 newContentRect newContentRect itemPos itemPos itemPtr defaultId
oldItems` itemH.wItems` tb
# (updRgn,tb) = updRgn_tb
# (minx,maxx,viewx) = (newDomainRect.rleft,newDomainRect.rright, newContentSize.w)
(miny,maxy,viewy) = (newDomainRect.rtop, newDomainRect.rbottom,newContentSize.h)
newOrigin = {x=SetBetween oldOrigin.x minx (max minx (maxx-viewx)),y=SetBetween oldOrigin.y miny (max miny (maxy-viewy))}
info = {info & compoundOrigin=newOrigin,compoundDomain=newDomainRect}
# tb = setsliderthumb hasHScroll miOSMetrics itemPtr True (minx,newOrigin.x,maxx) viewx itemSize` tb
# tb = setsliderthumb hasVScroll miOSMetrics itemPtr False (miny,newOrigin.y,maxy) viewy itemSize` tb
oldItems` = itemH.wItems`
| isEmpty oldItems` // CompoundControl has no controls
# itemH = {itemH & wItemInfo`=CompoundInfo` info}
| shownContext1
# (itemH,tb) = drawCompoundLook` miOSMetrics ableContext1 wPtr (IntersectRects newContentRect clipRect) itemH tb
= (True,itemH,(updRgn,tb))
// otherwise
= (True,itemH,(updRgn,tb))
// CompoundControl has controls
# orientation` = [(newDomain,newOrigin):miOrientation]
# (_,newItems`,tb) = layoutControls` miOSMetrics hMargins` vMargins` spaces` itemSize itemSize orientation` oldItems` tb
newItems` = shiftControls` (toVector itemPos) newItems`
itemH = {itemH & wItems`=newItems`,wItemInfo`=CompoundInfo` info}
# tb = case updRgn of
Just rgn -> osdisposergn rgn tb
nothing -> tb
# (itemH, tb) = forceValidCompoundClipState` miOSMetrics True wPtr defaultId shownContext itemH tb
# (updRgn,tb) = relayoutControls` miOSMetrics ableContext1 shownContext1 newContentRect newContentRect itemPos itemPos itemPtr defaultId
oldItems` itemH.wItems` tb
| shownContext1
# (itemH,tb) = drawCompoundLook` miOSMetrics ableContext1 wPtr (IntersectRects newContentRect clipRect) itemH tb
# (itemH