module Hoodle.Coroutine.Dialog where
import Control.Applicative ((<$>),(<*>))
import Control.Lens (view)
import Control.Monad.Loops
import Control.Monad.State
import qualified Data.Foldable as F
import qualified Data.Text as T
import qualified Graphics.UI.Gtk as Gtk
import System.Directory (getCurrentDirectory)
import Hoodle.Coroutine.Draw
import qualified Hoodle.Script.Coroutine as S
import Hoodle.Type.Coroutine
import Hoodle.Type.Enum
import Hoodle.Type.Event
import Hoodle.Type.HoodleState
okMessageBox :: String -> MainCoroutine ()
okMessageBox msg = action >> waitSomeEvent (\case GotOk -> True ; _ -> False) >> return ()
where
action = doIOaction $
\_evhandler -> do
dialog <- Gtk.messageDialogNew Nothing [Gtk.DialogModal]
Gtk.MessageQuestion Gtk.ButtonsOk msg
_res <- Gtk.dialogRun dialog
Gtk.widgetDestroy dialog
return (UsrEv GotOk)
okCancelMessageBox :: String -> MainCoroutine Bool
okCancelMessageBox msg = action >> waitSomeEvent p >>= return . q
where
p (OkCancel _) = True
p _ = False
q (OkCancel b) = b
q _ = False
action = doIOaction $
\_evhandler -> do
dialog <- Gtk.messageDialogNew Nothing [Gtk.DialogModal]
Gtk.MessageQuestion Gtk.ButtonsOkCancel msg
res <- Gtk.dialogRun dialog
let b = case res of
Gtk.ResponseOk -> True
_ -> False
Gtk.widgetDestroy dialog
return (UsrEv (OkCancel b))
textInputDialog :: String -> MainCoroutine (Maybe String)
textInputDialog msg = do
doIOaction $ \_evhandler -> do
dialog <- Gtk.messageDialogNew Nothing [Gtk.DialogModal]
Gtk.MessageQuestion Gtk.ButtonsOkCancel msg
vbox <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog)
txtvw <- Gtk.textViewNew
Gtk.containerAdd vbox txtvw
Gtk.widgetShowAll dialog
res <- Gtk.dialogRun dialog
case res of
Gtk.ResponseOk -> do
buf <- Gtk.textViewGetBuffer txtvw
(istart,iend) <- (,) <$> Gtk.textBufferGetStartIter buf
<*> Gtk.textBufferGetEndIter buf
l <- Gtk.textBufferGetText buf istart iend True
Gtk.widgetDestroy dialog
return (UsrEv (TextInput (Just l)))
_ -> do
Gtk.widgetDestroy dialog
return (UsrEv (TextInput Nothing))
TextInput input <- waitSomeEvent (\case TextInput _ -> True ; _ -> False)
return input
keywordDialog :: [T.Text] -> MainCoroutine (Maybe T.Text)
keywordDialog keylst = do
doIOaction (keywordDialog' keylst)
keywordLoop
keywordDialog' :: [T.Text] -> (AllEvent -> IO ()) -> IO AllEvent
keywordDialog' keys = \_evhandler -> do
dialog <- Gtk.dialogNew
upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog)
vbox <- Gtk.vBoxNew False 0
Gtk.containerAdd upper vbox
hbox <- Gtk.hBoxNew False 0
Gtk.boxPackStart vbox hbox Gtk.PackNatural 0
_btnOk <- Gtk.dialogAddButton dialog ("Ok" :: String) Gtk.ResponseOk
_btnCancel <- Gtk.dialogAddButton dialog ("Cancel" :: String) Gtk.ResponseCancel
cbx <- Gtk.comboBoxNewText
klst <- mapM (Gtk.comboBoxAppendText cbx) keys
when ((not.null) klst) $
Gtk.comboBoxSetActive cbx (head klst)
Gtk.boxPackStart hbox cbx Gtk.PackGrow 2
Gtk.widgetShowAll dialog
res <- Gtk.dialogRun dialog
Gtk.widgetDestroy dialog
case res of
Gtk.ResponseOk -> do
keystr <- Gtk.comboBoxGetActiveText cbx
(return . UsrEv . Keyword) keystr
Gtk.ResponseCancel -> return (UsrEv (Keyword Nothing))
_ -> return (UsrEv (Keyword Nothing))
keywordLoop :: MainCoroutine (Maybe T.Text)
keywordLoop = waitSomeEvent (\case Keyword _ -> True ; _ -> False ) >>= \(Keyword x) -> return x
longTextMessageBox :: String -> MainCoroutine ()
longTextMessageBox msg = action
>> waitSomeEvent (\case GotOk -> True ; _ -> False)
>> return ()
where
action = doIOaction $
\_evhandler -> do
dialog <- Gtk.dialogNew
upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog)
vbox <- Gtk.vBoxNew False 0
Gtk.containerAdd upper vbox
hbox <- Gtk.hBoxNew False 0
txtbuf <- Gtk.textBufferNew Nothing
Gtk.textBufferSetText txtbuf msg
txtview <- Gtk.textViewNewWithBuffer txtbuf
vadj <- Gtk.textViewGetVadjustment txtview
vscr <- Gtk.vScrollbarNew vadj
Gtk.widgetSetSizeRequest txtview 400 700
Gtk.boxPackEnd hbox vscr Gtk.PackNatural 0
Gtk.boxPackStart hbox txtview Gtk.PackGrow 0
Gtk.boxPackStart vbox hbox Gtk.PackGrow 0
_btnOk <- Gtk.dialogAddButton dialog ("Ok" :: String) Gtk.ResponseOk
Gtk.widgetShowAll dialog
_res <- Gtk.dialogRun dialog
Gtk.widgetDestroy dialog
return (UsrEv GotOk)
fileChooser :: Gtk.FileChooserAction -> Maybe String -> MainCoroutine (Maybe FilePath)
fileChooser choosertyp mfname = do
mrecentfolder <- S.recentFolderHook
xst <- get
let rtrwin = view rootOfRootWindow xst
liftIO $ Gtk.widgetQueueDraw rtrwin
doIOaction (action rtrwin mrecentfolder) >> go
where
go = do r <- nextevent
case r of
FileChosen b -> return b
UpdateCanvas cid ->
invalidateInBBox Nothing Efficient cid >> go
_ -> go
action win mrf _evhandler = do
dialog <- Gtk.fileChooserDialogNew Nothing (Just win) choosertyp
[ ("OK", Gtk.ResponseOk)
, ("Cancel", Gtk.ResponseCancel) ]
case mrf of
Just rf -> Gtk.fileChooserSetCurrentFolder dialog rf
Nothing -> getCurrentDirectory >>= Gtk.fileChooserSetCurrentFolder dialog
F.mapM_ (Gtk.fileChooserSetCurrentName dialog) mfname
whileM_ (liftM (>0) Gtk.eventsPending) (Gtk.mainIterationDo False)
res <- Gtk.dialogRun dialog
mr <- case res of
Gtk.ResponseDeleteEvent -> return Nothing
Gtk.ResponseOk -> Gtk.fileChooserGetFilename dialog
Gtk.ResponseCancel -> return Nothing
_ -> putStrLn "??? in fileOpen" >> return Nothing
Gtk.widgetDestroy dialog
return (UsrEv (FileChosen mr))