GridPage.hs

module View.GridPage (new,add,deleteCurrent,setCurrent
                     ,getCurrentCaption,setCurrentCaption
                     ,keyEventHandler,captions
                     ,currentSelectionNum,currentSelectionId,pageId
                     ,fireSelectionEvent
                     ,markAsUnsaved)
    where

import Control.Applicative ((<$>))
import Control.Monad (forM)
import qualified Graphics.UI.WX as WX
import qualified Graphics.UI.WXCore as WXC
import View (View,notebook,current,onGrid)
import Util (justWhen)
import View.Component.Notebook (GridId)
import qualified View.Component.Notebook as Notebook
import View.Component.Grid (Grid)
import qualified View.Component.Grid as Grid
import View.Modes (gridMode)

new :: View -> IO (GridId,Grid)
new view = do
  grid <- Grid.new (notebook view) []
  id <- WXC.windowGetId grid
  return (id,grid)

add :: Grid -> View -> IO ()
add grid view = 
    let nb = notebook view
    in do 
      caption <- do id <- show . abs <$> WXC.windowGetId grid
                    return $ unwords ["*unnamed","[" ++ id ++ "]"]
      Notebook.addGrid grid caption nb
      Notebook.currentSelectionNum nb >>= (\(Just n) -> setCurrent n view)

deleteCurrent :: View -> IO ()
deleteCurrent view = do
  currentStuff <- WX.varGet $ current view
  justWhen currentStuff $ \_ -> 
      do Notebook.deleteCurrentView $ notebook view
         next <- Notebook.currentSelectionNum $ notebook view
         case next of
           Nothing -> WX.varSet (current view) Nothing
           Just n -> setCurrent n view

setCurrent :: Int -> View -> IO ()
setCurrent n view = do
  grid <- Notebook.getGrid n $ notebook view
  WX.varSet (current view) $ Just grid
  gridMode view

fireSelectionEvent :: Int -> View -> IO ()
fireSelectionEvent n view = do
  _ <- WXC.notebookSetSelection (notebook view) n
  return ()

setCurrentCaption :: String -> View -> IO ()
setCurrentCaption c = Notebook.setCurrentCaption c . notebook

getCurrentCaption :: View -> IO String
getCurrentCaption = Notebook.getCurrentCaption . notebook

captions :: View -> IO [String]
captions view = do
  n <- WXC.notebookGetPageCount $ notebook view
  forM [0..n-1] $ WXC.notebookGetPageText $ notebook view

currentSelectionNum :: View -> IO (Maybe Int)
currentSelectionNum = Notebook.currentSelectionNum . notebook

currentSelectionId :: View -> IO (Maybe Int)
currentSelectionId = Notebook.currentSelectionId . notebook

pageId :: Int -> View -> IO Int
pageId n = Notebook.pageId n . notebook

keyEventHandler :: View -> WXC.EventKey -> IO ()
keyEventHandler view (WXC.EventKey key modifier _) = do
    case key of 
      WXC.KeyReturn -> 
          do isEnabled <- onGrid view WXC.gridIsCellEditControlEnabled
             onGrid view $ if isEnabled 
                           then flip WXC.gridEnableCellEditControl False
                           else flip WXC.gridEnableCellEditControl True
      WXC.KeyTab -> 
          case modifier of
            WXC.Modifiers {WXC.controlDown=True} ->
                 WXC.notebookAdvanceSelection (notebook view) True
            _ -> onGrid view Grid.cycleCursor
      WXC.KeyLeft -> WXC.propagateEvent
      WXC.KeyRight -> WXC.propagateEvent
      WXC.KeyUp -> WXC.propagateEvent
      WXC.KeyDown -> WXC.propagateEvent
      _ -> return ()

markAsUnsaved :: View -> IO ()
markAsUnsaved view = do
  caption <- getCurrentCaption view
  setCurrentCaption ('*':caption) view