lhae-0.0.2: src/Controller/Grid.hs

module Controller.Grid (new,changePageEventHandler
                       ,setFilePath,deleteCurrent,changePageTo
                       ,writeCell,writeCells
                       ,updateRowLabel,updateColumnLabel
                       ,updateRowLabels,updateColumnLabels
                       ,markAsSaved)
    where

import Control.Monad.Reader
import qualified Graphics.UI.WXCore as WXC
import Controller (Controller,onView,onModel,onGridModel,onGridView)
import Controller.Cell (updateInView,showContent,showSelectedContent)
import Controller.Menu.Table.Add (addRow,addColumn)
import View (onGrid,info)
import qualified View.GridPage as GridPage
import View.Component.Grid (getRowLabel,getColumnLabel,numDataRows
                           ,numDataColumns)
import qualified View.Component.Grid as GridV
import View.Dialog.Simple (input)
import View.Modes (formulaMode)
import qualified Model as M
import qualified Model.Grid as GridM
import qualified Model.Cell as Cell
import System.FilePath (takeFileName)
import Util (justWhen)
import CellCoordinate (CellCoord)
import View.FormulaInput (logString)

new :: Maybe FilePath -> Controller ()
new filePath = 
    let addModel id = 
            do viewInfo <- onView $ return . info
               onModel $ M.addGrid id viewInfo
               justWhen filePath $ onGridModel . GridM.setFilePath

        addView grid =
            do onView $ GridPage.add (fmap takeFileName filePath) grid
               ctrl <- ask
               onView $ \view -> 
                   onGrid view $ \grid ->
                       do WXC.gridOnGridEvent grid $ \event -> 
                              runReaderT (eventHandler event) ctrl
                          WXC.windowOnKeyDown grid 
                                 $ GridPage.keyEventHandler view
    in do
      (gridViewId,gridView) <- onView GridPage.new
      addModel gridViewId
      addView gridView

setFilePath :: FilePath -> Controller ()
setFilePath filePath = do
  onView $ GridPage.setCurrentCaption $ takeFileName filePath
  onGridModel $ GridM.setFilePath filePath

markAsUnsaved :: Controller ()
markAsUnsaved = do
  caption <- onView GridPage.getCurrentCaption
  when (head caption /= '*') 
           $ onView $ GridPage.setCurrentCaption $ '*':caption

markAsSaved :: Controller ()
markAsSaved = do
  x:xs <- onView GridPage.getCurrentCaption
  when (x == '*') $ onView $ GridPage.setCurrentCaption xs

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 ""

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.MouseLeftDClick {}) -> 
            do value <- if col == -1
                        then onGridView $ getRowLabel row
                        else onGridView $ getColumnLabel col
               value' <- onView $ input "Label" value
               justWhen value' $ if col == -1
                                 then updateRowLabel row
                                 else updateColumnLabel col

        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

changePageEventHandler :: Controller ()
changePageEventHandler = do
  Just n <- onView $ GridPage.currentSelectionNum
  Just id <- onView $ GridPage.currentSelectionId
  onView $ GridPage.setCurrent n
  onModel $ M.setCurrent id  
  showSelectedContent

changePageTo :: Int -> Controller ()
changePageTo = onView . GridPage.fireSelectionEvent

extendWhenClicked :: CellCoord -> Controller ()
extendWhenClicked (row,column) = do
  rows <- onGridView GridV.numDataRows
  cols <- onGridView GridV.numDataColumns
  when (row == rows) $ addRow Nothing
  when (column == cols) $ addColumn Nothing

updateRowLabel,updateColumnLabel :: Int -> String -> Controller ()
updateRowLabel n to = do
  changed <- onGridModel $ GridM.updateRowLabel n to
  onGridView $ GridV.setRowLabel n to
  updateInView changed
  showSelectedContent
  markAsUnsaved
updateColumnLabel n to = do
  changed <- onGridModel $ GridM.updateColumnLabel n to
  onGridView $ GridV.setColumnLabel n to
  updateInView changed
  showSelectedContent
  markAsUnsaved

updateRowLabels,updateColumnLabels :: [String] -> Controller ()
updateRowLabels labels = do
  n <- onGridView numDataRows
  forM_ (zip [0..n-1] labels) $ uncurry updateRowLabel
updateColumnLabels labels = do
  n <- onGridView numDataColumns
  forM_ (zip [0..n-1] labels) $ uncurry updateColumnLabel

writeCell :: CellCoord -> String -> Controller ()
writeCell coord input = writeCells [(coord,input)]

writeCells :: [(CellCoord,String)] -> Controller ()
writeCells [] = return ()
writeCells cells = 
    let (maxRow,maxCol) = maximum $ map fst cells
    in do
      rows <- onGridView numDataRows
      cols <- onGridView numDataColumns

      forM_ [rows..maxRow] $ \_ -> addRow Nothing
      forM_ [cols..maxCol] $ \_ -> addColumn Nothing

      forM_ cells $ \(coord,input) -> do
         changed <- onGridModel $ GridM.setCell coord input
         updateInView changed

      markAsUnsaved