Dialog.hs

module Controller.Dialog (openFileDialog,saveFileDialog
                         ,chooseColumnDialog
                         ,chooseColumnsDialog
                         ,chooseRowDialog
                         ,chooseRowsDialog
                         ,chooseColumnsAndTableDialog,chooseRowsAndTableDialog
                         ,previewImage,warning
                         ,nonNumericDataWarningText,nonNumericDataWarning
                         ,noColumnsSelectedText,noColumnsSelected
                         ,noRowsSelectedText,noRowsSelected
                         ,whenSure)
    where

import Control.Applicative ((<$>))
import Control.Monad (when)
import Graphics.UI.WX (Prop ((:=)),on)
import qualified Graphics.UI.WX as WX
import qualified Graphics.UI.WXCore as WXC
import System.FilePath (takeDirectory)
import Controller (Controller,onView,onGridView,setOnConfig,getFromConfig)
import View (View,frame)
import View.Component.Grid (getColumnLabels,getRowLabels)
import View.GridPage (captions)
import View.Dialog.Complex (Layout (..),Widget (..),Modifier (..)
                           ,showSimpleDialog,okButton,cancelButton)
import qualified View.Dialog.Simple as Simple
import Config (getLastHandledPathForDialogs,setLastHandledPath)
import Util (justWhen)
import I18n (__)

openFileDialog :: String -> [(String,[String])] -> Controller (Maybe FilePath)
openFileDialog caption filters = do
  lastPath <- getFromConfig getLastHandledPathForDialogs
  result <- onView $ \view -> 
            WX.fileOpenDialog (frame view) True True caption
            ((__ "Any file",["*"]) : filters) lastPath ""
  justWhen result $ setOnConfig . setLastHandledPath . takeDirectory
  return result

saveFileDialog :: String -> [(String,[String])] -> Controller (Maybe FilePath)
saveFileDialog caption filters = do
  lastPath <- getFromConfig getLastHandledPathForDialogs
  result <- onView $ \view -> 
            WX.fileSaveDialog (frame view) True True caption
            ((__ "Any file",["*"]) : filters) lastPath ""
  justWhen result $ setOnConfig . setLastHandledPath . takeDirectory
  return result

chooseOneFromListDialog :: String -> String -> String -> [String]
                        -> Maybe Int -> Controller (Maybe Int)
chooseOneFromListDialog dialogCaption listCaption okLabel list init =
    let listBox = SingleListBox list id $ \_ -> id
        dialog = Modifier Margin $ Column
          [ Modifier (Boxed listCaption) $ Modifier HFill $ Widget listBox
          , Modifier Center $ Row [ Widget $ DefaultButton okLabel ()
                                  , cancelButton]]
    in
      maybe Nothing id 
        <$> (onView $ showSimpleDialog dialogCaption dialog init)

chooseSomeFromListDialog :: String -> String -> String -> [String]
                         -> [Int] -> Controller [Int]
chooseSomeFromListDialog dialogCaption listCaption okLabel list init =
    let listBox = MultiListBox list id $ \_ -> id
        dialog = Modifier Margin $ Column
          [ Modifier (Boxed listCaption) $ Modifier HFill $ Widget listBox
          , Modifier Center $ Row [ Widget $ DefaultButton okLabel ()
                                  , cancelButton]]
    in
      maybe [] id 
        <$> (onView $ showSimpleDialog dialogCaption dialog init)

chooseColumnDialog :: String -> String -> Maybe Int -> Controller (Maybe Int)
chooseColumnDialog caption okLabel init = do
  labels <- onGridView getColumnLabels 
  chooseOneFromListDialog caption (__ "Column") okLabel labels init

chooseRowDialog :: String -> String -> Maybe Int -> Controller (Maybe Int)
chooseRowDialog caption okLabel init = do
  labels <- onGridView getRowLabels 
  chooseOneFromListDialog caption (__ "Row") okLabel labels init

