module WindowUpdate( updateWindow, updateWindowBackgrounds
		   , updateRectControls, updateWindowBackground
		   , updateControls
		   ) where


--  ********************************************************************************
--  Clean to Haskell Standard Object I/O library, version 1.2
--  
--  WindowUpdate contains the window update functions.
--  ********************************************************************************

import	OSPicture
import	OSRgn
import	OSWindow
import	CommonDef
import	DeviceEvents
import	WindowHandle
import	WindowAccess(getWItemCompoundInfo, getWItemCustomButtonInfo, getWItemCustomInfo,
			getCompoundContentRect, getWindowContentRect, getCompoundHScrollRect, getCompoundVScrollRect)
import	WindowClipState(validateWindowClipState)
import  StdPicture(toRegion, accClipPicture)
import  Control.Monad(when)
import  Foreign.Ptr(nullPtr)


windowupdateFatalError :: String -> String -> x
windowupdateFatalError rule error = dumpFatalError rule "windowupdate" error


--	updateWindow updates the window, using the UpdateInfo argument. 

updateWindow :: OSWindowMetrics -> UpdateInfo -> WindowHandle ls ps -> IO (WindowHandle ls ps)
updateWindow wMetrics info@(UpdateInfo {updWIDS=WIDS{wPtr=wPtr},updGContext=updGContext}) wH = do
	wH1 <- validateWindowClipState wMetrics False wPtr wH
	osPict <- getUpdateContext wPtr updGContext
	wH2 <- updateWindowBackground wMetrics False Nothing info wH1 osPict
	wH3 <- updateControls wMetrics info wH2 osPict
	setUpdateContext wPtr updGContext osPict
	return wH3
	where
	    getUpdateContext :: OSWindowPtr -> Maybe OSPictContext -> IO OSPictContext
	    getUpdateContext _ (Just osPict) = return osPict
	    getUpdateContext wPtr _ = osGrabWindowPictContext wPtr
	
	    setUpdateContext :: OSWindowPtr -> Maybe OSPictContext -> OSPictContext -> IO ()
	    setUpdateContext wPtr updContext osPict
		| isJust updContext = return ()
		| otherwise	    = osReleaseWindowPictContext wPtr osPict


