-------------------------------------------------------------------------------- {-| Module : Controls Copyright : (c) Daan Leijen 2003 License : wxWindows Maintainer : wxhaskell-devel@lists.sourceforge.net Stability : provisional Portability : portable -} -------------------------------------------------------------------------------- module Graphics.UI.WXCore.Controls ( -- * Log textCtrlMakeLogActiveTarget , logDeleteAndSetActiveTarget -- * Tree control , TreeCookie , treeCtrlGetChildCookie, treeCtrlGetNextChild2 , treeCtrlWithChildren, treeCtrlGetChildren , treeCtrlGetSelections2 -- * Wrappers , listBoxGetSelectionList , execClipBoardData -- * Deprecated , wxcAppUSleep ) where import Graphics.UI.WXCore.WxcTypes import Graphics.UI.WXCore.WxcDefs import Graphics.UI.WXCore.WxcClasses import Graphics.UI.WXCore.Types import Foreign.Storable import Foreign.Marshal.Array import Foreign.Marshal.Utils -- | Get the selections of a tree control. treeCtrlGetSelections2 :: TreeCtrl a -> IO [TreeItem] treeCtrlGetSelections2 treeCtrl = do xs <- treeCtrlGetSelections treeCtrl return (map treeItemFromInt xs) -- | Represents the children of a tree control. data TreeCookie = TreeCookie (Var Cookie) data Cookie = Cookie TreeItem | CookieFirst TreeItem | CookieInvalid -- | Get a @TreeCookie@ to iterate through the children of tree node. treeCtrlGetChildCookie :: TreeCtrl a -> TreeItem -> IO TreeCookie treeCtrlGetChildCookie treeCtrl parent = do pcookie <- varCreate (CookieFirst parent) return (TreeCookie pcookie) -- | Get the next child of a tree node. Returns 'Nothing' when -- the end of the list is reached. This also invalidates the tree cookie. treeCtrlGetNextChild2 :: TreeCtrl a -> TreeCookie -> IO (Maybe TreeItem) treeCtrlGetNextChild2 treeCtrl treeCookie@(TreeCookie pcookie) = do cookie <- varGet pcookie case cookie of CookieInvalid -> return Nothing CookieFirst item -> with 0 $ \pint -> do first <- treeCtrlGetFirstChild treeCtrl item pint if (treeItemIsOk first) then do varSet pcookie (Cookie first) return (Just first) else do varSet pcookie (CookieInvalid) return Nothing Cookie item -> do next <- treeCtrlGetNextSibling treeCtrl item if (treeItemIsOk next) then do varSet pcookie (Cookie next) return (Just next) else do varSet pcookie (CookieInvalid) return Nothing -- | Iterate on the list of children of a tree node. treeCtrlWithChildren :: TreeCtrl a -> TreeItem -> (TreeItem -> IO b) -> IO [b] treeCtrlWithChildren treeCtrl parent f = do cookie <- treeCtrlGetChildCookie treeCtrl parent let walk acc = do mbitem <- treeCtrlGetNextChild2 treeCtrl cookie case mbitem of Nothing -> return (reverse acc) Just item -> do x <- f item walk (x:acc) walk [] -- | Get the children of tree node. treeCtrlGetChildren :: TreeCtrl a -> TreeItem -> IO [TreeItem] treeCtrlGetChildren treeCtrl item = treeCtrlWithChildren treeCtrl item return -- | -- | Return the current selection in a listbox. listBoxGetSelectionList :: ListBox a -> IO [Int] listBoxGetSelectionList listBox = do n <- listBoxGetSelections listBox ptrNull 0 let count = abs n allocaArray count $ \carr -> do listBoxGetSelections listBox carr count xs <- peekArray count carr return (map fromCInt xs) -- | Sets the active log target and deletes the old one. logDeleteAndSetActiveTarget :: Log a -> IO () logDeleteAndSetActiveTarget log = do oldlog <- logSetActiveTarget log when (not (objectIsNull oldlog)) (logDelete oldlog) -- | Set a text control as a log target. textCtrlMakeLogActiveTarget :: TextCtrl a -> IO () textCtrlMakeLogActiveTarget textCtrl = do log <- logTextCtrlCreate textCtrl logDeleteAndSetActiveTarget log -- | Use a 'clipboardSetData' or 'clipboardGetData' in this function. But don't -- use long computation in this function. Because this function encloses the -- computation with 'clipboardOpen' and 'clipboardClose', and wxHaskell uses -- Global clipboard on your environment. So, long computation causes problem. execClipBoardData :: Clipboard a -> (Clipboard a -> IO b) -> IO b execClipBoardData cl event = bracket_ (clipboardOpen cl) (clipboardClose cl) (event cl) {-# DEPRECATED wxcAppUSleep "Use wxcAppMilliSleep instead" #-} -- | This function just left for backward-compatiblity. -- Update your code to use 'wxcAppMilliSleep' instead. wxcAppUSleep :: Int -> IO () wxcAppUSleep = wxcAppMilliSleep