module WindowClipState( validateWindowClipState, validateCompoundClipState
		      , forceValidWindowClipState, forceValidCompoundClipState		      
		      , invalidateWindowClipState, invalidateCompoundClipState
		      , disposeClipState) where


--	********************************************************************************
--	Clean to Haskell Standard Object I/O library, version 1.2
--	
--	WindowClipState
--	********************************************************************************


import OSRgn
import OSWindow
import CommonDef
import WindowAccess(getWItemRadioInfo,  getWItemCheckInfo,  getWItemCompoundInfo,
		    getCompoundContentRect, getCompoundHScrollRect, getCompoundVScrollRect, getWindowContentRect)
import Cutil_12(addr2int) -- to be removed
import WindowHandle -- to be removed
import Foreign.Ptr(nullPtr)


{-	createClipState wMetrics allClipStates validate wPtr clipRect defId isVisible items
		calculates the ClipState that corresponds with items.
		If the Boolean argument is True, also the invalid ClipStates are recalculated of CompoundControls
			that are inside the window frame. 
-}
createClipState :: OSWindowMetrics -> Bool -> Bool -> OSWindowPtr -> Rect -> Maybe Id -> Bool -> [WElementHandle ls ps] -> IO (ClipState,[WElementHandle ls ps])
createClipState wMetrics allClipStates validate wPtr clipRect defId isVisible itemHs = do	
	clipRgn <- osNewRectRgn clipRect
	(itemHs,clipRgn) <- createWElementsClipState wMetrics allClipStates validate wPtr clipRect defId isVisible itemHs clipRgn
	return (ClipState{clipRgn=clipRgn,clipOk=True},itemHs)
	where
	    createWElementsClipState :: OSWindowMetrics -> Bool -> Bool -> OSWindowPtr -> Rect -> Maybe Id -> Bool -> [WElementHandle ls ps] -> OSRgnHandle -> IO ([WElementHandle ls ps],OSRgnHandle)
	    createWElementsClipState wMetrics allClipStates validate wPtr clipRect defId isVisible (itemH:itemHs) clipRgn = do
		(itemH, clipRgn1) <- createWElementClipState  wMetrics allClipStates validate wPtr clipRect defId isVisible itemH  clipRgn
		(itemHs,clipRgn2) <- createWElementsClipState wMetrics allClipStates validate wPtr clipRect defId isVisible itemHs clipRgn1
		return (itemH:itemHs,clipRgn2)
		where
		  createWElementClipState :: OSWindowMetrics -> Bool -> Bool -> OSWindowPtr -> Rect -> Maybe Id -> Bool -> WElementHandle ls ps -> OSRgnHandle -> IO (WElementHandle ls ps, OSRgnHandle)
		  createWElementClipState wMetrics allClipStates validate wPtr clipRect defId isVisible itemH@(WItemHandle {wItemShow=wItemShow,wItemKind=wItemKind}) clipRgn
		      | not itemVisible || disjointRects clipRect itemClipRect =
			      if not allClipStates || not (isRecursiveControl wItemKind) then	-- PA:<>IsCompoundControl
				      return (itemH, clipRgn)
			      else if wItemKind==IsLayoutControl then do				-- PA: this alternative added				      
				      (itemHs,clipRgn1) <- createWElementsClipState wMetrics allClipStates validate wPtr itemClipRect defId False (wItems itemH) clipRgn
				      return (itemH{wItems=itemHs},clipRgn1)
			      else if validate then do
				      itemH1 <- validateCompoundClipState wMetrics allClipStates wPtr defId itemVisible itemH
				      return (itemH1,clipRgn)
			      else do			      	      
				      itemH1 <- forceValidCompoundClipState wMetrics allClipStates wPtr defId itemVisible itemH
				      return (itemH1,clipRgn)
		      | otherwise = do
			      (itemH,clipRgn1) <- createWItemClipState wMetrics allClipStates validate wPtr clipRect defId itemH clipRgn
			      return (itemH,clipRgn1)
		      where
			  itemVisible  = isVisible && wItemShow
			  itemClipRect = posSizeToRect (wItemPos itemH) (wItemSize itemH)

			  createWItemClipState :: OSWindowMetrics -> Bool -> Bool -> OSWindowPtr -> Rect -> Maybe Id -> WElementHandle ls ps -> OSRgnHandle -> IO (WElementHandle ls ps, OSRgnHandle)
			  createWItemClipState _ _ _ wPtr clipRect _ itemH@(WItemHandle {wItemKind=IsRadioControl,wItemInfo=wItemInfo}) clipRgn = do
			      clipRgn1 <- foldrM (createRadioClipState wPtr clipRect) clipRgn (radioItems (getWItemRadioInfo wItemInfo))
			      return (itemH,clipRgn1)
			      where
				  createRadioClipState :: OSWindowPtr -> Rect -> RadioItemInfo ls ps -> OSRgnHandle -> IO OSRgnHandle
				  createRadioClipState wPtr clipRect (RadioItemInfo{radioItemPos=radioItemPos,radioItemSize=radioItemSize}) clipRgn = do
				      radioRgn <- osClipRadioControl wPtr (0,0) clipRect (toTuple radioItemPos) (toTuple radioItemSize)
				      diffRgn <- osDiffRgn clipRgn radioRgn
				      osDisposeRgn clipRgn				      
				      osDisposeRgn radioRgn
				      return diffRgn

			  createWItemClipState _ _ _ wPtr clipRect defId itemH@(WItemHandle {wItemKind=IsCheckControl,wItemInfo=wItemInfo}) clipRgn = do
			      clipRgn <- foldrM (createCheckClipState wPtr clipRect) clipRgn (checkItems (getWItemCheckInfo wItemInfo))
			      return (itemH,clipRgn)
			      where
				  createCheckClipState :: OSWindowPtr -> Rect -> CheckItemInfo ls ps -> OSRgnHandle -> IO OSRgnHandle
				  createCheckClipState wPtr clipRect (CheckItemInfo{checkItemPos=checkItemPos,checkItemSize=checkItemSize}) clipRgn = do
				      checkRgn <- osClipCheckControl wPtr (0,0) clipRect (toTuple checkItemPos) (toTuple checkItemSize)
				      diffRgn <- osDiffRgn clipRgn checkRgn
				      osDisposeRgn clipRgn
				      osDisposeRgn checkRgn
				      return diffRgn

			  createWItemClipState wMetrics allClipStates validate wPtr clipRect defId itemH@(WItemHandle {wItemKind=IsCompoundControl,wItems=wItems}) clipRgn = do
			      rectRgn <- osClipCompoundControl wPtr (0,0) clipRect (toTuple itemPos) (toTuple itemSize)
			      diffRgn <- osDiffRgn clipRgn rectRgn
			      osDisposeRgn clipRgn
			      osDisposeRgn rectRgn
			      (if allClipStates then
			         if validate then do
			           itemH1 <- validateCompoundClipState wMetrics allClipStates wPtr defId True itemH
				   return (itemH1,diffRgn)
				 else do
				   itemH1 <- forceValidCompoundClipState wMetrics allClipStates wPtr defId True itemH				   
				   return (itemH1,diffRgn)
			       else
				 return (itemH,diffRgn))
			      where
				 itemPos	= wItemPos itemH
				 itemSize	= wItemSize itemH

			  createWItemClipState wMetrics allClipStates validate wPtr clipRect defId itemH@(WItemHandle {wItemKind=IsLayoutControl,wItems=wItems}) clipRgn = do
			      (itemHs,clipRgn) <- createWElementsClipState wMetrics allClipStates validate wPtr clipRect1 defId True wItems clipRgn
			      return (itemH{wItems=itemHs},clipRgn)
			      where
				  clipRect1 = intersectRects (posSizeToRect (wItemPos itemH) (wItemSize itemH)) clipRect

			  createWItemClipState _ _ _ wPtr clipRect defId itemH@(WItemHandle {wItemKind=wItemKind,wItemPos=wItemPos,wItemSize=wItemSize}) clipRgn
				  | okItem = do
					  itemRgn <- clipItem wPtr (0,0) clipRect (toTuple wItemPos) (toTuple wItemSize)
					  diffRgn <- osDiffRgn clipRgn itemRgn					  
					  osDisposeRgn clipRgn
					  osDisposeRgn itemRgn
					  return (itemH,diffRgn)
			  		  where
					    (okItem,clipItem) = case wItemKind of
						IsPopUpControl		-> (True,osClipPopUpControl)
						IsSliderControl		-> (True,osClipSliderControl)
						IsTextControl		-> (True,osClipTextControl)
						IsEditControl		-> (True,osClipEditControl)
						IsButtonControl		-> (True,osClipButtonControl)
						IsCustomButtonControl	-> (True,osClipCustomButtonControl)
						IsCustomControl		-> (True,osClipCustomControl)
						_			-> (False,undefined)

			  createWItemClipState _ _ _ _ _ _ itemH clipRgn = return (itemH,clipRgn)

		  createWElementClipState wMetrics allClipStates validate wPtr clipRect defId isVisible (WListLSHandle itemHs) clipRgn = do
			  (itemHs1,clipRgn1) <- createWElementsClipState wMetrics allClipStates validate wPtr clipRect defId isVisible itemHs clipRgn
			  return (WListLSHandle itemHs1,clipRgn1)

		  createWElementClipState wMetrics allClipStates validate wPtr clipRect defId isVisible (WExtendLSHandle exLS itemHs) clipRgn = do
			  (itemHs1,clipRgn1) <- createWElementsClipState wMetrics allClipStates validate wPtr clipRect defId isVisible itemHs clipRgn
			  return (WExtendLSHandle exLS itemHs1,clipRgn1)

		  createWElementClipState wMetrics allClipStates validate wPtr clipRect defId isVisible (WChangeLSHandle chLS itemHs) clipRgn = do
			  (itemHs1,clipRgn1) <- createWElementsClipState wMetrics allClipStates validate wPtr clipRect defId isVisible itemHs clipRgn
			  return (WChangeLSHandle chLS itemHs1,clipRgn1)
	
	    createWElementsClipState _ _ _ _ _ _ _ itemHs clipRgn =
		return (itemHs,clipRgn)


