{-# LANGUAGE DoRec #-} module Hbro.Gui where -- {{{ Imports import Hbro.Types import Control.Monad.Trans(liftIO) --import Graphics.UI.Gtk.Abstract.Misc import Graphics.UI.Gtk.Abstract.Container import Graphics.UI.Gtk.Abstract.Widget import Graphics.UI.Gtk.Builder import Graphics.UI.Gtk.Display.Label import Graphics.UI.Gtk.Entry.Editable import Graphics.UI.Gtk.Entry.Entry import Graphics.UI.Gtk.General.General import Graphics.UI.Gtk.Gdk.EventM import Graphics.UI.Gtk.Layout.HBox import Graphics.UI.Gtk.Scrolling.ScrolledWindow import Graphics.UI.Gtk.WebKit.WebInspector import Graphics.UI.Gtk.WebKit.WebView import Graphics.UI.Gtk.Windows.Window import System.Glib.Attributes import System.Glib.Signals -- }}} -- | Load GUI from XML file loadGUI :: String -> IO GUI loadGUI xmlPath = do builder <- builderNew builderAddFromFile builder xmlPath -- Init main web view webView <- webViewNew set webView [ widgetCanDefault := True ] _ <- on webView closeWebView $ do mainQuit return True -- Load main window window <- builderGetObject builder castToWindow "mainWindow" windowSetDefault window (Just webView) --windowSetDefaultSize window 1024 768 --windowSetPosition window WinPosCenter --windowSetIconFromFile window "/path/to/icon" set window [ windowTitle := "hbro" ] scrollWindow <- builderGetObject builder castToScrolledWindow "webViewParent" containerAdd scrollWindow webView set scrollWindow [ scrolledWindowHscrollbarPolicy := PolicyNever, scrolledWindowVscrollbarPolicy := PolicyNever ] promptLabel <- builderGetObject builder castToLabel "promptDescription" promptEntry <- builderGetObject builder castToEntry "promptEntry" statusBox <- builderGetObject builder castToHBox "statusBox" -- Create web inspector's window inspector <- webViewGetInspector webView inspectorWindow <- initWebInspector inspector return $ GUI window inspectorWindow scrollWindow webView promptLabel promptEntry statusBox builder -- {{{ Web inspector initWebInspector :: WebInspector -> IO (Window) initWebInspector inspector = do inspectorWindow <- windowNew set inspectorWindow [ windowTitle := "hbro | Web inspector" ] _ <- on inspector inspectWebView $ \_ -> do webView <- webViewNew containerAdd inspectorWindow webView return webView _ <- on inspector showWindow $ do widgetShowAll inspectorWindow return True -- TODO: when does this signal happen ?! --_ <- on inspector finished $ return () -- _ <- on inspector attachWindow $ do -- getWebView <- webInspectorGetWebView inspector -- case getWebView of -- Just webView -> do widgetHide (mInspectorWindow gui) -- containerRemove (mInspectorWindow gui) webView -- widgetSetSizeRequest webView (-1) 250 -- boxPackEnd (mWindowBox gui) webView PackNatural 0 -- widgetShow webView -- return True -- _ -> return False -- _ <- on inspector detachWindow $ do -- getWebView <- webInspectorGetWebView inspector -- _ <- case getWebView of -- Just webView -> do containerRemove (mWindowBox gui) webView -- containerAdd (mInspectorWindow gui) webView -- widgetShowAll (mInspectorWindow gui) -- return True -- _ -> return False -- widgetShowAll (mInspectorWindow gui) -- return True return inspectorWindow -- | Show web inspector for current webpage. showWebInspector :: Browser -> IO () showWebInspector browser = do inspector <- webViewGetInspector (mWebView $ mGUI browser) webInspectorInspectCoordinates inspector 0 0 -- }}} -- {{{ Prompt -- | Show or hide the prompt bar (label + entry). showPrompt :: Bool -> Browser -> IO () showPrompt toShow browser = case toShow of False -> do widgetHide (mPromptLabel $ mGUI browser) widgetHide (mPromptEntry $ mGUI browser) _ -> do widgetShow (mPromptLabel $ mGUI browser) widgetShow (mPromptEntry $ mGUI browser) -- | Show the prompt bar label and default text. -- As the user validates its entry, the given callback is executed. prompt :: String -> String -> Bool -> Browser -> (Browser -> IO ()) -> IO () prompt label defaultText incremental browser callback = let promptLabel = (mPromptLabel $ mGUI browser) promptEntry = (mPromptEntry $ mGUI browser) webView = (mWebView $ mGUI browser) in do -- Show prompt showPrompt True browser -- Fill prompt labelSetText promptLabel label entrySetText promptEntry defaultText widgetGrabFocus promptEntry -- Register callback case incremental of True -> do id1 <- on promptEntry editableChanged $ liftIO $ callback browser rec id2 <- on promptEntry keyPressEvent $ do key <- eventKeyName case key of "Return" -> do liftIO $ showPrompt False browser liftIO $ signalDisconnect id1 liftIO $ signalDisconnect id2 liftIO $ widgetGrabFocus webView "Escape" -> do liftIO $ showPrompt False browser liftIO $ signalDisconnect id1 liftIO $ signalDisconnect id2 liftIO $ widgetGrabFocus webView _ -> return () return False return () _ -> do rec id <- on promptEntry keyPressEvent $ do key <- eventKeyName case key of "Return" -> do liftIO $ showPrompt False browser liftIO $ callback browser liftIO $ signalDisconnect id liftIO $ widgetGrabFocus webView "Escape" -> do liftIO $ showPrompt False browser liftIO $ signalDisconnect id liftIO $ widgetGrabFocus webView _ -> return () return False return () -- }}} fullscreen, unfullscreen :: Browser -> IO() fullscreen browser = windowFullscreen (mWindow $ mGUI browser) unfullscreen browser = windowUnfullscreen (mWindow $ mGUI browser)