{-# LANGUAGE CPP #-}
{- |
Module      :  ./GUI/Utils.hs
Description :  cpp choice between "GUI.HTkUtils" and "GUI.ConsoleUtils"
Copyright   :  (c) C. Maeder, Uni Bremen 2002-2005
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  non-portable (cpp)

Utilities on top of HTk or System.IO
-}

module GUI.Utils
  ( listBox
  , createTextSaveDisplay
  , askFileNameAndSave
  , infoDialog
#if defined GTKGLADE || defined UNI_PACKAGE
  , createTextDisplay
  , errorDialog
  , warningDialog
  , questionDialog

  , fileOpenDialog
  , fileSaveDialog

  , displayTheoryWithWarning

  , progressBar
  , pulseBar
#endif
  ) where

#ifdef GTKGLADE
import GUI.GtkUtils
  ( infoDialogExt
  , errorDialogExt
  , warningDialogExt
  , questionDialogExt
  , fileSaveDialogExt
  , fileOpenDialogExt
  , listChoiceExt
  , textViewExt
  , displayTheoryWithWarningExt
  , progressBarExt
  , pulseBarExt
  )
import Static.GTheory (G_theory)

-- | create a window which displays a given text
infoDialog :: String -- ^ Title
           -> String -- ^ Message
           -> IO ()
infoDialog :: String -> String -> IO ()
infoDialog = String -> String -> IO ()
infoDialogExt

-- | create a window which displays a given error
errorDialog :: String -- ^ Title
            -> String -- ^ Message
            -> IO ()
errorDialog :: String -> String -> IO ()
errorDialog = String -> String -> IO ()
errorDialogExt

-- | create a window which displays a given warning and ask for continue
warningDialog :: String -- ^ Title
              -> String -- ^ Message
              -> IO Bool
warningDialog :: String -> String -> IO Bool
warningDialog = String -> String -> IO Bool
warningDialogExt

-- | create a window which displays a given question
questionDialog :: String  -- ^ Title
               -> String  -- ^ Message
               -> IO Bool
questionDialog :: String -> String -> IO Bool
questionDialog = String -> String -> IO Bool
questionDialogExt

fileSaveDialog :: FilePath -- ^ Defaultname for file
               -> [(String, [String])] -- ^ Filter (name, pattern list)
               -> Maybe (FilePath -> IO ()) -- ^ Action on save
               -> IO (Maybe FilePath)
fileSaveDialog :: String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileSaveDialog = String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileSaveDialogExt

fileOpenDialog :: FilePath -- ^ Defaultname for file
               -> [(String, [String])] -- ^ Filter (name, pattern list)
               -> Maybe (FilePath -> IO ()) -- ^ Action on open
               -> IO (Maybe FilePath)
fileOpenDialog :: String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileOpenDialog = String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileOpenDialogExt

-- | displays a theory with warning in a window
displayTheoryWithWarning :: String -- ^ Kind of theory
                         -> String -- ^ Name of theory
                         -> String -- ^ Warning
                         -> G_theory -- ^ Theory
                         -> IO ()
displayTheoryWithWarning :: String -> String -> String -> G_theory -> IO ()
displayTheoryWithWarning = String -> String -> String -> G_theory -> IO ()
displayTheoryWithWarningExt

progressBar :: String -- ^ Title
            -> String -- ^ Description
            -> IO (Double -> String -> IO (), IO ())
progressBar :: String -> String -> IO (Double -> String -> IO (), IO ())
progressBar = String -> String -> IO (Double -> String -> IO (), IO ())
progressBarExt

pulseBar :: String -- ^ Title
         -> String -- ^ Description
         -> IO (String -> IO (), IO ())
pulseBar :: String -> String -> IO (String -> IO (), IO ())
pulseBar = String -> String -> IO (String -> IO (), IO ())
pulseBarExt

-- | create a window with title and list of options, return selected option
listBox :: String -- ^ Title
        -> [String] -- ^ Rows to display
        -> IO (Maybe Int) -- ^ Selected row
listBox :: String -> [String] -> IO (Maybe Int)
listBox = String -> [String] -> IO (Maybe Int)
listChoiceExt

-- | Display some (longish) text in an uneditable, scrollable editor.
createTextDisplay :: String -- ^ Title
                  -> String -- ^ Message
                  -> IO ()
createTextDisplay :: String -> String -> IO ()
createTextDisplay t :: String
t m :: String
m = String -> String -> Maybe String -> IO ()
textViewExt String
t String
m Maybe String
forall a. Maybe a
Nothing

-- | Display some (longish) text in an uneditable, scrollable editor.
createTextSaveDisplay :: String -- ^ Title
                      -> FilePath -- ^ Filename
                      -> String -- ^ Message
                      -> IO ()
createTextSaveDisplay :: String -> String -> String -> IO ()
createTextSaveDisplay t :: String
t f :: String
f m :: String
m = String -> String -> Maybe String -> IO ()
textViewExt String
t String
m (Maybe String -> IO ()) -> Maybe String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
f

-- | opens a FileDialog and saves to the selected file if Save is clicked
askFileNameAndSave :: FilePath -- ^ default filename for saving the text
                   -> String -- ^ text to be saved
                   -> IO ()
askFileNameAndSave :: String -> String -> IO ()
askFileNameAndSave f :: String
f m :: String
m = do
  String
-> [(String, [String])]
-> Maybe (String -> IO ())
-> IO (Maybe String)
fileSaveDialogExt String
f [] (Maybe (String -> IO ()) -> IO (Maybe String))
-> Maybe (String -> IO ()) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (String -> IO ()) -> Maybe (String -> IO ())
forall a. a -> Maybe a
Just (\ f' :: String
f' -> String -> String -> IO ()
writeFile String
f' String
m)
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#elif defined UNI_PACKAGE
import GUI.HTkUtils
  ( listBox
  , errorMess
  , confirmMess
  , messageMess
  , createTextSaveDisplay
  , askFileNameAndSave
  , newFileDialogStr
  , fileDialogStr
  , displayTheoryWithWarning
  , sync
  )
import qualified GUI.HTkUtils (createTextDisplay)

-- | create a window which displays a given text
infoDialog :: String -- ^ Title
           -> String -- ^ Message
           -> IO ()
infoDialog _ m = messageMess m

-- | create a window which displays a given error
errorDialog :: String -- ^ Title
            -> String -- ^ Message
            -> IO ()
errorDialog _ m = errorMess m

-- | create a window which displays a given warning and ask for continue
warningDialog :: String -- ^ Title
              -> String -- ^ Message
              -> IO Bool
warningDialog _ = confirmMess

-- | create a window which displays a given question
questionDialog :: String  -- ^ Title
               -> String  -- ^ Message
               -> IO Bool
questionDialog _ = confirmMess

fileOpenDialog :: FilePath -- ^ Defaultname for file
               -> [(String, [String])] -- ^ Filter (name, pattern list)
               -> Maybe (FilePath -> IO ()) -- ^ Action on open
               -> IO (Maybe FilePath)
fileOpenDialog f _ mAction = do
  evnt <- fileDialogStr "Open..." f
  mPath <- sync evnt
  case mPath of
    Just path -> case mAction of
      Just action -> action path
      Nothing -> return ()
    Nothing -> return ()
  return mPath

fileSaveDialog :: FilePath -- ^ Defaultname for file
               -> [(String, [String])] -- ^ Filter (name, pattern list)
               -> Maybe (FilePath -> IO ()) -- ^ Action on save
               -> IO (Maybe FilePath)
fileSaveDialog f _ mAction = do
  evnt <- newFileDialogStr "Save as..." f
  mPath <- sync evnt
  case mPath of
    Just path -> case mAction of
      Just action -> action path
      Nothing -> return ()
    Nothing -> return ()
  return mPath

-- | Display some (longish) text in an uneditable, scrollable editor.
createTextDisplay :: String -- ^ Title
                  -> String -- ^ Message
                  -> IO ()
createTextDisplay t m = GUI.HTkUtils.createTextDisplay t m []

-- Not implemented in HTk
progressBar :: String -- ^ Title
            -> String -- ^ Description
            -> IO (Double -> String -> IO (), IO ())
progressBar _ _ = return (\ _ _ -> return (), return ())

-- Not implemented in HTk
pulseBar :: String -- ^ Title
         -> String -- ^ Description
         -> IO (String -> IO (), IO ())
pulseBar _ _ = return (\ _ -> return (), return ())


#else
import GUI.ConsoleUtils
#endif