{-	updateWindowBackgrounds redraws the (window/compound) backgrounds that are inside the OSRgnHandle argument.
	After redrawing the OSRgnHandle argument is disposed!
-}
updateWindowBackgrounds :: OSWindowMetrics -> OSRgnHandle -> WIDS -> WindowHandle ls ps -> IO (WindowHandle ls ps)
updateWindowBackgrounds wMetrics backgrRgn wids@(WIDS {wPtr=wPtr}) wH@(WindowHandle {whItems=whItems,whSelect=whSelect,whSize=whSize,whWindowInfo=whWindowInfo}) = do
    (_,backgrRect) <- osGetRgnBox backgrRgn
    (if isEmptyRect backgrRect then osDisposeRgn backgrRgn >> return wH
     else do
	let updInfo = UpdateInfo
	      { updWIDS       = wids
	      , updWindowArea	= backgrRect
	      , updControls	= []
	      , updGContext	= Nothing
	      }
	osPict <- osGrabWindowPictContext wPtr	    
	wH1 <- updateWindowBackground wMetrics True (Just backgrRgn) updInfo wH osPict
	backgrRgn1 <- updateControlBackgrounds wMetrics backgrRgn wH1 osPict
	osReleaseWindowPictContext wPtr osPict
	osDisposeRgn backgrRgn1
	return wH1)
    where
	pen = case whWindowInfo of
		WindowInfo{windowLook=look} -> lookPen look
		NoWindowInfo 		    -> defaultPen
	
	updateControlBackgrounds :: OSWindowMetrics -> OSRgnHandle -> WindowHandle ls ps -> OSPictContext -> IO OSRgnHandle
	updateControlBackgrounds wMetrics backgrRgn wH@(WindowHandle {whItems=whItems,whSelect=whSelect,whSize=whSize}) osPict = do
	    updateBackgrounds wMetrics (sizeToRect whSize) whSelect backgrRgn whItems osPict
	    where
		updateBackgrounds :: OSWindowMetrics -> Rect -> Bool -> OSRgnHandle -> [WElementHandle ls ps] -> OSPictContext -> IO OSRgnHandle
		updateBackgrounds wMetrics wFrame ableContext backgrRgn itemHs osPict = do
		    empty <- osIsEmptyRgn backgrRgn
		    (if empty || null itemHs then return backgrRgn
		     else do
			backgrRgn <- updateBackground  wMetrics wFrame ableContext backgrRgn (head itemHs) osPict
			backgrRgn <- updateBackgrounds wMetrics wFrame ableContext backgrRgn (tail itemHs) osPict
			return backgrRgn)
		    where
			updateBackground :: OSWindowMetrics -> Rect -> Bool -> OSRgnHandle -> WElementHandle ls ps -> OSPictContext -> IO OSRgnHandle
			updateBackground wMetrics wFrame ableContext backgrRgn itemH@(WItemHandle {wItemShow=wItemShow,wItemVirtual=wItemVirtual,wItemKind=wItemKind,wItemPos=wItemPos,wItemSize=wItemSize}) osPict
			    | not wItemShow || wItemVirtual || not (isRecursiveControl wItemKind) =	-- PA: isRecursive includes also LayoutControls
				    return backgrRgn
			    | otherwise = do
				    (_, backgrRect) <- osGetRgnBox backgrRgn
				    let compoundRect = posSizeToRect wItemPos wItemSize
				    (if disjointRects backgrRect compoundRect then
				       return backgrRgn
				     else updateCompoundBackground wMetrics wFrame compoundRect ableContext backgrRgn itemH osPict)
			    where
				updateCompoundBackground :: OSWindowMetrics -> Rect -> Rect -> Bool -> OSRgnHandle -> WElementHandle ls ps -> OSPictContext -> IO OSRgnHandle
				updateCompoundBackground wMetrics wFrame compoundRect ableContext backgrRgn itemH@(WItemHandle {wItemKind=IsLayoutControl,wItems=wItems}) osPict = do
				    backgrRgn <- updateBackgrounds wMetrics cFrame cAble backgrRgn wItems osPict
				    rectRgn	<- osNewRectRgn cFrame
				    diffRgn <- osDiffRgn backgrRgn rectRgn
				    mapM_ osDisposeRgn [rectRgn,backgrRgn]
				    return diffRgn
				    where
					cFrame = intersectRects wFrame compoundRect
					cAble  = ableContext && wItemSelect itemH
				updateCompoundBackground wMetrics wFrame compoundRect ableContext backgrRgn itemH@(WItemHandle {wItemKind=IsCompoundControl,wItems=wItems,wItemPos=itemPos,wItemSize=itemSize}) osPict = do
				    updRgn <- osSectRgn backgrRgn (clipRgn clipInfo)
				    empty <- osIsEmptyRgn updRgn
				    (if empty then do
					backgrRgn <- updateBackgrounds wMetrics cFrame cAble backgrRgn wItems osPict
					rectRgn <- osNewRectRgn cFrame
					diffRgn <- osDiffRgn backgrRgn rectRgn
					mapM_ osDisposeRgn [rectRgn,backgrRgn,updRgn]
					return diffRgn
				     else do					
					(x,_,_,_) <- doDraw (origin-itemPos) lookPen True osPict (clipOSPicture updRgn contentRect (lookFun (if cAble then Able else Unable) updState))
					backgrRgn <- updateBackgrounds wMetrics cFrame cAble backgrRgn wItems osPict
					rectRgn <- osNewRectRgn cFrame
					diffRgn <- osDiffRgn backgrRgn rectRgn
					mapM_ osDisposeRgn [rectRgn,backgrRgn,updRgn]
					return diffRgn)
				    where				
					info		= getWItemCompoundInfo (wItemInfo itemH)
					compLookInfo	= compoundLookInfo info
					LookInfo{lookFun=lookFun,lookPen=lookPen} = compoundLook compLookInfo
					clipInfo	= compoundClip compLookInfo
					origin		= compoundOrigin info
					domainRect	= compoundDomain info
					hasScrolls	= (isJust (compoundHScroll info),isJust (compoundVScroll info))
					visScrolls	= osScrollbarsAreVisible wMetrics domainRect (toTuple itemSize) hasScrolls
					contentRect	= getCompoundContentRect wMetrics visScrolls compoundRect
					cFrame		= intersectRects wFrame contentRect
					cAble		= ableContext && wItemSelect itemH
					updFrame	= rectToRectangle cFrame
					updState	= UpdateState{oldFrame=updFrame,newFrame=updFrame,updArea=[updFrame]}

					clipOSPicture :: OSRgnHandle -> Rect -> Draw () -> Draw ()
					clipOSPicture newClipRgn rect drawf = do
					    rectRgn <- liftIO (osNewRectRgn rect)
					    curClipRgn <- pictGetClipRgn
					    (if curClipRgn==nullPtr then pictSetClipRgn else pictAndClipRgn) rectRgn
					    pictAndClipRgn newClipRgn
					    drawf
					    pictSetClipRgn curClipRgn
					    liftIO (when (curClipRgn/=nullPtr) (osDisposeRgn curClipRgn) >> osDisposeRgn rectRgn)

			        updateCompoundBackground _ _ _ _ _ WItemHandle {wItemKind=wItemKind} _ =
				    windowupdateFatalError "updateCompoundBackground (updateWindowBackgrounds)" ("unexpected control kind: " ++ show wItemKind)
			
			updateBackground wMetrics wFrame ableContext backgrRgn (WListLSHandle itemHs) osPict = do
				updateBackgrounds wMetrics wFrame ableContext backgrRgn itemHs osPict				
			
			updateBackground wMetrics wFrame ableContext backgrRgn (WExtendLSHandle exLS itemHs) osPict = do
				updateBackgrounds wMetrics wFrame ableContext backgrRgn itemHs osPict				
			
			updateBackground wMetrics wFrame ableContext backgrRgn (WChangeLSHandle chLS itemHs) osPict = do
				updateBackgrounds wMetrics wFrame ableContext backgrRgn itemHs osPict				


