packages feed

lhae-0.0.2: src/Controller/Dialog.hs

module Controller.Dialog (openFileDialog,saveFileDialog
                         ,chooseColumnDialog
                         ,chooseColumnsDialog
                         ,chooseRowsDialog
                         ,chooseColumnsAndTableDialog
--                         ,pushColorButton
                         ,previewImage,warning
                         ,nonNumericDataWarningText,nonNumericDataWarning
                         ,noColumnsSelectedText,noColumnsSelected)
    where

import Control.Applicative ((<$>))
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] -> Controller (Maybe Int)
chooseOneFromListDialog dialogCaption listCaption list =
    let listBox = SingleListBox list id $ \_ -> id
        dialog = Modifier Margin $ Column
          [ Modifier (Boxed listCaption) $ Modifier HFill $ Widget listBox
          , Modifier Center $ Row [ okButton (), cancelButton]]
    in
      maybe Nothing id 
        <$> (onView $ showSimpleDialog dialogCaption dialog Nothing)

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

chooseColumnDialog :: String -> Controller (Maybe Int)
chooseColumnDialog caption = 
    onGridView getColumnLabels 
                   >>= chooseOneFromListDialog caption (__ "Column")

chooseColumnsDialog :: String -> Controller [Int]
chooseColumnsDialog caption = 
    onGridView getColumnLabels 
                   >>= chooseSomeFromListDialog caption (__ "Columns")

chooseRowsDialog :: String -> Controller [Int]
chooseRowsDialog caption = 
    onGridView getRowLabels 
                   >>= chooseSomeFromListDialog caption (__ "Rows")

chooseSomethingAndTableDialog :: String -> String -> [String] 
                              -> Controller (Maybe ([Int],Maybe Int))
chooseSomethingAndTableDialog dialogCaption someCaption something = 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 
                   [ okButton (), cancelButton]]
  onView $ showSimpleDialog dialogCaption dialog ([],Nothing)

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

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