chooseColumnsDialog :: String -> String -> [Int] -> Controller [Int]
chooseColumnsDialog caption okLabel init = do
  labels <- onGridView getColumnLabels 
  chooseSomeFromListDialog caption (__ "Columns") okLabel labels init

chooseRowsDialog :: String -> String -> [Int] -> Controller [Int]
chooseRowsDialog caption okLabel init = do
  labels <- onGridView getRowLabels 
  chooseSomeFromListDialog caption (__ "Rows") okLabel labels init

chooseSomethingAndTableDialog :: String -> String -> String -> [String]
                              -> [Int] -> Controller (Maybe ([Int],Maybe Int))
chooseSomethingAndTableDialog dialogCaption someCaption okLabel something init = do
  tableCaptions <- onView captions
  let someList = MultiListBox something fst
                   $ \(_,table) some -> (some,table)
      tableList = SingleListBox tableCaptions snd
                    $ \(some,_) table -> (some,table)
      dialog = Modifier Margin $ Column
               [ Modifier Center $ Row
                   [ Modifier (Boxed someCaption) $ Modifier HFill $ Widget someList
                   , Label $ __ "to"
                   , Modifier (Boxed $ __ "Table") $ Widget tableList
                   ]
               , Modifier Center $ Row 
                   [Widget $ DefaultButton okLabel (), cancelButton]]
  onView $ showSimpleDialog dialogCaption dialog (init,Nothing)

chooseColumnsAndTableDialog :: String -> String -> [Int]
                            -> Controller (Maybe ([Int],Maybe Int))
chooseColumnsAndTableDialog caption okLabel init = do
  labels <- onGridView getColumnLabels 
  chooseSomethingAndTableDialog caption (__ "Columns") okLabel labels init

chooseRowsAndTableDialog :: String -> String -> [Int]
                            -> Controller (Maybe ([Int],Maybe Int))
chooseRowsAndTableDialog caption okLabel init = do
  labels <- onGridView getRowLabels 
  chooseSomethingAndTableDialog caption (__ "Rows") okLabel labels init

previewImage :: WXC.Bitmap () -> Controller ()
previewImage bitmap = 
    let drawBitmap dc _ = WX.drawBitmap dc bitmap WX.pointZero False []
        makeWindow dialog = do
          size <- do width <- WXC.bitmapGetWidth bitmap
                     height <- WXC.bitmapGetHeight bitmap
                     return (width,height)

          WX.scrolledWindow dialog [ WX.virtualSize := uncurry WX.sz size
                                   , WX.clientSize := uncurry WX.sz size
                                   , on WX.paint := drawBitmap]
        dialog = Modifier Margin $ Column
                 [ Widget $ ScrolledWindow makeWindow
                 , Modifier Center $ okButton ()]
    in
      onView (showSimpleDialog (__ "Preview") dialog ()) >> return ()

warning :: String -> Controller ()
warning = onView . Simple.warning

nonNumericDataWarningText :: [String] -> String
nonNumericDataWarningText labels = 
    unwords [__ "Column(s)",show labels,__ "contains non-numeric data"]

nonNumericDataWarning :: [String] -> Controller ()
nonNumericDataWarning = warning . nonNumericDataWarningText

noColumnsSelectedText :: String
noColumnsSelectedText = __ "No columns selected"

noColumnsSelected :: Controller ()
noColumnsSelected = warning noColumnsSelectedText

noRowsSelectedText :: String
noRowsSelectedText = __ "No rows selected"

noRowsSelected :: Controller ()
noRowsSelected = warning noRowsSelectedText

whenSure :: String -> Controller () -> Controller ()
whenSure caption doThis =
    let caption' = caption ++ ": " ++ (__ "Are you sure?")
    in do
      sure <- onView $ \view -> 
              WX.confirmDialog (frame view) caption' caption' False
      when sure doThis