implementation module controlresize


import	StdBool, StdFunc, StdList, StdMisc, StdTuple
import	commondef, controlrelayout, windowhandle, wstateaccess
from	StdControlAttribute	import isControlResize,       getControlResizeFun,
									isControlMinimumSize, getControlMinimumSizeAtt,
									isControlPos,         getControlPosAtt, isControlViewSize
from	controllayout		import layoutControls, layoutControls`
from	windowaccess		import getWItemCompoundInfo, getWItemEditInfo, getWItemSliderInfo, getWindowInfoWindowData,
									getWindowHMargins, getWindowVMargins, getWindowItemSpaces, identifyMaybeId
from	windowclipstate		import forceValidWindowClipState, forceValidWindowClipState`, invalidateCompoundClipState
from	windowdraw			import drawwindowlook, drawwindow`look
from	windowupdate		import updatewindowbackgrounds, updatewindowbackgrounds`
import	ossystem, ostoolbox, ostypes, oswindow


/*	resizeControls proceeds as follows:
	-	Apply to every control its ControlResizeFunction if applicable.
	-	If some controls have changed size or have been layout relative to the window view frame:
		-	Calculate the new layout.
		-	Reposition and resize the appropriate controls.
*/
resizeControls :: !OSWindowMetrics !Bool !Bool !WIDS !Origin !Size !Size !(WindowHandle .ls .pst) !*OSToolbox
																	  -> (!WindowHandle .ls .pst, !*OSToolbox)
resizeControls wMetrics isActive updateAll wids=:{wPtr} oldOrigin oldWSize newWSize 
			   wH=:{whWindowInfo,whItems=oldItems,whAtts,whDefaultId,whSelect,whShow} tb
	# (oldItems`,oldItems,tb)	= getWElementHandles` wPtr oldItems tb
	# (layoutChanged,newItems)	= calcNewControlsSize wMetrics originShifted oldWSize newWSize oldItems
	| not layoutChanged && newWSize.w<=oldWSize.w && newWSize.h<=oldWSize.h
		# wH					= {wH & whItems=newItems}
		# (wH,tb)				= forceValidWindowClipState wMetrics True wPtr wH tb
		| lookSysUpdate && not updateAll
			= (wH,tb)
		// otherwise
			# updState			= {oldFrame=oldFrame,newFrame=newFrame,updArea=[newFrame]}
			= drawwindowlook wMetrics wPtr id updState wH tb
	| otherwise
		# (_,newItems,tb)		= layoutControls wMetrics hMargins vMargins spaces newWSize minSize [(domain,newOrigin)] newItems tb
		  wH					= {wH & whItems=newItems}
		# (wH,tb)				= forceValidWindowClipState wMetrics True wPtr wH tb
		# (updRgn,newItems,tb)	= relayoutControls wMetrics wPtr whDefaultId False whSelect whShow (sizeToRect oldWSize,zero,zero,oldItems`) 
								                                                                   (sizeToRect newWSize,zero,zero,wH.whItems) tb
		# (wH,tb)				= updatewindowbackgrounds wMetrics updRgn wids {wH & whItems=newItems} tb
		  {x,y}					= oldOrigin
		  (oldw,oldh)			= toTuple oldWSize
		  (neww,newh)			= toTuple newWSize
		  updArea				= if (lookSysUpdate && not originShifted && (neww>oldw || newh>oldh) && isActive && not updateAll)
		  							(	(if (neww>oldw) [{ corner1={oldOrigin & x=x+oldw},corner2={x=x+neww,y=y+min oldh newh}}] [])
		  							++	(if (newh>oldh) [{ corner1={oldOrigin & y=y+oldh},corner2={x=x+neww,y=y+newh}}]          [])
		  							)
		  							[newFrame]
		  updState				= {oldFrame=oldFrame,newFrame=newFrame,updArea=updArea}
		= drawwindowlook wMetrics wPtr id updState wH tb
