Grid.hs

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