manatee-core-0.0.2: Manatee/Toolkit/Gtk/ModelView.hs
-- Author: Andy Stewart <lazycat.manatee@gmail.com>
-- Maintainer: Andy Stewart <lazycat.manatee@gmail.com>
--
-- Copyright (C) 2010 Andy Stewart, all rights reserved.
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
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
-- | Focus first toplevel node.
-- It focus first node if model is list model.
treeViewFocusFirstToplevelNode :: TreeViewClass view => view -> IO ()
treeViewFocusFirstToplevelNode view =
treeViewSetCursor view [0] Nothing
-- | Focus last toplevel node.
-- It focus last node if model is list model.
treeViewFocusLastToplevelNode :: TreeViewClass view => view -> IO ()
treeViewFocusLastToplevelNode view =
treeViewApplyModel view $ \model -> do
lastPath <- treeModelLastToplevelPath model
treeViewSetCursor view lastPath Nothing
-- | Get number of toplevel node in TreeView.
treeViewGetToplevelNodeCount :: TreeViewClass view => view -> IO Int
treeViewGetToplevelNodeCount view = do
model <- treeViewGetModel view
case model of
Just ml -> treeModelGetToplevelNodeCount ml
Nothing -> return 0
-- | Get number of toplevel node in TreeModel.
treeModelGetToplevelNodeCount :: TreeModelClass model => model -> IO Int
treeModelGetToplevelNodeCount model =
treeModelIterNChildren model Nothing
-- | Apply treeView model.
treeViewApplyModel :: TreeViewClass view => view -> (TreeModel -> IO ()) -> IO ()
treeViewApplyModel view f =
treeViewGetModel view >?>= f
-- | Get current selection.
-- Don't *store* TreeIter, it's wrong value after model change.
-- It's should just as a argument for another IO function.
treeViewGetSelectedPath :: TreeViewClass view => view -> IO (Maybe TreePath)
treeViewGetSelectedPath view =
fmap maybeHead $
treeViewGetSelection view
>>= treeSelectionGetSelectedRows
-- | Get tree coordinate of cell.
treeViewGetCellTreeCoordinate :: TreeViewClass view => view -> Maybe TreePath -> TreeViewColumn -> IO Rectangle
treeViewGetCellTreeCoordinate view treePath column = do
-- Get coordinate relative to *visible area* of tree.
(Rectangle cx cy cw ch) <- treeViewGetBackgroundArea view treePath column
-- Try to get adjustment value.
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
-- Because `treeViewGetSelectedBound` just return coordinate
-- relative to visible area of tree.
-- For get coordinate relative to full scrollable area of tree,
-- We need add value of adjustment.
return (Rectangle (cx + adjustX) (cy + adjustY) cw ch)
-- | Get selection bound.
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)
-- | Get selection widget coordinate.
treeViewGetSelectedWidgetCoordinate :: TreeViewClass view => view -> IO (Maybe Rectangle)
treeViewGetSelectedWidgetCoordinate view =
treeViewGetSelectedTreeCoordidnate view
>?>=> \(Rectangle rx ry rw rh) -> do
-- Transform tree coordinate to widget coordinate.
(wx, wy) <- treeViewConvertTreeToWidgetCoords view (rx, ry)
return $ Just (Rectangle wx wy rw rh)
-- | Focus next toplevel node.
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
-- | Focus prev toplevel node.
-- Return True if focus prev toplevel node,
-- Otherwise return False.
treeViewFocusPrevToplevelNode :: TreeViewClass view => view -> IO ()
treeViewFocusPrevToplevelNode view =
treeViewGetSelectedPath view
>?>= \ currentPath -> do
let currentRootNode = head currentPath
when (currentRootNode > 0) $
treeViewSetCursor view [currentRootNode - 1] Nothing
-- | Last toplevel node path of TreeModel.
treeModelLastToplevelPath :: TreeModelClass model => model -> IO TreePath
treeModelLastToplevelPath model = do
number <- treeModelGetToplevelNodeCount model
return $ if number > 0 then [number - 1] else [0]
-- | Whether at first toplevel node?
-- It at first node if model is list model.
treeViewAtFirstToplevelNode :: TreeViewClass view => view -> IO Bool
treeViewAtFirstToplevelNode view = do
currentPath <- treeViewGetSelectedPath view
return $ case currentPath of
Just cp -> head cp == 0
Nothing -> False
-- | Whether at last toplevel node?
-- It at last node if model is list model.
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
-- | Remove all column's from treeView.
treeViewRemoveColumns :: TreeViewClass self => self -> IO ()
treeViewRemoveColumns treeView =
mapM_ (treeViewRemoveColumn treeView)
=<< treeViewGetColumns treeView
-- | Have cell columns.
treeViewHaveColumn :: TreeViewClass self => self -> IO Bool
treeViewHaveColumn treeView =
has <$> treeViewGetColumns treeView
-- | Un-select all.
treeViewUnselectAll :: TreeViewClass view => view -> IO ()
treeViewUnselectAll view =
treeViewGetSelection view
>>= treeSelectionUnselectAll
-- | Get default cell height.
treeViewGetDefaultCellHeight :: TreeViewClass view => view -> IO (Maybe Int)
treeViewGetDefaultCellHeight view =
treeViewGetColumn view 0
>?>=> \col ->
(Just . rectangleH) <$> treeViewGetBackgroundArea view (Just [0]) col
-- | Get attribute of cursor cell.
treeViewGetSelectedCellArea :: TreeViewClass self => (Rectangle -> Int) -> self -> IO Int
treeViewGetSelectedCellArea f treeView = do
(path, column) <- treeViewGetCursor treeView
case column of
-- Get attribute.
Just c -> (return . f) =<< treeViewGetCellArea treeView (Just path) c
-- Otherwise return 0.
Nothing -> return 0
-- | Get current cell height.
treeViewGetSelectedCellHeight :: TreeViewClass view => view -> IO Int
treeViewGetSelectedCellHeight = treeViewGetSelectedCellArea rectangleH
-- | Get current cell height.
treeViewGetSelectedCellY :: TreeViewClass view => view -> IO Int
treeViewGetSelectedCellY = treeViewGetSelectedCellArea rectangleY
-- | Get header height.
treeViewGetHeaderHeight :: TreeViewClass self => self -> IO Int
treeViewGetHeaderHeight treeView = do
(_, by) <- treeViewConvertTreeToBinWindowCoords treeView (0, 0)
(_, wy) <- treeViewConvertTreeToWidgetCoords treeView (0, 0)
return $ wy - by
-- | Focus TreeView and keep current selected position.
treeViewFocus :: TreeViewClass self => self -> IO ()
treeViewFocus view = do
selectedPath <- treeViewGetSelectedPath view
let focusPath = fromMaybe [0] selectedPath
treeViewSetCursor view focusPath Nothing
widgetGrabFocus view
-- | Scroll vertical.
treeViewScrollVertical :: (TreeViewClass self, ScrolledWindowClass swc) => self -> swc -> Double -> IO ()
treeViewScrollVertical view swc increment = do
-- Get adjustment arguments.
aj <- scrolledWindowGetVAdjustment swc
ps <- adjustmentGetPageSize aj
vl <- adjustmentGetValue aj
ur <- adjustmentGetUpper aj
lr <- adjustmentGetLower aj
-- Get y coordinate and height of cell.
cellY <- do
cy <- treeViewGetSelectedCellY view
-- Transform to tree coordinate for compare with adjustment value.
(i2d . snd) <$> treeViewConvertBinWindowToTreeCoords view (0, cy)
ch <- treeViewGetSelectedCellHeight view
let cellH = i2d ch
-- Update adjustment value.
let inc = i2d $ floorToMultiple (truncate increment) ch
iv = vl + inc
top = if inc >= 0
then min iv $ ur - cellH -- don't bigger than upper value when scroll up
else max iv lr -- don't less than lower value when scroll down
bottom = top + ps
-- Calculate new y coordinate when cell at outside of visible area.
let adjustY | top >= cellY = Just topY
| bottom <= cellY + cellH = Just bottomY
| otherwise = Nothing
where topY = top + 1
bottomY = i2d $ floorToMultiple (truncate bottom) ch - 1
-- Selected new cell when got new y coordinate.
adjustY ?>= \ y -> do
p <- treeViewConvertTreeToBinWindowCoords view (0, truncate y)
treeViewGetPathAtPos view p >?>=
\ (path, _, _) -> treeViewSetCursor view path Nothing
-- Set adjustment.
adjustmentSetValue aj top
treeViewAddColumnWithTitle :: TreeViewClass self => self -> String -> SortColumnId -> IO TreeViewColumn
treeViewAddColumnWithTitle treeView title sortId = do
-- Get treeViewColumn.
tvc <- treeViewColumnNew
treeViewAppendColumn treeView tvc
-- Set attribute.
set tvc [treeViewColumnTitle := title
,treeViewColumnResizable := True
,treeViewColumnSortIndicator := True
,treeViewColumnSortColumnId := sortId]
return tvc
-- | Get row.
treeModelSortGetRow :: (TreeModelSortClass self,
TypedTreeModelClass model)
=> model row
-> self
-> TreeIter
-> IO row
treeModelSortGetRow model =
(<=<) (treeModelGetRow model) . treeModelSortConvertIterToChildIter
-- | Get next sort path.
-- Pass unsorted path to get next path in the given sorted model.
-- Very useful to track path after change sort rule.
treeViewNextSortPath :: (TreeViewClass view
,TreeModelClass sortModel
,TreeModelSortClass sortModel)
=> view
-> sortModel
-> TreePath
-> IO TreePath
treeViewNextSortPath treeView sortModel path = do
-- Converts the given path to a path relative to the given sorted model.
currentIndex <- liftM head $ treeModelSortConvertChildPathToPath sortModel path
-- Get tree view size and index of next path.
size <- treeViewGetToplevelNodeCount treeView
let nextIndex = if currentIndex >= size - 1
then 0
else currentIndex + 1
-- Converts path in the sorted model to a path on the unsorted model on which the given TreeModelSort is based.
treeModelSortConvertPathToChildPath sortModel [nextIndex]
-- | Get previous sort path.
-- Pass unsorted path to get previous path in the given sorted model.
-- Very useful to track path after change sort rule.
treeViewPrevSortPath :: (TreeViewClass view
,TreeModelClass sortModel
,TreeModelSortClass sortModel)
=> view
-> sortModel
-> TreePath
-> IO TreePath
treeViewPrevSortPath treeView sortModel path = do
-- Converts the given path to a path relative to the given sorted model.
currentIndex <- liftM head $ treeModelSortConvertChildPathToPath sortModel path
-- Get tree view size and index of prev path.
size <- treeViewGetToplevelNodeCount treeView
let prevIndex = if currentIndex <= 0
then size - 1
else currentIndex - 1
-- Converts path in the sorted model to a path on the unsorted model on which the given TreeModelSort is based.
treeModelSortConvertPathToChildPath sortModel [prevIndex]
-- | Get current value.
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)