where
	originShifted				= oldOrigin<>newOrigin
	windowInfo					= getWindowInfoWindowData whWindowInfo
	(newOrigin,domainRect,lookInfo)
								= (windowInfo.windowOrigin,windowInfo.windowDomain,windowInfo.windowLook)
	domain						= rectToRectangle domainRect
	lookSysUpdate				= lookInfo.lookSysUpdate
	(defMinW,   defMinH)		= osMinWindowSize
	wKind						= wH.whKind
	hMargins					= getWindowHMargins   wKind wMetrics whAtts
	vMargins					= getWindowVMargins   wKind wMetrics whAtts
	spaces						= getWindowItemSpaces wKind wMetrics whAtts
	minSize						= {w=defMinW,h=defMinH}
	oldFrame					= posSizeToRectangle oldOrigin oldWSize
	newFrame					= posSizeToRectangle newOrigin newWSize


/*	calcNewControlsSize applies to a Control its ControlResizeFunction if it has one.
	The Boolean result holds iff some Control has changed its size or may cause change of layout.
*/
calcNewControlsSize :: !OSWindowMetrics !Bool !Size !Size ![WElementHandle .ls .pst]  -> (!Bool,![WElementHandle .ls .pst])
calcNewControlsSize wMetrics originShifted oldWSize newWSize []
	= (False,[])
calcNewControlsSize wMetrics originShifted oldWSize newWSize [itemH:itemHs]
	# (layoutChanged1,itemH)	= calcNewControlSize  wMetrics originShifted oldWSize newWSize itemH
	# (layoutChanged2,itemHs)	= calcNewControlsSize wMetrics originShifted oldWSize newWSize itemHs
	= (layoutChanged1 || layoutChanged2,[itemH:itemHs])
where
	calcNewControlSize :: !OSWindowMetrics !Bool !Size !Size !(WElementHandle .ls .pst) -> (!Bool,!WElementHandle .ls .pst)
	calcNewControlSize wMetrics originShifted oldWSize newWSize (WItemHandle itemH=:{wItemAtts})
		| not resizable
			= (isViewFrameSensitive || isOriginSensitive,WItemHandle itemH)
		| otherwise
			# (layoutChanged,itemH)	= calcNewWItemSize wMetrics originShifted (\oldCSize -> resizeF oldCSize oldWSize newWSize) itemH
			= (isViewFrameSensitive || isOriginSensitive || layoutChanged,WItemHandle itemH)
	where
		(resizable,resizeAtt)	= cselect isControlResize undef wItemAtts
		(hasPos,posAtt)			= cselect isControlPos undef wItemAtts
		itemPos					= getControlPosAtt posAtt
		resizeF					= getControlResizeFun resizeAtt
		isViewFrameSensitive	= if hasPos
									(case (fst itemPos) of
										LeftBottom	-> True
										RightTop	-> True
										RightBottom	-> True
										Center		-> True
										Right		-> True
										Fix			-> originShifted
										_			-> False
									)
									False
		isOriginSensitive		= if hasPos
									(case (snd itemPos) of
										OffsetFun _ _	-> True
										_				-> False
									)
									False
		
		calcNewWItemSize :: !OSWindowMetrics !Bool !(IdFun Size) !(WItemHandle .ls .pst) -> (!Bool,!WItemHandle .ls .pst)
		
