module Hbro.Gui where
import Hbro.Types
import Control.Monad.Trans(liftIO)
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
loadGUI :: String -> IO GUI
loadGUI xmlPath = do
builder <- builderNew
builderAddFromFile builder xmlPath
webView <- webViewNew
set webView [ widgetCanDefault := True ]
_ <- on webView closeWebView $ do
mainQuit
return True
window <- builderGetObject builder castToWindow "mainWindow"
windowSetDefault window (Just webView)
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"
inspector <- webViewGetInspector webView
inspectorWindow <- initWebInspector inspector
return $ GUI window inspectorWindow scrollWindow webView promptLabel promptEntry statusBox builder
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
return inspectorWindow
showWebInspector :: Browser -> IO ()
showWebInspector browser = do
inspector <- webViewGetInspector (mWebView $ mGUI browser)
webInspectorInspectCoordinates inspector 0 0
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)
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
showPrompt True browser
labelSetText promptLabel label
entrySetText promptEntry defaultText
widgetGrabFocus promptEntry
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 ()
toggleStatusBar :: Browser -> IO ()
toggleStatusBar browser = do
visibility <- get (mStatusBox $ mGUI browser) widgetVisible
case visibility of
False -> widgetShow (mStatusBox $ mGUI browser)
_ -> widgetHide (mStatusBox $ mGUI browser)
fullscreen :: Browser -> IO ()
fullscreen browser = windowFullscreen (mWindow $ mGUI browser)
unfullscreen :: Browser -> IO ()
unfullscreen browser = windowUnfullscreen (mWindow $ mGUI browser)