module Controller.Grid (new,changePageEventHandler ,deleteCurrent,changePageTo ,writeCellInput,writeCellExpr ,addRows,addColumns,addNRows,addNColumns ,deleteRows,deleteColumns ,insertRow,insertColumn ,updateRowLabel,updateColumnLabel ,updateRowLabels,updateColumnLabels,batched) where import Control.Monad.Trans (liftIO) import Control.Monad (forM_,when) import Control.Applicative ((<$>)) import Data.Char (chr,ord) import Graphics.UI.WX (Prop ((:=)),on) import qualified Graphics.UI.WX as WX import qualified Graphics.UI.WXCore as WXC import Controller (Controller,onView,onModel,onGridModel,onGridView ,ctrlData,withCtrlData) import {-# SOURCE #-} qualified Controller.Menu.Table.Copy as Copy import {-# SOURCE #-} qualified Controller.Menu.Table.Delete as Delete import {-# SOURCE #-} qualified Controller.Menu.Table.Transpose as Transpose import {-# SOURCE #-} qualified Controller.Menu.Table.Rename as Rename import Controller.Cell (updateInView,showContent,showSelectedContent) import qualified Model as M import qualified Model.Cell as Cell import qualified Model.Grid as GridM import Model.CellContent (CellExpr) import qualified View.Component.Grid as GridV import View (frame,onGrid) import View.Modes (formulaMode) import qualified View.GridPage as GridPage import View.FormulaInput (logString) import qualified View.Dialog.Simple as Dialog import Util (justWhen,whenM) import I18n (__) import qualified ModelToView import CellCoordinate (CellCoord,coordRange) data LabelType = Row | Column data LabelClickInfo = LabelClickInfo { labelType :: LabelType , labelIndex :: Int , labelPoint :: WX.Point } data CellClickInfo = CellClickInfo { cellCoord :: CellCoord , cellPoint :: WX.Point } new :: Controller () new = let addModel id = do modelToView <- onView $ return . ModelToView.new onModel $ M.addGrid id modelToView addView grid = do onView $ GridPage.add grid ctrl <- ctrlData onView $ \view -> onGrid view $ \grid -> do WXC.gridOnGridEvent grid $ \event -> withCtrlData (eventHandler event) ctrl WXC.windowOnKeyDown grid $ GridPage.keyEventHandler view in do (gridViewId,gridView) <- onView GridPage.new addModel gridViewId addView gridView lastRow,lastColumn :: Int -> Controller Bool lastRow row = do rows <- onGridView GridV.numDataRows return $ row == rows lastColumn col = do cols <- onGridView GridV.numDataColumns return $ col == cols extendWhenClicked :: CellCoord -> Controller () extendWhenClicked (row,column) = do whenM (lastRow row) $ addNRows 1 whenM (lastColumn column) $ addNColumns 1 eventHandler :: WXC.EventGrid -> Controller () eventHandler event = case event of WXC.GridLabelMouse row col (WXC.MouseLeftDown {}) -> do extendWhenClicked (row,col) liftIO WXC.propagateEvent WXC.GridLabelMouse row col (WXC.MouseRightDown pt _) -> if col == -1 then whenM (not <$> lastRow row) $ labelClickDialog $ LabelClickInfo Row row pt else whenM (not <$> lastColumn col) $ labelClickDialog $ LabelClickInfo Column col pt WXC.GridCellMouse row col (WXC.MouseRightDown pt _) -> do lRow <- lastRow row lCol <- lastColumn col when (not lRow && not lCol) $ cellClickDialog $ CellClickInfo (row,col) pt WXC.GridCellMouse row col (WXC.MouseLeftDown {}) -> do extendWhenClicked (row,col) liftIO WXC.propagateEvent WXC.GridEditorShown row col veto -> do extendWhenClicked (row,col) cell <- onGridModel $ GridM.getCell (row,col) onView (formulaMode (row,col) $ Cell.input cell) liftIO veto WXC.GridCellSelect row col _ -> do showContent (row,col) liftIO WXC.propagateEvent _ -> liftIO WXC.propagateEvent labelClickDialog :: LabelClickInfo -> Controller () labelClickDialog info = do cData <- ctrlData let (copyLabel,deleteLabel,insertLabel,transposeLabel,renameLabel) = case labelType info of Row -> ( __ "Copy row" , __ "Delete row" , __ "Insert row" , __ "Transpose row" , __ "Rename row") Column -> ( __ "Copy column" , __ "Delete column" , __ "Insert column" , __ "Transpose column" , __ "Rename column") onCopy = case labelType info of Row -> Copy.rowEventHandlerWith [labelIndex info] Column -> Copy.columnEventHandlerWith [labelIndex info] onDelete = case labelType info of Row -> Delete.rowEventHandlerWith [labelIndex info] Column -> Delete.columnEventHandlerWith [labelIndex info] onInsert = do result <- onView $ Dialog.input insertLabel "" justWhen result $ \label -> case labelType info of Row -> insertRow label $ labelIndex info Column -> insertColumn label $ labelIndex info onTranspose = case labelType info of Row -> Transpose.rowEventHandlerWith [labelIndex info] Column -> Transpose.columnEventHandlerWith [labelIndex info] onRename = case labelType info of Row -> Rename.rowEventHandlerWith $ labelIndex info Column -> Rename.columnEventHandlerWith $ labelIndex info makeMenu = do menu <- WX.menuPane [] let makeItem label ctrl = WX.menuItem menu [ WX.text := label , on WX.command := withCtrlData ctrl cData] makeItem copyLabel onCopy makeItem deleteLabel onDelete makeItem insertLabel onInsert makeItem transposeLabel onTranspose makeItem renameLabel onRename return menu menu <- liftIO makeMenu onView $ WX.menuPopup menu (labelPoint info) . frame cellClickDialog :: CellClickInfo -> Controller () cellClickDialog info = do cData <- ctrlData let onCopy = Copy.formulaAtEventHandler $ cellCoord info makeMenu = do menu <- WX.menuPane [] WX.menuItem menu [ WX.text := __ "Copy formula" , on WX.command := withCtrlData onCopy cData] return menu menu <- liftIO makeMenu onView $ WX.menuPopup menu (cellPoint info) . frame changePageEventHandler :: Controller () changePageEventHandler = do Just n <- onView $ GridPage.currentSelectionNum Just id <- onView $ GridPage.currentSelectionId onView $ GridPage.setCurrent n onModel $ M.setCurrent id showSelectedContent deleteCurrent :: Controller () deleteCurrent = do onModel M.deleteCurrent onView GridPage.deleteCurrent next <- onView GridPage.currentSelectionId case next of Just n -> do onModel $ M.setCurrent n showSelectedContent Nothing -> onView $ logString "" changePageTo :: Int -> Controller () changePageTo = onView . GridPage.fireSelectionEvent extendWhenAddingCells :: [(CellCoord,a)] -> Controller () extendWhenAddingCells cells = let (maxRow,maxCol) = maximum $ map fst cells in do newRows <- do rows <- onGridView GridV.numDataRows return $ maxRow - rows + 1 newCols <- do cols <- onGridView GridV.numDataColumns return $ maxCol - cols + 1 when (newRows > 0) $ addNRows newRows when (newCols > 0) $ addNColumns newCols writeCellInput :: [(CellCoord,String)] -> Controller () writeCellInput [] = return () writeCellInput cells = do extendWhenAddingCells cells forM_ cells $ \(coord,input) -> do onGridModel (GridM.setCellInput coord input) >>= updateInView writeCellExpr :: [(CellCoord,CellExpr)] -> Controller () writeCellExpr [] = return () writeCellExpr cells = do extendWhenAddingCells cells forM_ cells $ \(coord,expr) -> do onGridModel (GridM.setCellExpr coord expr) >>= updateInView updateAllCellsInView :: Controller () updateAllCellsInView = do rows <- onGridView GridV.numDataRows cols <- onGridView GridV.numDataColumns updateInView $ coordRange ((0,0),(rows-1,cols-1)) {- Reihenfolge wichtig: 1. zu Model hinzufügen 2. zu View hinzufügen -} addRows,addColumns :: [String] -> Controller () addRows [] = return () addRows captions = do onGridModel $ GridM.addRows captions onGridView $ GridV.addRows captions updateAllCellsInView addColumns [] = return () addColumns captions = do onGridModel $ GridM.addColumns captions onGridView $ GridV.addColumns captions updateAllCellsInView addNRows,addNColumns :: Int -> Controller () addNRows n = do rows <- onGridView GridV.numDataRows addRows $ map show [rows+1..rows+n] addNColumns n = do cols <- onGridView GridV.numDataColumns addColumns $ map columnName [cols..cols+n-1] where columnName i = let number = (i `div` 26) + 1 in replicate number $ chr $ (i `mod` 26) + ord 'A' deleteRows,deleteColumns :: [Int] -> Controller () deleteRows rows = do onGridModel $ GridM.deleteRows rows onGridView $ GridV.deleteRows $ reverse rows updateAllCellsInView deleteColumns cols = do onGridModel $ GridM.deleteColumns cols onGridView $ GridV.deleteColumns $ reverse cols updateAllCellsInView insertRow,insertColumn :: String -> Int -> Controller () insertRow label i = do onGridView $ GridV.insertRowBefore label i onGridModel $ GridM.insertRowBefore label i updateAllCellsInView insertColumn label i = do onGridView $ GridV.insertColumnBefore label i onGridModel $ GridM.insertColumnBefore label i updateAllCellsInView updateRowLabel,updateColumnLabel :: Int -> String -> Controller () updateRowLabel n to = do changed <- onGridModel $ GridM.updateRowLabel n to onGridView $ GridV.setRowLabel n to updateInView changed showSelectedContent updateColumnLabel n to = do changed <- onGridModel $ GridM.updateColumnLabel n to onGridView $ GridV.setColumnLabel n to updateInView changed showSelectedContent updateRowLabels,updateColumnLabels :: [String] -> Controller () updateRowLabels labels = do n <- onGridView GridV.numDataRows forM_ (zip [0..n-1] labels) $ uncurry updateRowLabel updateColumnLabels labels = do n <- onGridView GridV.numDataColumns forM_ (zip [0..n-1] labels) $ uncurry updateColumnLabel batched :: Controller a -> Controller a batched doThis = do onGridView WXC.gridBeginBatch result <- doThis onGridView WXC.gridEndBatch return result