disposeClipState :: ClipState -> IO ()
disposeClipState (ClipState{clipRgn=clipRgn})
	| clipRgn==nullPtr = return ()
	| otherwise        = osDisposeRgn clipRgn


{-	validateAllClipStates(`) validate wPtr defaultId isVisible items
		checks for all items if the ClipState of CompoundControls is valid.
		If validate holds, then the ClipState is checked, otherwise the ClipState is disposed and recalculated(!!).
-}
validateAllClipStates :: OSWindowMetrics -> Bool -> OSWindowPtr -> Maybe Id -> Bool -> [WElementHandle ls ps] -> IO [WElementHandle ls ps]
validateAllClipStates wMetrics validate wPtr defaultId isVisible itemHs =
    mapM (validateClipState wMetrics validate wPtr defaultId isVisible) itemHs
    where
	validateClipState :: OSWindowMetrics -> Bool -> OSWindowPtr -> Maybe Id -> Bool -> WElementHandle ls ps -> IO (WElementHandle ls ps)
	validateClipState wMetrics validate wPtr defaultId isVisible itemH@(WItemHandle {wItemKind=wItemKind})
	    | wItemKind /= IsCompoundControl =
		    if isRecursiveControl wItemKind then do		-- PA: added for LayoutControls
			itemHs <- mapM (validateClipState wMetrics validate wPtr defaultId itemVisible) (wItems itemH)
			return (itemH{wItems=itemHs})
		    else
			return itemH
	    | validate = validateCompoundClipState wMetrics True wPtr defaultId itemVisible itemH
	    | otherwise = forceValidCompoundClipState wMetrics True wPtr defaultId itemVisible itemH
	    where
		itemVisible			= isVisible && wItemShow itemH
	
	validateClipState wMetrics validate wPtr defaultId isVisible (WListLSHandle itemHs) = do
		itemHs <- mapM (validateClipState wMetrics validate wPtr defaultId isVisible) itemHs
		return (WListLSHandle itemHs)

	validateClipState wMetrics validate wPtr defaultId isVisible (WExtendLSHandle exLS itemHs) = do
		itemHs <- mapM (validateClipState wMetrics validate wPtr defaultId isVisible) itemHs
		return (WExtendLSHandle exLS itemHs)

	validateClipState wMetrics validate wPtr defaultId isVisible (WChangeLSHandle chLS itemHs) = do
		itemHs <- mapM (validateClipState wMetrics validate wPtr defaultId isVisible) itemHs
		return (WChangeLSHandle chLS itemHs)


validateWindowClipState :: OSWindowMetrics -> Bool -> OSWindowPtr -> WindowHandle ls ps -> IO (WindowHandle ls ps)
validateWindowClipState wMetrics allClipStates wPtr wH@(WindowHandle {whKind=whKind,whWindowInfo=windowInfo,whItems=whItems,whSize=whSize,whDefaultId=whDefaultId,whShow=whShow})
	| whKind==IsDialog =
		if not allClipStates then return wH
		else do
		  itemHs <- validateAllClipStates wMetrics True wPtr whDefaultId whShow whItems
		  return (wH{whItems=itemHs})
	| clipOk clipState =
		if not allClipStates then return wH
		else do
		  itemHs <- validateAllClipStates wMetrics True wPtr whDefaultId whShow whItems
		  return (wH{whItems=itemHs})
	| otherwise = do		
		disposeClipState clipState
		(newClipState,itemHs) <- createClipState wMetrics allClipStates True wPtr contentRect whDefaultId whShow whItems		
		return (wH{whItems=itemHs,whWindowInfo=windowInfo{windowClip=newClipState}})
	where
	  clipState	= windowClip windowInfo
	  domainRect	= windowDomain windowInfo
	  hasScrolls	= (isJust (windowHScroll windowInfo), isJust (windowVScroll windowInfo))
	  visScrolls	= osScrollbarsAreVisible wMetrics domainRect (toTuple whSize) hasScrolls
	  contentRect	= getWindowContentRect wMetrics visScrolls (sizeToRect whSize)

forceValidWindowClipState :: OSWindowMetrics -> Bool -> OSWindowPtr -> WindowHandle ls ps -> IO (WindowHandle ls ps)
forceValidWindowClipState wMetrics allClipStates wPtr wH@(WindowHandle {whKind=whKind,whWindowInfo=windowInfo,whItems=whItems,whSize=whSize,whDefaultId=whDefaultId,whShow=whShow})
	| whKind == IsDialog =
		if not allClipStates then return wH
		else do
		  itemHs <- validateAllClipStates wMetrics False wPtr whDefaultId whShow whItems
		  return (wH{whItems=itemHs})
	| otherwise = do		
		disposeClipState (windowClip windowInfo)
		(clipState,itemHs) <- createClipState wMetrics allClipStates False wPtr contentRect whDefaultId whShow whItems		
		return (wH{whItems=itemHs,whWindowInfo=windowInfo{windowClip=clipState}})
	where
	  domainRect	= windowDomain windowInfo
	  hasScrolls	= (isJust (windowHScroll windowInfo), isJust (windowVScroll windowInfo))
	  visScrolls	= osScrollbarsAreVisible wMetrics domainRect (toTuple whSize) hasScrolls
	  contentRect	= getWindowContentRect wMetrics visScrolls (sizeToRect whSize)

invalidateWindowClipState :: WindowHandle ls ps -> WindowHandle ls ps
invalidateWindowClipState wH@(WindowHandle {whKind=whKind,whWindowInfo=windowInfo})
	| whKind==IsWindow =
		let clipState  = windowClip windowInfo
		in wH{whWindowInfo=windowInfo {windowClip=clipState{clipOk=False}}}
	| otherwise = wH

validateCompoundClipState :: OSWindowMetrics -> Bool -> OSWindowPtr -> Maybe Id -> Bool -> WElementHandle ls ps -> IO (WElementHandle ls ps)
validateCompoundClipState wMetrics allClipStates wPtr defId isVisible itemH@(WItemHandle {wItemShow=wItemShow,wItemPos=wItemPos,wItemSize=wItemSize,wItemInfo=wItemInfo,wItems=wItems})
	| clipOk clipState =
		if not allClipStates then return itemH
		else do
		   itemHs <- validateAllClipStates wMetrics True wPtr defId itemVisible wItems
		   return (itemH{wItems=itemHs})
	| otherwise = do		
		disposeClipState clipState
		(newClipState,itemHs) <- createClipState wMetrics allClipStates True wPtr contentRect defId itemVisible wItems		
		let compoundInfo1 = compoundInfo{compoundLookInfo=compoundLook{compoundClip=newClipState}}
		return (itemH{wItemInfo=WCompoundInfo compoundInfo1,wItems=itemHs})
	where
	  itemVisible		= isVisible && wItemShow
	  compoundInfo		= getWItemCompoundInfo wItemInfo
	  compoundLook		= compoundLookInfo compoundInfo
	  clipState		= compoundClip compoundLook
	  domainRect		= compoundDomain compoundInfo
	  hasScrolls		= (isJust (compoundHScroll compoundInfo), isJust (compoundVScroll compoundInfo))
	  visScrolls		= osScrollbarsAreVisible wMetrics domainRect (toTuple wItemSize) hasScrolls
	  contentRect		= getCompoundContentRect wMetrics visScrolls (posSizeToRect wItemPos wItemSize)

forceValidCompoundClipState :: OSWindowMetrics -> Bool -> OSWindowPtr -> Maybe Id -> Bool -> WElementHandle ls ps -> IO (WElementHandle ls ps)
forceValidCompoundClipState wMetrics allClipStates wPtr defId isVisible itemH@(WItemHandle {wItemShow=wItemShow,wItemPos=wItemPos,wItemSize=wItemSize,wItemInfo=wItemInfo,wItems=wItems}) = do	
	disposeClipState (compoundClip compoundLook)
	(clipState,itemHs) <- createClipState wMetrics allClipStates False wPtr contentRect defId itemVisible wItems	
	let compoundInfo1 = compoundInfo{compoundLookInfo=compoundLook{compoundClip=clipState}}
	return (itemH{wItemInfo=WCompoundInfo compoundInfo1,wItems=itemHs})
	where
	  itemVisible		= isVisible && wItemShow
	  compoundInfo		= getWItemCompoundInfo wItemInfo
	  compoundLook		= compoundLookInfo compoundInfo	  
	  domainRect		= compoundDomain compoundInfo
	  hasScrolls		= (isJust (compoundHScroll compoundInfo), isJust (compoundVScroll compoundInfo))
	  visScrolls		= osScrollbarsAreVisible wMetrics domainRect (toTuple wItemSize) hasScrolls
	  contentRect		= getCompoundContentRect wMetrics visScrolls (posSizeToRect wItemPos wItemSize)

invalidateCompoundClipState :: WElementHandle ls ps -> WElementHandle ls ps
invalidateCompoundClipState itemH@(WItemHandle {wItemInfo=wItemInfo}) =
	let compoundInfo = getWItemCompoundInfo wItemInfo
	    compoundLook = compoundLookInfo compoundInfo
	    clipState	 = compoundClip compoundLook
	in (itemH{wItemInfo=WCompoundInfo compoundInfo{compoundLookInfo=compoundLook{compoundClip=clipState{clipOk=False}}}})