{-	updateRectControls updates the controls that fit in the Rect argument of the indicated window or compound control. 
	The Rect is in window/compound coordinates. 
-}
updateRectControls :: OSWindowMetrics -> Rect -> OSWindowPtr -> WindowHandle ls ps -> IO (WindowHandle ls ps)
updateRectControls wMetrics area wPtr wH@(WindowHandle {whItems=whItems,whSelect=whSelect})
    | isEmptyRect area = return wH
    | otherwise = do
	itemHs <- updateControlsInRect wMetrics wPtr whSelect area whItems
	return (wH{whItems=itemHs})
    where
	updateControlsInRect :: OSWindowMetrics -> OSWindowPtr -> Bool -> Rect -> [WElementHandle ls ps] -> IO [WElementHandle ls ps]
	updateControlsInRect wMetrics parentPtr ableContext area itemHs
	    | isEmptyRect area || null itemHs = return itemHs
	    | otherwise = do
		itemH  <- updateControlInRect  wMetrics parentPtr ableContext area (head itemHs)
		itemHs <- updateControlsInRect wMetrics parentPtr ableContext area (tail itemHs)
		return (itemH:itemHs)
	    where
		updateControlInRect :: OSWindowMetrics -> OSWindowPtr -> Bool -> Rect -> WElementHandle ls ps -> IO (WElementHandle ls ps)
		updateControlInRect wMetrics parentPtr ableContext area itemH@(WItemHandle {wItemKind=wItemKind,wItemPtr=wItemPtr,wItemPos=wItemPos,wItemSize=wItemSize,wItemShow=wItemShow,wItemVirtual=wItemVirtual})
		    | not wItemShow || wItemVirtual || isEmptyRect intersectRect || wItemKind == IsReceiverControl =
			    return itemH
		    | isCustomControl = updateCustomControl wMetrics parentPtr ableContext intersectRect itemH
		    | isOSControl = do
		            updateOSControl (subVector (toVector wItemPos) intersectRect) parentPtr wItemPtr
		            return itemH
		    | isRecursiveControl wItemKind	= do -- This includes LayoutControl and excludes CompoundControl which is already guarded as iscustomcontrol
			    let ableContext1 = ableContext && wItemSelect itemH
			    itemHs <- updateControlsInRect wMetrics parentPtr ableContext1 area (wItems itemH) -- PA: shouldn't area be clipped (also below at updatecustomcontrol?)
			    return (itemH{wItems=itemHs})
		    | otherwise	-- This alternative should never be reached
			    = windowupdateFatalError "updateControlInRect" "unexpected ControlKind"
		    where
			controlRect		= posSizeToRect wItemPos wItemSize
			intersectRect		= intersectRects area controlRect
			isCustomControl		= case wItemKind of
				IsCustomButtonControl	-> True
				IsCustomControl		-> True
				IsCompoundControl	-> True
				_			-> False			
			(isOSControl,updateOSControl) = case wItemKind of
				IsRadioControl		-> (True,osUpdateRadioControl)
				IsCheckControl		-> (True,osUpdateCheckControl)
				IsPopUpControl		-> (True,osUpdatePopUpControl)
				IsSliderControl		-> (True,osUpdateSliderControl)
				IsTextControl		-> (True,osUpdateTextControl)
				IsEditControl		-> (True,osUpdateEditControl)
				IsButtonControl		-> (True,osUpdateButtonControl)
				_			-> (False,undefined)
			
	--		updatecustomcontrol updates a ((Custom)Button/Compound)Control.
			updateCustomControl :: OSWindowMetrics -> OSWindowPtr -> Bool -> Rect -> WElementHandle ls ps -> IO (WElementHandle ls ps)
			updateCustomControl _ parentPtr contextAble area itemH@(WItemHandle {wItemKind=IsCustomButtonControl, wItemSize=wItemSize, wItemPos=wItemPos, wItemPtr=itemPtr}) = do
			    osPict <- osGrabControlPictContext parentPtr itemPtr
			    (_,_,pen,_) <- doDraw zero (lookPen lookInfo) True osPict (accClipPicture (toRegion updArea) (lookFun lookInfo selectState updState))
			    let info1 = info{cButtonInfoLook=lookInfo{lookPen=pen}}
			    osReleaseControlPictContext itemPtr osPict
			    osValidateWindowRect itemPtr areaLocal
			    return (itemH{wItemInfo=WCustomButtonInfo info1})
			    where
				selectState	= if (contextAble && wItemSelect itemH) then Able else Unable
				info		= getWItemCustomButtonInfo (wItemInfo itemH)
				lookInfo	= cButtonInfoLook info
				areaLocal	= subVector (toVector wItemPos) area
				cFrame		= sizeToRectangle wItemSize
				updArea		= rectToRectangle areaLocal
				updState	= UpdateState{oldFrame=cFrame,newFrame=cFrame,updArea=[updArea]}
			
			updateCustomControl _ parentPtr contextAble area itemH@(WItemHandle {wItemKind=IsCustomControl,wItemSize=wItemSize,wItemPtr=itemPtr,wItemPos=itemPos}) = do
			    osPict <- osGrabControlPictContext parentPtr itemPtr			    
			    (_,_,pen,_) <- doDraw zero (lookPen lookInfo) True osPict (accClipPicture (toRegion updArea) (lookFun lookInfo selectState updState))			    
			    let info1 = info{customInfoLook=lookInfo{lookPen=pen}}
			    osReleaseControlPictContext itemPtr osPict
			    osValidateWindowRect itemPtr areaLocal
			    return (itemH{wItemInfo=WCustomInfo info1})
			    where
				selectState	= if (contextAble && wItemSelect itemH) then Able else Unable
				info		= getWItemCustomInfo (wItemInfo itemH)
				lookInfo	= customInfoLook info
				areaLocal	= subVector (toVector itemPos) area
				cFrame		= sizeToRectangle wItemSize
				updArea		= rectToRectangle areaLocal
				updState	= UpdateState{oldFrame=cFrame,newFrame=cFrame,updArea=[updArea]}
			
			updateCustomControl wMetrics parentPtr contextAble area itemH@(WItemHandle {wItemKind=IsCompoundControl,wItems=wItems,wItemSize=itemSize,wItemPtr=itemPtr,wItemPos=itemPos}) = do
			    osPict <- osGrabControlPictContext parentPtr itemPtr			    
			    (_,_,pen,_) <- doDraw origin (lookPen lookInfo) True osPict (accClipPicture (toRegion updArea) (lookFun lookInfo selectState updState))			    
			    let info1 = info{compoundLookInfo=compLookInfo{compoundLook=lookInfo{lookPen=pen}}}
			    osReleaseControlPictContext itemPtr osPict
			    updateScrollAreas
			    itemHs <- updateControlsInRect wMetrics parentPtr compoundAble area wItems
			    osValidateWindowRect itemPtr areaLocal
			    return (itemH{wItemInfo=WCompoundInfo info1,wItems=itemHs})
			    where				
				compoundAble	= contextAble && wItemSelect itemH
				selectState	= if compoundAble then Able else Unable
				info		= getWItemCompoundInfo (wItemInfo itemH)
				compLookInfo	= compoundLookInfo info
				lookInfo	= compoundLook compLookInfo
				(origin,domainRect,hasScrolls) = (compoundOrigin info,compoundDomain info,(isJust (compoundHScroll info),isJust (compoundVScroll info)))
				visScrolls	= osScrollbarsAreVisible wMetrics domainRect (toTuple itemSize) hasScrolls
				contentRect	= getCompoundContentRect wMetrics visScrolls (posSizeToRect origin itemSize)
				areaLocal	= subVector (toVector itemPos) area
				cFrame		= rectToRectangle contentRect
				updArea		= rectToRectangle (intersectRects contentRect (subVector (toVector (itemPos-origin)) area))
				updState	= UpdateState {oldFrame=cFrame,newFrame=cFrame,updArea=[updArea]}
				
				updateScrollAreas = if emptyH && emptyV then return () else
						    (if emptyH	then (osUpdateCompoundControl updVRect parentPtr itemPtr) else
						     (if emptyV	then (osUpdateCompoundControl updHRect parentPtr itemPtr) else
						      ((osUpdateCompoundControl (updVRect{rbottom=rbottom updHRect}) parentPtr itemPtr) >>
						       (osUpdateCompoundControl updHRect parentPtr itemPtr))))
				itemRect	= posSizeToRect itemPos itemSize
				hRect		= getCompoundHScrollRect wMetrics hasScrolls itemRect
				vRect		= getCompoundVScrollRect wMetrics hasScrolls itemRect
				updHRect	= intersectRects hRect area
				updVRect	= intersectRects vRect area
				emptyH		= isEmptyRect updHRect
				emptyV		= isEmptyRect updVRect
			
			updateCustomControl _ _ _ _ (WItemHandle {wItemKind=wItemKind}) =
				windowupdateFatalError "updateCustomControl" ("unexpected ControlKind: " ++ show wItemKind)
		
		updateControlInRect wMetrics parentPtr ableContext area (WListLSHandle itemHs) = do
		    itemHs <- updateControlsInRect wMetrics parentPtr ableContext area itemHs
		    return (WListLSHandle itemHs)
		
		updateControlInRect wMetrics parentPtr ableContext area (WExtendLSHandle exLS itemHs) = do
		    itemHs <- updateControlsInRect wMetrics parentPtr ableContext area itemHs
		    return (WExtendLSHandle exLS itemHs)
		
		updateControlInRect wMetrics parentPtr ableContext area (WChangeLSHandle chLS itemHs) = do
		    itemHs <- updateControlsInRect wMetrics parentPtr ableContext area itemHs
		    return (WChangeLSHandle chLS itemHs)
			

