module Manatee.Toolkit.Gtk.ModelView where
import Control.Applicative hiding (empty)
import Control.Monad
import Data.Maybe
import Graphics.UI.Gtk
import Manatee.Toolkit.General.Basic
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Maybe
import Manatee.Toolkit.Gtk.Gtk
treeViewFocusFirstToplevelNode :: TreeViewClass view => view -> IO ()
treeViewFocusFirstToplevelNode view =
treeViewSetCursor view [0] Nothing
treeViewFocusLastToplevelNode :: TreeViewClass view => view -> IO ()
treeViewFocusLastToplevelNode view =
treeViewApplyModel view $ \model -> do
lastPath <- treeModelLastToplevelPath model
treeViewSetCursor view lastPath Nothing
treeViewGetToplevelNodeCount :: TreeViewClass view => view -> IO Int
treeViewGetToplevelNodeCount view = do
model <- treeViewGetModel view
case model of
Just ml -> treeModelGetToplevelNodeCount ml
Nothing -> return 0
treeModelGetToplevelNodeCount :: TreeModelClass model => model -> IO Int
treeModelGetToplevelNodeCount model =
treeModelIterNChildren model Nothing
treeViewApplyModel :: TreeViewClass view => view -> (TreeModel -> IO ()) -> IO ()
treeViewApplyModel view f =
treeViewGetModel view >?>= f
treeViewGetSelectedPath :: TreeViewClass view => view -> IO (Maybe TreePath)
treeViewGetSelectedPath view =
fmap maybeHead $
treeViewGetSelection view
>>= treeSelectionGetSelectedRows
treeViewGetCellTreeCoordinate :: TreeViewClass view => view -> Maybe TreePath -> TreeViewColumn -> IO Rectangle
treeViewGetCellTreeCoordinate view treePath column = do
(Rectangle cx cy cw ch) <- treeViewGetBackgroundArea view treePath column
hAdjust <- treeViewGetHAdjustment view
adjustX <- case hAdjust of
Just ha -> ceiling <$> adjustmentGetValue ha
Nothing -> return 0
vAdjust <- treeViewGetVAdjustment view
adjustY <- case vAdjust of
Just va -> ceiling <$> adjustmentGetValue va
Nothing -> return 0
return (Rectangle (cx + adjustX) (cy + adjustY) cw ch)
treeViewGetSelectedTreeCoordidnate :: TreeViewClass view => view -> IO (Maybe Rectangle)
treeViewGetSelectedTreeCoordidnate view = do
treePath <- treeViewGetSelectedPath view
treePath
?>=> \ tp -> treeViewGetColumn view 0
>?>=> (\x -> Just <$> treeViewGetCellTreeCoordinate view (Just tp) x)
treeViewGetSelectedWidgetCoordinate :: TreeViewClass view => view -> IO (Maybe Rectangle)
treeViewGetSelectedWidgetCoordinate view =
treeViewGetSelectedTreeCoordidnate view
>?>=> \(Rectangle rx ry rw rh) -> do
(wx, wy) <- treeViewConvertTreeToWidgetCoords view (rx, ry)
return $ Just (Rectangle wx wy rw rh)
treeViewFocusNextToplevelNode :: TreeViewClass view => view -> IO ()
treeViewFocusNextToplevelNode view =
treeViewGetSelectedPath view
>?>= \ currentPath -> do
number <- treeViewGetToplevelNodeCount view
let currentRootNode = head currentPath
when (currentRootNode < number 1) $
treeViewSetCursor view [currentRootNode + 1] Nothing
treeViewFocusPrevToplevelNode :: TreeViewClass view => view -> IO ()
treeViewFocusPrevToplevelNode view =
treeViewGetSelectedPath view
>?>= \ currentPath -> do
let currentRootNode = head currentPath
when (currentRootNode > 0) $
treeViewSetCursor view [currentRootNode 1] Nothing
treeModelLastToplevelPath :: TreeModelClass model => model -> IO TreePath
treeModelLastToplevelPath model = do
number <- treeModelGetToplevelNodeCount model
return $ if number > 0 then [number 1] else [0]
treeViewAtFirstToplevelNode :: TreeViewClass view => view -> IO Bool
treeViewAtFirstToplevelNode view = do
currentPath <- treeViewGetSelectedPath view
return $ case currentPath of
Just cp -> head cp == 0
Nothing -> False
treeViewAtLastToplevelNode :: TreeViewClass view => view -> IO Bool
treeViewAtLastToplevelNode view = do
currentPath <- treeViewGetSelectedPath view
nodeCount <- treeViewGetToplevelNodeCount view
return $ case currentPath of
Just cp -> head cp == nodeCount 1
Nothing -> False
treeViewRemoveColumns :: TreeViewClass self => self -> IO ()
treeViewRemoveColumns treeView =
mapM_ (treeViewRemoveColumn treeView)
=<< treeViewGetColumns treeView
treeViewHaveColumn :: TreeViewClass self => self -> IO Bool
treeViewHaveColumn treeView =
has <$> treeViewGetColumns treeView
treeViewUnselectAll :: TreeViewClass view => view -> IO ()
treeViewUnselectAll view =
treeViewGetSelection view
>>= treeSelectionUnselectAll
treeViewGetDefaultCellHeight :: TreeViewClass view => view -> IO (Maybe Int)
treeViewGetDefaultCellHeight view =
treeViewGetColumn view 0
>?>=> \col ->
(Just . rectangleH) <$> treeViewGetBackgroundArea view (Just [0]) col
treeViewGetSelectedCellArea :: TreeViewClass self => (Rectangle -> Int) -> self -> IO Int
treeViewGetSelectedCellArea f treeView = do
(path, column) <- treeViewGetCursor treeView
case column of
Just c -> (return . f) =<< treeViewGetCellArea treeView (Just path) c
Nothing -> return 0
treeViewGetSelectedCellHeight :: TreeViewClass view => view -> IO Int
treeViewGetSelectedCellHeight = treeViewGetSelectedCellArea rectangleH
treeViewGetSelectedCellY :: TreeViewClass view => view -> IO Int
treeViewGetSelectedCellY = treeViewGetSelectedCellArea rectangleY
treeViewGetHeaderHeight :: TreeViewClass self => self -> IO Int
treeViewGetHeaderHeight treeView = do
(_, by) <- treeViewConvertTreeToBinWindowCoords treeView (0, 0)
(_, wy) <- treeViewConvertTreeToWidgetCoords treeView (0, 0)
return $ wy by
treeViewFocus :: TreeViewClass self => self -> IO ()
treeViewFocus view = do
selectedPath <- treeViewGetSelectedPath view
let focusPath = fromMaybe [0] selectedPath
treeViewSetCursor view focusPath Nothing
widgetGrabFocus view
treeViewScrollVertical :: (TreeViewClass self, ScrolledWindowClass swc) => self -> swc -> Double -> IO ()
treeViewScrollVertical view swc increment = do
aj <- scrolledWindowGetVAdjustment swc
ps <- adjustmentGetPageSize aj
vl <- adjustmentGetValue aj
ur <- adjustmentGetUpper aj
lr <- adjustmentGetLower aj
cellY <- do
cy <- treeViewGetSelectedCellY view
(i2d . snd) <$> treeViewConvertBinWindowToTreeCoords view (0, cy)
ch <- treeViewGetSelectedCellHeight view
let cellH = i2d ch
let inc = i2d $ floorToMultiple (truncate increment) ch
iv = vl + inc
top = if inc >= 0
then min iv $ ur cellH
else max iv lr
bottom = top + ps
let adjustY | top >= cellY = Just topY
| bottom <= cellY + cellH = Just bottomY
| otherwise = Nothing
where topY = top + 1
bottomY = i2d $ floorToMultiple (truncate bottom) ch 1
adjustY ?>= \ y -> do
p <- treeViewConvertTreeToBinWindowCoords view (0, truncate y)
treeViewGetPathAtPos view p >?>=
\ (path, _, _) -> treeViewSetCursor view path Nothing
adjustmentSetValue aj top
treeViewAddColumnWithTitle :: TreeViewClass self => self -> String -> SortColumnId -> IO TreeViewColumn
treeViewAddColumnWithTitle treeView title sortId = do
tvc <- treeViewColumnNew
treeViewAppendColumn treeView tvc
set tvc [treeViewColumnTitle := title
,treeViewColumnResizable := True
,treeViewColumnSortIndicator := True
,treeViewColumnSortColumnId := sortId]
return tvc
treeModelSortGetRow :: (TreeModelSortClass self,
TypedTreeModelClass model)
=> model row
-> self
-> TreeIter
-> IO row
treeModelSortGetRow model =
(<=<) (treeModelGetRow model) . treeModelSortConvertIterToChildIter
treeViewNextSortPath :: (TreeViewClass view
,TreeModelClass sortModel
,TreeModelSortClass sortModel)
=> view
-> sortModel
-> TreePath
-> IO TreePath
treeViewNextSortPath treeView sortModel path = do
currentIndex <- liftM head $ treeModelSortConvertChildPathToPath sortModel path
size <- treeViewGetToplevelNodeCount treeView
let nextIndex = if currentIndex >= size 1
then 0
else currentIndex + 1
treeModelSortConvertPathToChildPath sortModel [nextIndex]
treeViewPrevSortPath :: (TreeViewClass view
,TreeModelClass sortModel
,TreeModelSortClass sortModel)
=> view
-> sortModel
-> TreePath
-> IO TreePath
treeViewPrevSortPath treeView sortModel path = do
currentIndex <- liftM head $ treeModelSortConvertChildPathToPath sortModel path
size <- treeViewGetToplevelNodeCount treeView
let prevIndex = if currentIndex <= 0
then size 1
else currentIndex 1
treeModelSortConvertPathToChildPath sortModel [prevIndex]
treeViewGetSelectedValue :: (TreeViewClass view
,TreeModelSortClass self)
=> view
-> self
-> ListStore a
-> IO (Maybe a)
treeViewGetSelectedValue view sortModel listStore =
treeViewGetSelectedPath view
>?>=> \ path -> do
currentPath <- treeModelSortConvertPathToChildPath sortModel path
liftM Just $ listStoreGetValue listStore (head currentPath)