{-# LANGUAGE ForeignFunctionInterface #-}

module Graphics.UI.FLTK.Ask (input,ask,message,dirChooser,fileChooser) where

import Foreign (nullPtr)
import Foreign.C.String (withCString, peekCString, CString)

foreign import ccall "_fl_input" _fl_input :: CString -> IO CString
foreign import ccall "_fl_ask" _fl_ask :: CString -> IO Bool
foreign import ccall "_fl_message" _fl_message :: CString -> IO ()
foreign import ccall "_fl_dir_chooser" _fl_dir_chooser :: CString -> CString -> IO CString
foreign import ccall "_fl_file_chooser" _fl_file_chooser :: CString->CString -> CString -> IO CString

sPeek ptr | ptr == nullPtr = return ""
          | True           = peekCString ptr


-- | Display a message with a single line input and return the result.
input :: String -> IO String
input s = withCString s (\cs -> _fl_input cs >>= sPeek)

-- | Ask a simple question with Ok and Cancel.
ask :: String -> IO Bool
ask s = withCString s _fl_ask

-- | Display a messagebox.
message :: String -> IO ()
message s = withCString s _fl_message

-- | Choose a directory. The first argument is the dialog title and the second one the initial location.
dirChooser :: String -> FilePath -> IO FilePath
dirChooser m s = withCString m (\ms -> withCString s (\cs -> _fl_dir_chooser ms cs >>= sPeek))

-- | Choose a file. This first argument is the dialog title. The second one is filename patterns in the format like \"Haskell (*.{hs,lhs})\\tC (*.c)\". The final argument is the start location.
fileChooser :: String -> String -> FilePath -> IO FilePath
fileChooser m p s = withCString m (\ms -> withCString p (\ps -> withCString s (\cs -> _fl_file_chooser ms ps cs >>= sPeek)))