{-	updateBackground updates the background of the window.
-}
updateWindowBackground :: OSWindowMetrics -> Bool -> Maybe OSRgnHandle -> UpdateInfo -> WindowHandle ls ps -> OSPictContext -> IO (WindowHandle ls ps)
updateWindowBackground wMetrics pictureInitialised alsoClipRgn info@(UpdateInfo {updWIDS=WIDS{wPtr=wPtr}}) wH@(WindowHandle {whKind=whKind,whWindowInfo=windowInfo,whSize=whSize}) osPict
    | isEmptyRect updRect || whKind /= IsWindow =		-- Nothing to update at all
	    return wH
    | isEmptyRect updAreaRect =					-- Nothing to update inside viewframe
	    return wH
    | otherwise = do	    
	    let drawf = do
		curClipRgn <- pictGetClipRgn		
		(if curClipRgn==nullPtr then pictSetClipRgn else pictAndClipRgn) (clipRgn clipState)		   
		(case alsoClipRgn of
			Just clip	-> pictAndClipRgn clip
		    	_		-> return ())
		setPictOrigin origin
		accClipPicture (toRegion updArea) (lookFun lookInfo selectState updState)
		pictSetClipRgn curClipRgn
		liftIO (when (curClipRgn/=nullPtr) (osDisposeRgn curClipRgn))	    
	    (_,_,pen,_) <- doDraw zero initPen True osPict drawf
	    return (wH{whWindowInfo=windowInfo{windowLook=lookInfo{lookPen=pen}}})
    where
	updRect				= updWindowArea info	
	(origin,domainRect,hasScrolls)	= (windowOrigin windowInfo,windowDomain windowInfo,(isJust (windowHScroll windowInfo),isJust (windowVScroll windowInfo)))
	visScrolls			= osScrollbarsAreVisible wMetrics domainRect (toTuple whSize) hasScrolls
	wFrameRect			= posSizeToRect origin (rectSize (getWindowContentRect wMetrics visScrolls (sizeToRect whSize)))
	wFrame				= rectToRectangle wFrameRect
	updAreaRect			= intersectRects wFrameRect (addVector (toVector origin) updRect)
	updArea				= rectToRectangle updAreaRect
	updState			= UpdateState{oldFrame=wFrame,newFrame=wFrame,updArea=[updArea]}
	lookInfo			= windowLook windowInfo
	clipState			= windowClip windowInfo
	selectState			= if whSelect wH then Able else Unable
	initPen				= lookPen lookInfo


