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

(PA) bug fixes wrt window activation/scrolling

parent d8ca2bf2
...@@ -566,7 +566,7 @@ where ...@@ -566,7 +566,7 @@ where
moveControlViewFrame` :: !Id Vector2 !*WState -> *WState moveControlViewFrame` :: !Id Vector2 !*WState -> *WState
moveControlViewFrame` id v wState=:{wIds,wRep,wTb,wMetrics} moveControlViewFrame` id v wState=:{wIds,wRep,wTb,wMetrics}
# (wH,tb) = movecontrolviewframe id v wMetrics wIds wRep wTb # (wH,tb) = movecontrolviewframe id v wMetrics wIds wRep wTb
wH = invalidateWindowClipState` wH // wH = invalidateWindowClipState` wH PA: seems to me that this is a bit exagerated
= {wState & wRep=wH,wTb=tb} = {wState & wRep=wH,wTb=tb}
......
...@@ -10,7 +10,7 @@ import StdControlClass ...@@ -10,7 +10,7 @@ import StdControlClass
from StdId import getParentId from StdId import getParentId
from StdPSt import appPIO, accPIO from StdPSt import appPIO, accPIO
from StdSystem import maxScrollWindowSize from StdSystem import maxScrollWindowSize
import commondef, controlpos, iostate, windowaccess, windowcreate, windowdevice, windowhandle, windowupdate, wstate import commondef, controlpos, iostate, scheduler, windowaccess, windowcreate, windowdevice, windowhandle, windowupdate, wstate
from controlinternal import enablecontrols, disablecontrols from controlinternal import enablecontrols, disablecontrols
from controllayout import layoutControls from controllayout import layoutControls
from controlrelayout import relayoutControls from controlrelayout import relayoutControls
...@@ -180,7 +180,7 @@ setActiveWindow wId pState ...@@ -180,7 +180,7 @@ setActiveWindow wId pState
# wHs = windows.whsWindows # wHs = windows.whsWindows
(modal,modeless) = Uspan ismodalwindow wHs (modal,modeless) = Uspan ismodalwindow wHs
(isModal,modal) = UContains (identifyWindowStateHandle wid) modal (isModal,modal) = UContains (identifyWindowStateHandle wid) modal
| isModal // Modal windows should be activated | isModal // Modal windows should not be activated
= {pState & io=IOStSetDevice (WindowSystemState {windows & whsWindows=modal++modeless}) ioState} = {pState & io=IOStSetDevice (WindowSystemState {windows & whsWindows=modal++modeless}) ioState}
# (osdInfo,ioState) = IOStGetOSDInfo ioState # (osdInfo,ioState) = IOStGetOSDInfo ioState
isSDI = getOSDInfoDocumentInterface osdInfo==SDI isSDI = getOSDInfoDocumentInterface osdInfo==SDI
...@@ -194,7 +194,11 @@ setActiveWindow wId pState ...@@ -194,7 +194,11 @@ setActiveWindow wId pState
activatePtr = if (isSDI && wids.wPtr==clientPtr) framePtr wids.wPtr // Do not activate SDI client, but SDI frame activatePtr = if (isSDI && wids.wPtr==clientPtr) framePtr wids.wPtr // Do not activate SDI client, but SDI frame
showAction = if shown id (snd o OSshowWindow activatePtr True) showAction = if shown id (snd o OSshowWindow activatePtr True)
# ioState = IOStSetDevice (WindowSystemState {windows & whsWindows=[wsH:others]}) ioState # ioState = IOStSetDevice (WindowSystemState {windows & whsWindows=[wsH:others]}) ioState
# (delayinfo,ioState) = accIOToolbox (OSactivateWindow osdInfo activatePtr o showAction) ioState // # (delayinfo,ioState) = accIOToolbox (OSactivateWindow osdInfo activatePtr o showAction) ioState
# (tb,ioState) = getIOToolbox ioState
# pState = {pState & io=ioState}
# (delayinfo,pState,tb) = OSactivateWindow osdInfo activatePtr handleOSEvent pState (showAction tb)
# ioState = setIOToolbox tb pState.io
# ioState = bufferDelayedEvents delayinfo ioState # ioState = bufferDelayedEvents delayinfo ioState
= {pState & io=ioState} = {pState & io=ioState}
| otherwise // There are modal windows, so put activated window behind last modal | otherwise // There are modal windows, so put activated window behind last modal
...@@ -216,6 +220,12 @@ where ...@@ -216,6 +220,12 @@ where
# (mode,wsH) = getWindowStateHandleWindowMode wsH # (mode,wsH) = getWindowStateHandleWindowMode wsH
= (mode==Modal,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. /* getActiveWindow returns the Id of the currently active window.
*/ */
getActiveWindow :: !(IOSt .l) -> (!Maybe Id, !IOSt .l) getActiveWindow :: !(IOSt .l) -> (!Maybe Id, !IOSt .l)
......
...@@ -1160,21 +1160,27 @@ where ...@@ -1160,21 +1160,27 @@ where
= (done,{itemH & wItems`=itemHs},updRgn_tb) = (done,{itemH & wItems`=itemHs},updRgn_tb)
| newOrigin==oldOrigin | newOrigin==oldOrigin
= (True,itemH,updRgn_tb) = (True,itemH,updRgn_tb)
# (updRgn,tb) = updRgn_tb
# tb = setsliderthumb hasHScroll miOSMetrics itemPtr True (minx,newOrigin.x,maxx) viewx (toTuple itemSize) tb
# tb = setsliderthumb hasVScroll miOSMetrics itemPtr False (miny,newOrigin.y,maxy) viewy (toTuple itemSize) tb
info = {info & compoundOrigin=newOrigin}
clipRect1 = IntersectRects contentRect clipRect
| isEmpty itemH.wItems`
# itemH = {itemH & wItemInfo`=CompoundInfo` info}
# (itemH,tb) = drawCompoundLook` miOSMetrics ableContext1 wPtr clipRect1 itemH tb
= (True,itemH,(updRgn,tb))
| otherwise | otherwise
# (updRgn,tb) = updRgn_tb # oldItems` = itemH.wItems`
# tb = setsliderthumb hasHScroll miOSMetrics itemPtr True (minx,newOrigin.x,maxx) viewx (toTuple itemSize) tb
# tb = setsliderthumb hasVScroll miOSMetrics itemPtr False (miny,newOrigin.y,maxy) viewy (toTuple itemSize) tb
oldItems` = itemH.wItems`
orientation` = [(domain,newOrigin):miOrientation] orientation` = [(domain,newOrigin):miOrientation]
# (_,newItems`,tb) = layoutControls` miOSMetrics hMargins` vMargins` spaces` itemSize itemSize orientation` oldItems` tb # (_,newItems`,tb) = layoutControls` miOSMetrics hMargins` vMargins` spaces` itemSize itemSize orientation` oldItems` tb
newItems` = shiftControls` (toVector itemPos) newItems` newItems` = shiftControls` (toVector itemPos) newItems`
info = {info & compoundOrigin=newOrigin}
itemH = {itemH & wItems`=newItems`,wItemInfo`=CompoundInfo` info} itemH = {itemH & wItems`=newItems`,wItemInfo`=CompoundInfo` info}
# tb = case updRgn of # tb = case updRgn of
Just rgn -> osdisposergn rgn tb Just rgn -> osdisposergn rgn tb
nothing -> tb nothing -> tb
# (itemH, tb) = forceValidCompoundClipState` miOSMetrics True wPtr defaultId shownContext itemH tb # (itemH, tb) = forceValidCompoundClipState` miOSMetrics True wPtr defaultId shownContext itemH tb
# (updRgn,tb) = relayoutControls` miOSMetrics ableContext1 shownContext1 contentRect contentRect itemPos itemPos itemPtr defaultId oldItems` itemH.wItems` tb # (updRgn,tb) = relayoutControls` miOSMetrics ableContext1 shownContext1 contentRect contentRect itemPos itemPos itemPtr defaultId oldItems` itemH.wItems` tb
# (itemH, tb) = drawCompoundLook` miOSMetrics ableContext1 wPtr clipRect1 itemH tb
= (True,itemH,(Just updRgn,tb)) = (True,itemH,(Just updRgn,tb))
where where
info = getWItemCompoundInfo` itemH.wItemInfo` info = getWItemCompoundInfo` itemH.wItemInfo`
...@@ -1257,26 +1263,28 @@ where ...@@ -1257,26 +1263,28 @@ where
= (done,{itemH & wItems`=itemHs},updRgn_tb) = (done,{itemH & wItems`=itemHs},updRgn_tb)
| newDomain==oldDomain | newDomain==oldDomain
= (True,itemH,updRgn_tb) = (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
| shownContext1
# (itemH,tb) = drawCompoundLook` miOSMetrics ableContext1 wPtr (IntersectRects newContentRect clipRect) itemH tb
= (True,itemH,(Just updRgn,tb))
| otherwise | otherwise
# (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
# (itemH,tb) = drawCompoundLook` miOSMetrics ableContext1 wPtr (IntersectRects newContentRect clipRect) itemH tb
= (True,itemH,(Just updRgn,tb)) = (True,itemH,(Just updRgn,tb))
where where
info = getWItemCompoundInfo` itemH.wItemInfo` info = getWItemCompoundInfo` itemH.wItemInfo`
......
...@@ -396,12 +396,6 @@ where ...@@ -396,12 +396,6 @@ where
visVScroll = hasVScroll && OSscrollbarIsVisible (domainRect.rtop, domainRect.rbottom) h visVScroll = hasVScroll && OSscrollbarIsVisible (domainRect.rtop, domainRect.rbottom) h
(w`,h`) = (w+wMetrics.osmVSliderWidth,h+wMetrics.osmHSliderHeight) (w`,h`) = (w+wMetrics.osmVSliderWidth,h+wMetrics.osmHSliderHeight)
validateControlMargin :: !(!Int,!Int) -> (!Int,!Int)
validateControlMargin (a,b) = (max 0 a,max 0 b)
validateControlItemSpace :: !(!Int,!Int) -> (!Int,!Int)
validateControlItemSpace (hspace,vspace) = (max 0 hspace,max 0 vspace)
layoutScrollbars :: !OSWindowMetrics !Size !CompoundInfo -> CompoundInfo layoutScrollbars :: !OSWindowMetrics !Size !CompoundInfo -> CompoundInfo
layoutScrollbars wMetrics size info=:{compoundHScroll,compoundVScroll} layoutScrollbars wMetrics size info=:{compoundHScroll,compoundVScroll}
= { info & compoundHScroll=layoutScrollbar hRect compoundHScroll = { info & compoundHScroll=layoutScrollbar hRect compoundHScroll
...@@ -474,12 +468,6 @@ where ...@@ -474,12 +468,6 @@ where
validateDerivedSize wMetrics derSize reqSize validateDerivedSize wMetrics derSize reqSize
| reqSize==zero = derSize | reqSize==zero = derSize
| otherwise = reqSize | otherwise = reqSize
validateControlMargin :: !(!Int,!Int) -> (!Int,!Int)
validateControlMargin (a,b) = (max 0 a,max 0 b)
validateControlItemSpace :: !(!Int,!Int) -> (!Int,!Int)
validateControlItemSpace (hspace,vspace) = (max 0 hspace,max 0 vspace)
getLayoutWItem _ _ _ _ _ _ _ _ _ _ getLayoutWItem _ _ _ _ _ _ _ _ _ _
= controllayoutFatalError "getLayoutWItem" "unmatched control implementation alternative" = controllayoutFatalError "getLayoutWItem" "unmatched control implementation alternative"
...@@ -517,7 +505,7 @@ getLayoutItems` wMetrics hMargins vMargins spaces orientations prevIds prevId cI ...@@ -517,7 +505,7 @@ getLayoutItems` wMetrics hMargins vMargins spaces orientations prevIds prevId cI
where where
getLayoutItem` :: !OSWindowMetrics !(!Int,!Int) !(!Int,!Int) !(!Int,!Int) ![(ViewDomain,Origin)] getLayoutItem` :: !OSWindowMetrics !(!Int,!Int) !(!Int,!Int) !(!Int,!Int) ![(ViewDomain,Origin)]
[Id] Id !Int !WElementHandle` !*OSToolbox [Id] Id !Int !WElementHandle` !*OSToolbox
-> (![LayoutItem],[Id],Id,!Int,!WElementHandle`,!*OSToolbox) -> (![LayoutItem],[Id],Id,!Int,!WElementHandle`,!*OSToolbox)
getLayoutItem` wMetrics hMargins vMargins spaces orientations prevIds prevId cId (WItemHandle` itemH=:{wItemVirtual`}) tb getLayoutItem` wMetrics hMargins vMargins spaces orientations prevIds prevId cId (WItemHandle` itemH=:{wItemVirtual`}) tb
| wItemVirtual` | wItemVirtual`
= ([],prevIds,prevId,cId,WItemHandle` itemH,tb) = ([],prevIds,prevId,cId,WItemHandle` itemH,tb)
...@@ -748,12 +736,6 @@ where ...@@ -748,12 +736,6 @@ where
w` = w+wMetrics.osmVSliderWidth w` = w+wMetrics.osmVSliderWidth
h` = h+wMetrics.osmHSliderHeight h` = h+wMetrics.osmHSliderHeight
validateControlMargin :: !(!Int,!Int) -> (!Int,!Int)
validateControlMargin (a,b) = (max 0 a,max 0 b)
validateControlItemSpace :: !(!Int,!Int) -> (!Int,!Int)
validateControlItemSpace (hspace,vspace) = (max 0 hspace,max 0 vspace)
layoutScrollbars :: !OSWindowMetrics !Size !CompoundInfo -> CompoundInfo layoutScrollbars :: !OSWindowMetrics !Size !CompoundInfo -> CompoundInfo
layoutScrollbars wMetrics size info=:{compoundHScroll,compoundVScroll} layoutScrollbars wMetrics size info=:{compoundHScroll,compoundVScroll}
= { info & compoundHScroll=layoutScrollbar hRect compoundHScroll = { info & compoundHScroll=layoutScrollbar hRect compoundHScroll
...@@ -826,12 +808,6 @@ where ...@@ -826,12 +808,6 @@ where
validateDerivedSize wMetrics derSize reqSize validateDerivedSize wMetrics derSize reqSize
| reqSize==zero = derSize | reqSize==zero = derSize
| otherwise = reqSize | otherwise = reqSize
validateControlMargin :: !(!Int,!Int) -> (!Int,!Int)
validateControlMargin (a,b) = (max 0 a,max 0 b)
validateControlItemSpace :: !(!Int,!Int) -> (!Int,!Int)
validateControlItemSpace (hspace,vspace) = (max 0 hspace,max 0 vspace)
getLayoutWItem` _ _ _ _ _ _ _ _ _ _ getLayoutWItem` _ _ _ _ _ _ _ _ _ _
= controllayoutFatalError "getLayoutWItem`" "unmatched control implementation alternative" = controllayoutFatalError "getLayoutWItem`" "unmatched control implementation alternative"
...@@ -849,7 +825,13 @@ where ...@@ -849,7 +825,13 @@ where
getLayoutItems` _ _ _ _ _ prevIds prevId cId [] tb getLayoutItems` _ _ _ _ _ prevIds prevId cId [] tb
= ([],prevIds,prevId,cId,[],tb) = ([],prevIds,prevId,cId,[],tb)
validateControlMargin :: !(!Int,!Int) -> (!Int,!Int)
validateControlMargin (a,b) = (max 0 a,max 0 b)
validateControlItemSpace :: !(!Int,!Int) -> (!Int,!Int)
validateControlItemSpace (hspace,vspace) = (max 0 hspace,max 0 vspace)
toColumns :: !RowsOrColumns ![x] -> [[x]] toColumns :: !RowsOrColumns ![x] -> [[x]]
toColumns (Columns n) items toColumns (Columns n) items
= repeat_splitting perColumn items = repeat_splitting perColumn items
......
...@@ -26,9 +26,19 @@ controlposFatalError function error ...@@ -26,9 +26,19 @@ controlposFatalError function error
*/ */
movewindowviewframe :: !OSWindowMetrics !Vector2 !WIDS !(WindowHandle .ls .pst) !*OSToolbox -> (!WindowHandle .ls .pst,!*OSToolbox) movewindowviewframe :: !OSWindowMetrics !Vector2 !WIDS !(WindowHandle .ls .pst) !*OSToolbox -> (!WindowHandle .ls .pst,!*OSToolbox)
movewindowviewframe wMetrics v wids=:{wPtr} wH=:{whWindowInfo,whItems=oldItems,whSize,whAtts,whSelect,whShow} tb movewindowviewframe wMetrics v wids=:{wPtr} wH=:{whWindowInfo,whItems=oldItems,whSize,whAtts,whSelect,whShow} tb
| newOrigin==oldOrigin | newOrigin==oldOrigin // origin has not changed
= (wH,tb) = (wH,tb)
| otherwise | isEmpty oldItems // there are no controls: do only visual updates
# tb = setsliderthumb hasHScroll wMetrics wPtr True (minx,newOrigin.x,maxx) vieww (toTuple whSize) tb
# tb = setsliderthumb hasVScroll wMetrics wPtr False (miny,newOrigin.y,maxy) viewh (toTuple whSize) tb
windowInfo = {windowInfo & windowOrigin=newOrigin}
wH = {wH & whWindowInfo=WindowInfo windowInfo}
(updArea,updAction) = if (not lookInfo.lookSysUpdate || toMuch)
([newFrame],return []) (calcScrollUpdateArea oldOrigin newOrigin contentRect)
updState = {oldFrame=PosSizeToRectangle oldOrigin contentSize,newFrame=newFrame,updArea=updArea}
# (wH,tb) = drawwindowlook` wMetrics wPtr updAction updState wH tb
= (wH,tb)
| otherwise // there are controls: recalculate layout and do visual updates
# tb = setsliderthumb hasHScroll wMetrics wPtr True (minx,newOrigin.x,maxx) vieww (toTuple whSize) tb # tb = setsliderthumb hasHScroll wMetrics wPtr True (minx,newOrigin.x,maxx) vieww (toTuple whSize) tb
# tb = setsliderthumb hasVScroll wMetrics wPtr False (miny,newOrigin.y,maxy) viewh (toTuple whSize) tb # tb = setsliderthumb hasVScroll wMetrics wPtr False (miny,newOrigin.y,maxy) viewh (toTuple whSize) tb
reqSize = {w=contentSize.w-fst hMargins-snd hMargins,h=contentSize.h-fst vMargins-snd vMargins} reqSize = {w=contentSize.w-fst hMargins-snd hMargins,h=contentSize.h-fst vMargins-snd vMargins}
...@@ -41,8 +51,6 @@ movewindowviewframe wMetrics v wids=:{wPtr} wH=:{whWindowInfo,whItems=oldItems,w ...@@ -41,8 +51,6 @@ movewindowviewframe wMetrics v wids=:{wPtr} wH=:{whWindowInfo,whItems=oldItems,w
_ -> controlposFatalError "movewindowviewframe" "unexpected whWindowInfo field" _ -> controlposFatalError "movewindowviewframe" "unexpected whWindowInfo field"
# (updRgn,tb) = relayoutControls wMetrics whSelect whShow contentRect contentRect zero zero wPtr wH.whDefaultId oldItems wH.whItems tb # (updRgn,tb) = relayoutControls wMetrics whSelect whShow contentRect contentRect zero zero wPtr wH.whDefaultId oldItems wH.whItems tb
# (wH,tb) = updatewindowbackgrounds wMetrics updRgn wids wH tb # (wH,tb) = updatewindowbackgrounds wMetrics updRgn wids wH tb
newFrame = PosSizeToRectangle newOrigin contentSize
toMuch = (abs (newOrigin.x-oldOrigin.x)>=w`) || (abs (newOrigin.y-oldOrigin.y)>=h`)
(updArea,updAction) = if (not lookInfo.lookSysUpdate || toMuch || not isRect) (updArea,updAction) = if (not lookInfo.lookSysUpdate || toMuch || not isRect)
([newFrame],return []) (calcScrollUpdateArea oldOrigin newOrigin areaRect) ([newFrame],return []) (calcScrollUpdateArea oldOrigin newOrigin areaRect)
updState = {oldFrame=PosSizeToRectangle oldOrigin contentSize,newFrame=newFrame,updArea=updArea} updState = {oldFrame=PosSizeToRectangle oldOrigin contentSize,newFrame=newFrame,updArea=updArea}
...@@ -62,6 +70,8 @@ where ...@@ -62,6 +70,8 @@ where
newOrigin = { x = SetBetween (oldOrigin.x+v.vx) minx (max minx (maxx-vieww)) newOrigin = { x = SetBetween (oldOrigin.x+v.vx) minx (max minx (maxx-vieww))
, y = SetBetween (oldOrigin.y+v.vy) miny (max miny (maxy-viewh)) , y = SetBetween (oldOrigin.y+v.vy) miny (max miny (maxy-viewh))
} }
newFrame = PosSizeToRectangle newOrigin contentSize
toMuch = (abs (newOrigin.x-oldOrigin.x)>=w`) || (abs (newOrigin.y-oldOrigin.y)>=h`)
(defMinW,defMinH) = OSMinWindowSize (defMinW,defMinH) = OSMinWindowSize
minSize = {w=defMinW,h=defMinH} minSize = {w=defMinW,h=defMinH}
hMargins = getWindowHMargins IsWindow wMetrics whAtts hMargins = getWindowHMargins IsWindow wMetrics whAtts
......
...@@ -26,22 +26,22 @@ import relayout, windowaccess, windowclipstate, wstateaccess ...@@ -26,22 +26,22 @@ import relayout, windowaccess, windowclipstate, wstateaccess
relayoutControls :: !OSWindowMetrics !Bool !Bool !Rect !Rect !Point2 !Point2 !OSWindowPtr !(Maybe Id) relayoutControls :: !OSWindowMetrics !Bool !Bool !Rect !Rect !Point2 !Point2 !OSWindowPtr !(Maybe Id)
![WElementHandle .ls .pst] ![WElementHandle .ls .pst] !*OSToolbox -> (!OSRgnHandle,!*OSToolbox) ![WElementHandle .ls .pst] ![WElementHandle .ls .pst] !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
relayoutControls wMetrics isAble isVisible oldFrame newFrame oldParentPos newParentPos wPtr defaultId oldHs newHs tb relayoutControls wMetrics isAble isVisible oldFrame newFrame oldParentPos newParentPos wPtr defaultId oldHs newHs tb
= relayoutItems wMetrics isAble oldFrame newFrame oldParentPos newParentPos wPtr = relayoutItems wMetrics oldFrame newFrame oldParentPos newParentPos wPtr
(WElementHandlesToRelayoutItems isVisible oldHs []) (WElementHandlesToRelayoutItems isAble isVisible oldHs [])
(WElementHandlesToRelayoutItems isVisible newHs []) (WElementHandlesToRelayoutItems isAble isVisible newHs [])
tb tb
where where
WElementHandlesToRelayoutItems :: !Bool ![WElementHandle .ls .pst] ![RelayoutItem] -> [RelayoutItem] WElementHandlesToRelayoutItems :: !Bool !Bool ![WElementHandle .ls .pst] ![RelayoutItem] -> [RelayoutItem]
WElementHandlesToRelayoutItems isVisible [itemH:itemHs] items WElementHandlesToRelayoutItems isAble isVisible [itemH:itemHs] items
= WElementHandleToRelayoutItems isVisible itemH (WElementHandlesToRelayoutItems isVisible itemHs items) = WElementHandleToRelayoutItems isAble isVisible itemH (WElementHandlesToRelayoutItems isAble isVisible itemHs items)
where where
WElementHandleToRelayoutItems :: !Bool !(WElementHandle .ls .pst) ![RelayoutItem] -> [RelayoutItem] WElementHandleToRelayoutItems :: !Bool !Bool !(WElementHandle .ls .pst) ![RelayoutItem] -> [RelayoutItem]
WElementHandleToRelayoutItems isVisible (WItemHandle itemH=:{wItemKind}) items WElementHandleToRelayoutItems isAble isVisible (WItemHandle itemH=:{wItemKind}) items
= WItemHandleToRelayoutItems wItemKind isVisible itemH items = WItemHandleToRelayoutItems wItemKind isAble isVisible itemH items
where where
WItemHandleToRelayoutItems :: !ControlKind !Bool !(WItemHandle .ls .pst) ![RelayoutItem] -> [RelayoutItem] WItemHandleToRelayoutItems :: !ControlKind !Bool !Bool !(WItemHandle .ls .pst) ![RelayoutItem] -> [RelayoutItem]
WItemHandleToRelayoutItems controlKind=:IsRadioControl isVisible itemH=:{wItemSelect,wItemShow} items WItemHandleToRelayoutItems controlKind=:IsRadioControl isAble isVisible itemH=:{wItemSelect,wItemShow} items
= RadioItemToRelayoutItems wItemSelect (isVisible && wItemShow) (getWItemRadioInfo itemH.wItemInfo).radioItems items = RadioItemToRelayoutItems (isAble && wItemSelect) (isVisible && wItemShow) (getWItemRadioInfo itemH.wItemInfo).radioItems items
where where
RadioItemToRelayoutItems :: !Bool !Bool ![RadioItemInfo *(.ls,.pst)] ![RelayoutItem] -> [RelayoutItem] RadioItemToRelayoutItems :: !Bool !Bool ![RadioItemInfo *(.ls,.pst)] ![RelayoutItem] -> [RelayoutItem]
RadioItemToRelayoutItems isAble isVisible [radio:radios] items RadioItemToRelayoutItems isAble isVisible [radio:radios] items
...@@ -63,8 +63,8 @@ where ...@@ -63,8 +63,8 @@ where
RadioItemToRelayoutItems _ _ _ items RadioItemToRelayoutItems _ _ _ items
= items = items
WItemHandleToRelayoutItems controlKind=:IsCheckControl isVisible itemH=:{wItemSelect,wItemShow} items WItemHandleToRelayoutItems controlKind=:IsCheckControl isAble isVisible itemH=:{wItemSelect,wItemShow} items
= CheckItemToRelayoutItems wItemSelect (isVisible && wItemShow) (getWItemCheckInfo itemH.wItemInfo).checkItems items = CheckItemToRelayoutItems (isAble && wItemSelect) (isVisible && wItemShow) (getWItemCheckInfo itemH.wItemInfo).checkItems items
where where
CheckItemToRelayoutItems :: !Bool !Bool ![CheckItemInfo *(.ls,.pst)] ![RelayoutItem] -> [RelayoutItem] CheckItemToRelayoutItems :: !Bool !Bool ![CheckItemInfo *(.ls,.pst)] ![RelayoutItem] -> [RelayoutItem]
CheckItemToRelayoutItems isAble isVisible [check:checks] items CheckItemToRelayoutItems isAble isVisible [check:checks] items
...@@ -86,12 +86,12 @@ where ...@@ -86,12 +86,12 @@ where
CheckItemToRelayoutItems _ _ _ items CheckItemToRelayoutItems _ _ _ items
= items = items
WItemHandleToRelayoutItems controlKind isVisible itemH=:{wItemPtr,wItemPos,wItemSize,wItemSelect,wItemShow} items WItemHandleToRelayoutItems controlKind isAble isVisible itemH=:{wItemPtr,wItemPos,wItemSize,wItemSelect,wItemShow} items
#! item = { rliItemKind = controlKind #! item = { rliItemKind = controlKind
, rliItemPtr = wItemPtr , rliItemPtr = wItemPtr
, rliItemPos = wItemPos , rliItemPos = wItemPos
, rliItemSize = wItemSize , rliItemSize = wItemSize
, rliItemSelect = wItemSelect , rliItemSelect = isAble`
, rliItemShow = isVisible` , rliItemShow = isVisible`
, rliItemInfo = info , rliItemInfo = info
, rliItemLook = look , rliItemLook = look
...@@ -99,55 +99,56 @@ where ...@@ -99,55 +99,56 @@ where
} }
= [item:items] = [item:items]
where where
isAble` = isAble && wItemSelect
isVisible` = isVisible && wItemShow isVisible` = isVisible && wItemShow
(info,look,items`) = getinfo controlKind isVisible` itemH (info,look,items`) = getinfo controlKind isAble` isVisible` itemH
getinfo :: !ControlKind !Bool !(WItemHandle .ls .pst) -> (CompoundInfo,LookInfo,![RelayoutItem]) getinfo :: !ControlKind !Bool !Bool !(WItemHandle .ls .pst) -> (CompoundInfo,LookInfo,![RelayoutItem])
getinfo IsCompoundControl isVisible {wItemInfo,wItems} getinfo IsCompoundControl isAble isVisible {wItemInfo,wItems}
= (info,info.compoundLookInfo.compoundLook,WElementHandlesToRelayoutItems isVisible wItems []) = (info,info.compoundLookInfo.compoundLook,WElementHandlesToRelayoutItems isAble isVisible wItems [])
where where
info = getWItemCompoundInfo wItemInfo info = getWItemCompoundInfo wItemInfo
getinfo IsCustomButtonControl _ {wItemInfo} getinfo IsCustomButtonControl _ _ {wItemInfo}
= (undef,(getWItemCustomButtonInfo wItemInfo).cButtonInfoLook,[]) = (undef,(getWItemCustomButtonInfo wItemInfo).cButtonInfoLook,[])
getinfo IsCustomControl _ {wItemInfo} getinfo IsCustomControl _ _ {wItemInfo}
= (undef,(getWItemCustomInfo wItemInfo).customInfoLook,[]) = (undef,(getWItemCustomInfo wItemInfo).customInfoLook,[])
getinfo IsLayoutControl isVisible {wItems} getinfo IsLayoutControl isAble isVisible {wItems}
= (undef,undef,WElementHandlesToRelayoutItems isVisible wItems []) = (undef,undef,WElementHandlesToRelayoutItems isAble isVisible wItems [])
getinfo _ _ _ getinfo _ _ _ _
= (undef,undef,[]) = (undef,undef,[])
WElementHandleToRelayoutItems isVisible (WListLSHandle itemHs) items WElementHandleToRelayoutItems isAble isVisible (WListLSHandle itemHs) items
= WElementHandlesToRelayoutItems isVisible itemHs items = WElementHandlesToRelayoutItems isAble isVisible itemHs items
WElementHandleToRelayoutItems isVisible (WExtendLSHandle {wExtendItems=itemHs}) items WElementHandleToRelayoutItems isAble isVisible (WExtendLSHandle {wExtendItems=itemHs}) items
= WElementHandlesToRelayoutItems isVisible itemHs items = WElementHandlesToRelayoutItems isAble isVisible itemHs items
WElementHandleToRelayoutItems isVisible (WChangeLSHandle {wChangeItems=itemHs}) items WElementHandleToRelayoutItems isAble isVisible (WChangeLSHandle {wChangeItems=itemHs}) items
= WElementHandlesToRelayoutItems isVisible itemHs items = WElementHandlesToRelayoutItems isAble isVisible itemHs items
WElementHandlesToRelayoutItems _ _ items WElementHandlesToRelayoutItems _ _ _ items
= items = items
relayoutControls` :: !OSWindowMetrics !Bool !Bool !Rect !Rect !Point2 !Point2 !OSWindowPtr !(Maybe Id) relayoutControls` :: !OSWindowMetrics !Bool !Bool !Rect !Rect !Point2 !Point2 !OSWindowPtr !(Maybe Id)
![WElementHandle`] ![WElementHandle`] !*OSToolbox -> (!OSRgnHandle,!*OSToolbox) ![WElementHandle`] ![WElementHandle`] !*OSToolbox -> (!OSRgnHandle,!*OSToolbox)
relayoutControls` wMetrics isAble isVisible oldFrame newFrame oldParentPos newParentPos wPtr defaultId oldHs newHs tb relayoutControls` wMetrics isAble isVisible oldFrame newFrame oldParentPos newParentPos wPtr defaultId oldHs newHs tb
= relayoutItems wMetrics isAble oldFrame newFrame oldParentPos newParentPos wPtr = relayoutItems wMetrics oldFrame newFrame oldParentPos newParentPos wPtr
(WElementHandles`ToRelayoutItems isVisible oldHs []) (WElementHandles`ToRelayoutItems isAble isVisible oldHs [])
(WElementHandles`ToRelayoutItems isVisible newHs []) (WElementHandles`ToRelayoutItems isAble isVisible newHs [])
tb tb
where where
WElementHandles`ToRelayoutItems :: !Bool ![WElementHandle`] ![RelayoutItem] -> [RelayoutItem] WElementHandles`ToRelayoutItems :: !Bool !Bool ![WElementHandle`] ![RelayoutItem] -> [RelayoutItem]
WElementHandles`ToRelayoutItems isVisible [itemH:itemHs] items WElementHandles`ToRelayoutItems isAble isVisible [itemH:itemHs] items
= WElementHandle`ToRelayoutItems isVisible itemH (WElementHandles`ToRelayoutItems isVisible itemHs items) = WElementHandle`ToRelayoutItems isAble isVisible itemH (WElementHandles`ToRelayoutItems isAble isVisible itemHs items)
where where
WElementHandle`ToRelayoutItems :: !Bool !WElementHandle` ![RelayoutItem] -> [RelayoutItem] WElementHandle`ToRelayoutItems :: !Bool !Bool !WElementHandle` ![RelayoutItem] -> [RelayoutItem]
WElementHandle`ToRelayoutItems isVisible (WItemHandle` itemH=:{wItemKind`}) items WElementHandle`ToRelayoutItems isAble isVisible (WItemHandle` itemH=:{wItemKind`}) items
= WItemHandle`ToRelayoutItems wItemKind` isVisible itemH items = WItemHandle`ToRelayoutItems wItemKind` isAble isVisible itemH items
where where
WItemHandle`ToRelayoutItems :: !ControlKind !Bool !WItemHandle` ![RelayoutItem] -> [RelayoutItem] WItemHandle`ToRelayoutItems :: !ControlKind !Bool !Bool !WItemHandle` ![RelayoutItem] -> [RelayoutItem]
WItemHandle`ToRelayoutItems controlKind=:IsRadioControl isVisible itemH=:{wItemSelect`,wItemShow`} items WItemHandle`ToRelayoutItems controlKind=:IsRadioControl isAble isVisible itemH=:{wItemSelect`,wItemShow`} items
= RadioItem`ToRelayoutItems wItemSelect` (isVisible && wItemShow`) (getWItemRadioInfo` itemH.wItemInfo`).radioItems` items = RadioItem`ToRelayoutItems (isAble && wItemSelect`) (isVisible && wItemShow`) (getWItemRadioInfo` itemH.wItemInfo`).radioItems` items
where where
RadioItem`ToRelayoutItems :: !Bool !Bool ![RadioItemInfo`] ![RelayoutItem] -> [RelayoutItem] RadioItem`ToRelayoutItems :: !Bool !Bool ![RadioItemInfo`] ![RelayoutItem] -> [RelayoutItem]
RadioItem`ToRelayoutItems isAble isVisible [radio:radios] items RadioItem`ToRelayoutItems isAble isVisible [radio:radios] items
...@@ -169,8 +170,8 @@ where ...@@ -169,8 +170,8 @@ where
RadioItem`ToRelayoutItems _ _ _ items RadioItem`ToRelayoutItems _ _ _ items
= items = items