/*	PA: the current size argument of the resize function must be the outer size, not the view size.
		Similar: the result size is also the outer size. 
*/		calcNewWItemSize wMetrics originShifted resizeF itemH=:{wItemKind=IsCompoundControl}
			# visScrolls		= osScrollbarsAreVisible wMetrics domainRect (toTuple oldSize) hasScrolls
			  oldFrameSize		= rectSize (osGetCompoundContentRect wMetrics visScrolls (sizeToRect oldSize))
			  newSize			= resizeF oldSize
			  newSize			= {w=max minSize.w newSize.w,h=max minSize.h newSize.h}
			  visScrolls		= osScrollbarsAreVisible wMetrics domainRect (toTuple newSize) hasScrolls
			  newFrameSize		= rectSize (osGetCompoundContentRect wMetrics visScrolls (sizeToRect newSize))
			| newFrameSize==oldFrameSize
				= (False,itemH)
			| otherwise
				# newOrigin		= calcNewOrigin origin domainRect newFrameSize
				  newInfo		= CompoundInfo {info & compoundOrigin=newOrigin}
				  (_,itemHs)	= calcNewControlsSize wMetrics (originShifted || newOrigin<>origin) oldFrameSize newFrameSize itemH.wItems
				  itemH			= {itemH & wItemSize=newSize,wItemAtts=replaceSizeAtt newFrameSize atts,wItemInfo=newInfo,wItems=itemHs}
				  itemH			= invalidateCompoundClipState itemH
				= (True,itemH)
		where
			atts				= itemH.wItemAtts
			oldSize				= itemH.wItemSize
			info				= getWItemCompoundInfo itemH.wItemInfo
			origin				= info.compoundOrigin
			domainRect			= info.compoundDomain
			hasScrolls			= (isJust info.compoundHScroll,isJust info.compoundVScroll)
			(defMinW,defMinH)	= osMinCompoundSize
			minSize				= getControlMinimumSizeAtt (snd (cselect isControlMinimumSize (ControlMinimumSize {w=defMinW,h=defMinH}) atts))
			
			calcNewOrigin :: !Point2 !OSRect !Size -> Point2		// This code also appears at windowdevice: windowStateSizeAction
			calcNewOrigin {x,y} {rleft,rtop,rright,rbottom} {w,h}
				= {x=x`,y=y`}
			where
				x`				= if (x+w>rright)  (max (rright -w) rleft) x
				y`				= if (y+h>rbottom) (max (rbottom-h) rtop ) y
		
		calcNewWItemSize wMetrics originShifted resizeF itemH=:{wItemKind=IsButtonControl}
			# itemH		= {itemH & wItemSize=newSize1,wItemAtts=replaceSizeAtt newSize1 itemH.wItemAtts}
			= (newSize1<>oldSize,itemH)
		where
			oldSize				= itemH.wItemSize
			newSize				= resizeF oldSize
			newSize1			= {w=max (osGetButtonControlMinWidth wMetrics) newSize.w,h=max 0 newSize.h}
		
		calcNewWItemSize _ originShifted resizeF itemH=:{wItemKind=IsCustomControl}
			# itemH		= {itemH & wItemSize=newSize1,wItemAtts=replaceSizeAtt newSize1 itemH.wItemAtts}
			= (newSize1<>oldSize,itemH)
		where
			oldSize				= itemH.wItemSize
			newSize				= resizeF oldSize
			newSize1			= {w=max 0 newSize.w,h=max 0 newSize.h}
		
		calcNewWItemSize _ originShifted resizeF itemH=:{wItemKind=IsCustomButtonControl}
			# itemH				= {itemH & wItemSize=newSize1,wItemAtts=replaceSizeAtt newSize1 itemH.wItemAtts}
			= (newSize1<>oldSize,itemH)
		where
			oldSize				= itemH.wItemSize
			newSize				= resizeF oldSize
			newSize1			= {w=max 0 newSize.w,h=max 0 newSize.h}
		
		calcNewWItemSize wMetrics originShifted resizeF itemH=:{wItemKind=IsEditControl}
			# itemH				= {itemH & wItemSize=newSize1,wItemInfo=editInfo,wItemAtts=replaceSizeAtt newSize1 itemH.wItemAtts}
			= (newSize1<>oldSize,itemH)
		where
			oldSize				= itemH.wItemSize
			newSize				= resizeF oldSize
			info				= getWItemEditInfo itemH.wItemInfo
			lineHeight			= wMetrics.osmHeight
			nrLines1			= max 1 (newSize.h/lineHeight)
			newSize1			= {w=max 0 newSize.w,h=nrLines1*lineHeight}
			editInfo			= EditInfo {info & editInfoWidth=newSize1.w,editInfoNrLines=nrLines1}
		
		calcNewWItemSize wMetrics originShifted resizeF itemH=:{wItemKind=IsLayoutControl}
			# newSize			= resizeF oldSize
			  newSize			= {w=max minSize.w newSize.w,h=max minSize.h newSize.h}
			| newSize==oldSize
				= (False,itemH)
			| otherwise
				# (_,itemHs)	= calcNewControlsSize wMetrics originShifted oldSize newSize itemH.wItems
				  itemH			= {itemH & wItemSize=newSize,wItemAtts=replaceSizeAtt newSize atts,wItems=itemHs}
				= (True,itemH)
		where
			atts				= itemH.wItemAtts
			oldSize				= itemH.wItemSize
			minSize				= getControlMinimumSizeAtt (snd (cselect isControlMinimumSize (ControlMinimumSize zero) atts))
		
		calcNewWItemSize wMetrics originShifted resizeF itemH=:{wItemKind=IsSliderControl}
			# itemH				= {itemH & wItemSize=newSize1,wItemInfo=sliderInfo,wItemAtts=replaceSizeAtt newSize1 itemH.wItemAtts}
			= (newSize1<>oldSize,itemH)
		where
			oldSize				= itemH.wItemSize
			newSize				= resizeF oldSize
			info				= getWItemSliderInfo itemH.wItemInfo
			horizontal			= info.sliderInfoDir==Horizontal
			newSize1			= if horizontal	{w=max newSize.w 0,h=wMetrics.osmHSliderHeight} {w=wMetrics.osmVSliderWidth,h=max newSize.h 0}
			sSize				= if horizontal newSize1.w newSize1.h
			sliderInfo			= SliderInfo {info & sliderInfoLength=sSize}
		
		calcNewWItemSize _ _ _ itemH
			= (False,itemH)
	
	calcNewControlSize wMetrics originShifted oldWSize newWSize (WListLSHandle itemHs)
		# (layoutChanged,itemHs)	= calcNewControlsSize wMetrics originShifted oldWSize newWSize itemHs
		= (layoutChanged,WListLSHandle itemHs)
	
	calcNewControlSize wMetrics originShifted oldWSize newWSize (WExtendLSHandle wExH=:{wExtendItems=itemHs})
		# (layoutChanged,itemHs)	= calcNewControlsSize wMetrics originShifted oldWSize newWSize itemHs
		= (layoutChanged,WExtendLSHandle {wExH & wExtendItems=itemHs})
	
	calcNewControlSize wMetrics originShifted oldWSize newWSize (WChangeLSHandle wChH=:{wChangeItems=itemHs})
		# (layoutChanged,itemHs)	= calcNewControlsSize wMetrics originShifted oldWSize newWSize itemHs
		= (layoutChanged,WChangeLSHandle {wChH & wChangeItems=itemHs})