-- 	updatecontrols updates the controls that are registered for update in UpdateInfo.

updateControls :: OSWindowMetrics -> UpdateInfo -> WindowHandle ls ps -> OSPictContext -> IO (WindowHandle ls ps)
updateControls wMetrics info@(UpdateInfo {updWIDS=updWIDS,updControls=updControls}) wH@(WindowHandle {whSelect=whSelect,whItems=whItems}) osPict = do
    (_,itemHs) <- updateControls wMetrics updWIDS whSelect updControls whItems osPict
    return (wH{whItems=itemHs})
    where
	updateControls :: OSWindowMetrics -> WIDS -> Bool -> [ControlUpdateInfo] -> [WElementHandle ls ps] -> OSPictContext -> IO ([ControlUpdateInfo],[WElementHandle ls ps])
	updateControls wMetrics wids contextAble updControls itemHs osPict
	    | null updControls || null itemHs = return (updControls,itemHs)
	    | otherwise = do			
		  (updControls1,itemH1) <- updateControl  wMetrics wids contextAble updControls  (head itemHs) osPict
		  (updControls2,itemHs1) <- updateControls wMetrics wids contextAble updControls1 (tail itemHs) osPict
		  return (updControls2,itemH1:itemHs1)
	    where
		updateControl :: OSWindowMetrics -> WIDS -> Bool -> [ControlUpdateInfo] -> WElementHandle ls ps -> OSPictContext -> IO ([ControlUpdateInfo], WElementHandle ls ps)
		updateControl wMetrics wids contextAble updControls itemH@(WItemHandle {wItemShow=wItemShow}) osPict = do
		    updateControl' wMetrics wids contextAble updControls itemH osPict		    
		    where
			updateControl' :: OSWindowMetrics -> WIDS -> Bool -> [ControlUpdateInfo] -> WElementHandle ls ps -> OSPictContext -> IO ([ControlUpdateInfo], WElementHandle ls ps)
			updateControl' wMetrics wids contextAble updControls itemH@(WItemHandle {wItemNr=wItemNr}) osPict = do
			    let (found,updInfo,updControls1) = remove (\ControlUpdateInfo{cuItemNr=cuItemNr}->cuItemNr==wItemNr) undefined updControls
			    (updControls2,itemHs) <- updateControls wMetrics wids (contextAble && wItemSelect itemH) updControls1 (wItems itemH) osPict
			    let itemH1 = itemH{wItems=itemHs}
			    (if not found then return (updControls2,itemH1)
			     else do
				 itemH <- updateControl'' wMetrics wids contextAble (cuArea updInfo) itemH1 osPict
				 return (updControls2,itemH))
			    where
				updateControl'' :: OSWindowMetrics -> WIDS -> Bool -> Rect -> WElementHandle ls ps -> OSPictContext -> IO (WElementHandle ls ps)
				updateControl'' wMetrics wids contextAble area itemH@(WItemHandle {wItemKind=IsCustomButtonControl}) osPict = do				    
				    (_,_,pen,_) <- doDraw zero (lookPen lookInfo) True osPict (accClipPicture (toRegion cFrame) (lookFun lookInfo selectState updState))				    
				    let info1 = info{cButtonInfoLook=lookInfo{lookPen=pen}}
				    return (itemH{wItemInfo=WCustomButtonInfo info1})
				    where
					selectState	= if (contextAble && wItemSelect itemH) then Able else Unable
					info		= getWItemCustomButtonInfo (wItemInfo itemH)
					lookInfo	= cButtonInfoLook info
					cFrame		= sizeToRectangle (wItemSize itemH)
					updArea		= rectToRectangle (subVector (toVector (wItemPos itemH)) area)
					updState	= UpdateState{oldFrame=cFrame,newFrame=cFrame,updArea=[updArea]}
				
				updateControl'' wMetrics wids contextAble area itemH@(WItemHandle {wItemKind=IsCustomControl}) osPict = do				    
				    (_,_,pen,_) <- doDraw zero (lookPen lookInfo) True osPict (accClipPicture (toRegion cFrame) (lookFun lookInfo selectState updState))
				    let info1 = info{customInfoLook=lookInfo{lookPen=pen}}
				    return (itemH{wItemInfo=WCustomInfo info1})
				    where
					selectState	= if (contextAble && wItemSelect itemH) then Able else Unable
					info		= getWItemCustomInfo (wItemInfo itemH)
					lookInfo	= customInfoLook info
					cFrame		= sizeToRectangle (wItemSize itemH)
					updArea		= rectToRectangle (subVector (toVector (wItemPos itemH)) area)
					updState	= UpdateState{oldFrame=cFrame,newFrame=cFrame,updArea=[updArea]}
				
				updateControl'' wMetrics wids contextAble area itemH@(WItemHandle {wItemKind=IsCompoundControl}) osPict = do				    
				    (_,_,pen,_) <- doDraw origin (lookPen lookInfo) True osPict (accClipPicture (toRegion cFrame) (lookFun lookInfo selectState updState))
				    let info1 = info{compoundLookInfo=compLookInfo{compoundLook=lookInfo{lookPen=pen}}}
				    return (itemH{wItemInfo=WCompoundInfo info1})
				    where
					selectState	= if contextAble && wItemSelect itemH then Able else Unable
					itemSize	= wItemSize itemH
					itemPos		= wItemPos itemH
					info		= getWItemCompoundInfo (wItemInfo itemH)
					domainRect	= compoundDomain info
					hasScrolls	= (isJust (compoundHScroll info),isJust (compoundVScroll info))
					visScrolls	= osScrollbarsAreVisible wMetrics domainRect (toTuple itemSize) hasScrolls
					compLookInfo	= compoundLookInfo info
					lookInfo	= compoundLook compLookInfo
					origin		= compoundOrigin info
					cFrame		= posSizeToRectangle origin (rectSize (getCompoundContentRect wMetrics visScrolls (sizeToRect itemSize)))
					updArea		= rectToRectangle (intersectRects (rectangleToRect cFrame) (addVector (toVector (origin-itemPos)) area))
					updState	= UpdateState{oldFrame=cFrame,newFrame=cFrame,updArea=[updArea]}
				
				updateControl'' _ wids contextAble area itemH@(WItemHandle {wItemKind=IsRadioControl}) osPict = do
					osUpdateRadioControl area (wPtr wids) (wItemPtr itemH)
					return itemH
				
				updateControl'' _ wids contextAble area itemH@(WItemHandle {wItemKind=IsCheckControl}) osPict = do
					osUpdateCheckControl area (wPtr wids) (wItemPtr itemH)
					return itemH
				
				updateControl'' _ wids contextAble area itemH@(WItemHandle {wItemKind=IsPopUpControl}) osPict = do
					osUpdatePopUpControl area (wPtr wids) (wItemPtr itemH)
					return itemH
				
				updateControl'' _ wids contextAble area itemH@(WItemHandle {wItemKind=IsSliderControl}) osPict = do
					osUpdateSliderControl area (wPtr wids) (wItemPtr itemH)
					return itemH
				
				updateControl'' _ wids contextAble area itemH@(WItemHandle {wItemKind=IsTextControl}) osPict = do
					osUpdateTextControl area (wPtr wids) (wItemPtr itemH)
					return itemH
				
				updateControl'' _ wids contextAble area itemH@(WItemHandle {wItemKind=IsEditControl}) osPict = do
					osUpdateEditControl area (wPtr wids) (wItemPtr itemH)
					return itemH
				
				updateControl'' _ wids contextAble area itemH@(WItemHandle {wItemKind=IsButtonControl}) osPict = do
					osUpdateButtonControl area (wPtr wids) (wItemPtr itemH)
					return itemH
				
				updateControl'' _ _ _ _ itemH@(WItemHandle {wItemKind=IsReceiverControl}) osPict =
					return itemH
				
				updateControl'' _ _ _ _ itemH@(WItemHandle {wItemKind=IsLayoutControl}) _ =
					windowupdateFatalError "updatecontrols (updateControl``)" "LayoutControl should never be updated"
		
		updateControl wMetrics wids contextAble updControls (WListLSHandle itemHs) osPict = do
		    (updControls1,itemHs1) <- updateControls wMetrics wids contextAble updControls itemHs osPict
		    return (updControls1,WListLSHandle itemHs1)
		
		updateControl wMetrics wids contextAble updControls (WExtendLSHandle exLS itemHs) osPict = do
		    (updControls1,itemHs1) <- updateControls wMetrics wids contextAble updControls itemHs osPict
		    return (updControls1,WExtendLSHandle exLS itemHs1)
		
		updateControl wMetrics wids contextAble updControls (WChangeLSHandle chLS itemHs) osPict = do
		    (updControls1,itemHs1) <- updateControls wMetrics wids contextAble updControls itemHs osPict
		    return (updControls1,WChangeLSHandle chLS itemHs1)