replaceSizeAtt :: !Size ![ControlAttribute .pst] -> [ControlAttribute .pst]
replaceSizeAtt size atts
//		= snd (creplace isControlSize sizeAtt atts)
	# (replaced,atts)	= creplace isControlViewSize sizeAtt atts
	| replaced			= atts
	| otherwise			= atts++[sizeAtt]
where
	sizeAtt				= ControlViewSize size

replaceSizeAtt` :: !Size ![ControlAttribute`] -> [ControlAttribute`]
replaceSizeAtt` size atts
	# (replaced,atts)	= creplace (\cAtt` -> case cAtt` of ControlViewSize` _ -> True; _ -> False) sizeAtt atts
	| replaced			= atts
	| otherwise			= atts++[sizeAtt]
where
	sizeAtt				= ControlViewSize` size

resizeControl :: !OSWindowMetrics !Bool !WIDS !Id !Size !WindowHandle` !*OSToolbox -> (!WindowHandle`, !*OSToolbox)
resizeControl wMetrics updateAll wids=:{wPtr} controlId newCSize wH=:{whWindowInfo`,whItems`=oldItems`,whAtts`,whDefaultId`,whSelect`,whShow`} tb
	#  oldVisScrolls			= osScrollbarsAreVisible wMetrics domainRect wSize` (hasHScroll,hasVScroll)
	   oldContent				= osGetWindowContentRect wMetrics oldVisScrolls (sizeToRect wSize)
	   oldContentSize			= rectSize oldContent
	# (layoutChanged,newItems`)	= replaceControlSize wMetrics controlId newCSize oldItems`
	| not layoutChanged
		= ({wH & whItems`=newItems`},tb)
	| otherwise
		# (_,newItems`,tb)		= layoutControls` wMetrics hMargins vMargins spaces wSize minSize [(domain,origin)] newItems` tb
		  wH					= {wH & whItems`=newItems`}
		# (wH,tb)				= forceValidWindowClipState` wMetrics True wPtr wH tb
		# (updRgn,tb)			= relayoutControls` wMetrics wPtr whDefaultId` False whSelect` whShow` (sizeToRect wSize,zero,zero,oldItems`) (sizeToRect wSize,zero,zero,wH.whItems`) tb
		# (wH,tb)				= updatewindowbackgrounds` wMetrics updRgn wids wH tb
		  {x,y}					= origin
		  (oldw,oldh)			= wSize`
		  updState				= {oldFrame=wFrame,newFrame=wFrame,updArea=[wFrame]}
		= drawwindow`look wMetrics wPtr id updState wH tb
where
	wSize						= wH.whSize`
	wSize`						= toTuple wSize
	windowInfo					= getWindowInfoWindowData whWindowInfo`
	(origin,domainRect,lookInfo,hasHScroll,hasVScroll)
								= (windowInfo.windowOrigin,windowInfo.windowDomain,windowInfo.windowLook,isJust windowInfo.windowHScroll,isJust windowInfo.windowVScroll)
	domain						= rectToRectangle domainRect
	lookSysUpdate				= lookInfo.lookSysUpdate
	(defMinW,defMinH)			= osMinWindowSize
	wKind						= wH.whKind`
	hMargins					= getWindowHMargins`   wKind wMetrics whAtts`
	vMargins					= getWindowVMargins`   wKind wMetrics whAtts`
	spaces						= getWindowItemSpaces` wKind wMetrics whAtts`
	minSize						= {w=defMinW,h=defMinH}
	wFrame						= posSizeToRectangle origin wSize

/*	replaceControlSize updates the size of the indicated control.
	The Boolean result holds iff this control has been found.
*/
	replaceControlSize :: !OSWindowMetrics !Id !Size ![WElementHandle`] -> (!Bool,![WElementHandle`])
	replaceControlSize wMetrics controlId newCSize []
		= (False,[])
	replaceControlSize wMetrics controlId newCSize [itemH:itemHs]
		# (done,itemH)		= replaceControlSize` wMetrics controlId newCSize itemH
		| done				= (done,[itemH:itemHs])
		| otherwise
			# (done,itemHs)	= replaceControlSize wMetrics controlId newCSize itemHs
			= (done,[itemH:itemHs])
	where
		replaceControlSize` :: !OSWindowMetrics !Id !Size !WElementHandle` -> (!Bool,!WElementHandle`)
		replaceControlSize`  wMetrics controlId newCSize (WItemHandle` itemH=:{wItemKind`,wItemId`,wItemAtts`})
			| not (identifyMaybeId controlId wItemId`) || not okControl
				| not (isRecursiveControl wItemKind`)
					= (False,WItemHandle` itemH)
				| otherwise
					# (found,itemHs)	= replaceControlSize wMetrics controlId newCSize itemH.wItems`
					= (found,WItemHandle` {itemH & wItems`=itemHs})
			| otherwise
				= (True,WItemHandle` {itemH & wItemSize`=newCSize,wItemAtts`=replaceSizeAtt` newCSize wItemAtts`})
		where
			okControl		= case wItemKind` of
								IsCompoundControl     -> True
								IsCustomButtonControl -> True
								IsCustomControl       -> True
								IsLayoutControl       -> True
								_                     -> False
		
		replaceControlSize` wMetrics controlId newCSize (WRecursiveHandle` itemHs wKind)
			# (done,itemHs)	= replaceControlSize wMetrics controlId newCSize itemHs
			= (done,WRecursiveHandle` itemHs wKind)
