From 43d63e2cb1e83fa195615ebf03c3894fe020f01e Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Mon, 8 Jul 2013 06:14:35 +1200 Subject: [PATCH] Support for using ghcjs-dom and for the webkit-sodium example. --- webkit-sodium/src/Engine.hs | 46 +++++++++++++++---------------- webkit-sodium/src/Main.hs | 25 +++++++---------- webkit-sodium/webkit-sodium.cabal | 20 ++++++++++---- 3 files changed, 47 insertions(+), 44 deletions(-) diff --git a/webkit-sodium/src/Engine.hs b/webkit-sodium/src/Engine.hs index 30b35fb..7d02d12 100644 --- a/webkit-sodium/src/Engine.hs +++ b/webkit-sodium/src/Engine.hs @@ -1,26 +1,24 @@ +{-# LANGUAGE CPP #-} module Engine where import Prelude hiding ((!!)) -import Graphics.UI.Gtk.WebKit.WebView - (webViewGetMainFrame, webViewNew, webViewGetDomDocument) -import Graphics.UI.Gtk.WebKit.DOM.Document +import GHCJS.DOM.Document (documentCreateElement, documentGetElementById, documentGetBody, documentGetDocumentElement) -import Graphics.UI.Gtk.WebKit.DOM.HTMLElement +import GHCJS.DOM.HTMLElement (htmlElementInsertAdjacentElement, htmlElementSetInnerHTML, htmlElementInsertAdjacentHTML) -import Graphics.UI.Gtk.WebKit.Types - (WebView(..), castToHTMLElement, castToElement, Document, - HTMLElement, ElementClass, MouseEventClass, gTypeElement) +import GHCJS.DOM.Types + (IsDOMWindow(..), castToHTMLElement, castToElement, Document, + HTMLElement, IsElement, IsMouseEvent, gTypeElement) import Control.Applicative ((<$>)) import Control.Arrow import Control.Monad.Trans ( liftIO ) -import Graphics.UI.Gtk.General.Enums (WindowPosition(..)) -import Graphics.UI.Gtk.WebKit.DOM.Element -import Graphics.UI.Gtk.WebKit.DOM.EventM -import Graphics.UI.Gtk.WebKit.DOM.MouseEvent -import Graphics.UI.Gtk.WebKit.DOM.Node -import System.Glib.GObject (isA) +import GHCJS.DOM.Element +import GHCJS.DOM.EventM +import GHCJS.DOM.MouseEvent +import GHCJS.DOM.Node +import GHCJS.DOM.DOMWindow import Control.Monad import Control.Monad.State.Strict import Data.IORef @@ -28,11 +26,11 @@ import Data.Maybe import FRP.Sodium import Game -import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame - (webFrameGetGlobalContext) import Control.Monad.Reader (ReaderT(..)) +#ifdef MIN_VERSION_jsc import Language.Javascript.JSC (js1, js0, js, jsg, (!!), (#), (<#), fun, deRefVal, JSValue(..)) import Control.Lens ((^.)) +#endif -- Convert (game) world to/from screen co-ordinates. -- World co-ordinates are x = -1400..1400, y = -1000 to 1000 @@ -60,14 +58,14 @@ fromWorldRect ((xOrig,yOrig),(wid,hei)) = ( -- | Get the mouse position relative to the top-left corner of the specified -- HTML element. -getXYRelativeTo :: (ElementClass elt, MouseEventClass e, ElementClass t) => +getXYRelativeTo :: (IsElement elt, IsMouseEvent e, IsElement t) => Document -> elt -> EventM e t (Int, Int) getXYRelativeTo doc container = do (px, py) <- mousePageXY doc container (cx, cy) <- liftIO $ elementPageXY doc container return (px - cx, py - cy) -mousePageXY :: (ElementClass elt, MouseEventClass e, ElementClass t) => +mousePageXY :: (IsElement elt, IsMouseEvent e, IsElement t) => Document -> elt -> EventM e t (Int, Int) mousePageXY doc container = do (x, y) <- mouseClientXY @@ -81,7 +79,7 @@ mousePageXY doc container = do return (x + bodyScrollLeft + docEltScrollLeft, y + bodyScrollTop + docEltScrollTop) -- | Get the top/left position of this element relative to the page. -elementPageXY :: ElementClass elt => Document -> elt -> IO (Int, Int) +elementPageXY :: IsElement elt => Document -> elt -> IO (Int, Int) elementPageXY doc elt = do Just body <- documentGetBody doc traverse body (castToElement elt) (0,0) @@ -113,11 +111,11 @@ data ButtonState = Up | Down deriving Eq -- | Instantiate the game, handling mouse events and drawing the output. -- Returns an \'unlisten\' action to de-register listeners. -engine :: WebView -> String -> (Event MouseEvent -> Reactive (BehaviorTree [Sprite])) -> IO (IO ()) -engine webView containerId game = do +engine :: IsDOMWindow w => w -> String -> (Event MouseEvent -> Reactive (BehaviorTree [Sprite])) -> IO (IO ()) +engine window containerId game = do putStrLn "Haskell Freecell" - Just doc <- webViewGetDomDocument webView + Just doc <- domWindowGetDocument window Just container <- fmap castToHTMLElement <$> documentGetElementById doc containerId -- Construct a mouse event that lives in FRP land, and a push action -- that allows us to push values into it from IO land. @@ -137,7 +135,8 @@ engine webView containerId game = do liftIO . sanitize Up . sync . pushMouse . MouseUp . toWorld $ xy (cx, cy) <- elementPageXY doc container - gctxt <- webViewGetMainFrame webView >>= webFrameGetGlobalContext +#ifdef MIN_VERSION_jsc + gctxt <- domWindowGetMainFrame window >>= webFrameGetGlobalContext (`runReaderT` gctxt) $ do document <- jsg "document" let getElementById = js1 "getElementById" @@ -185,6 +184,7 @@ engine webView containerId game = do (ValNumber x, ValNumber y) -> liftIO . sanitize Up . sync . pushMouse . MouseUp . toWorld $ ((floor x)-cx, (floor y)-cy) _ -> return () +#endif -- Instantiate the FRP logic: We give it our mouse event, and it gives us back the -- sprite behaviours that tell us what to draw on the screen. @@ -194,7 +194,7 @@ engine webView containerId game = do -- web page. showAll doc container sprites -showAll :: ElementClass elt => +showAll :: IsElement elt => Document -> elt -> BehaviorTree [Sprite] -> IO (IO ()) showAll doc container sprites = -- Pass the zIndex through as state. The order of the FRP's output determines diff --git a/webkit-sodium/src/Main.hs b/webkit-sodium/src/Main.hs index 88f05e4..e7f28a0 100644 --- a/webkit-sodium/src/Main.hs +++ b/webkit-sodium/src/Main.hs @@ -5,37 +5,32 @@ module Main ( import Engine import Freecell -import Graphics.UI.Gtk - (widgetShowAll, mainQuit, onDestroy, containerAdd, - scrolledWindowNew, windowSetPosition, windowSetDefaultSize, - windowNew, mainGUI, initGUI) -import Graphics.UI.Gtk.WebKit.WebView - (webViewNew, webViewGetDomDocument) -import Graphics.UI.Gtk.WebKit.DOM.Document +import GHCJS.DOM.DOMWindow + (domWindowGetDocument) +import GHCJS.DOM.Document (documentCreateElement, documentGetElementById, documentGetBody) -import Graphics.UI.Gtk.WebKit.DOM.HTMLElement +import GHCJS.DOM.HTMLElement (htmlElementInsertAdjacentElement, htmlElementSetInnerHTML, htmlElementInsertAdjacentHTML) -import Graphics.UI.Gtk.WebKit.Types (castToHTMLDivElement) -import Graphics.UI.Gtk.WebKit.DOM.CSSStyleDeclaration +import GHCJS.DOM.Types (castToHTMLDivElement) +import GHCJS.DOM.CSSStyleDeclaration (cssStyleDeclarationSetProperty) import Control.Applicative ((<$>)) import Control.Arrow import Control.Monad.Trans ( liftIO ) -import Graphics.UI.Gtk.General.Enums (WindowPosition(..)) -import Graphics.UI.Gtk.WebKit.DOM.Element -import Graphics.UI.Gtk.WebKit.DOM.Node +import GHCJS.DOM.Element +import GHCJS.DOM.Node import Control.Monad import System.Random import FRP.Sodium -import Graphics.UI.Gtk.WebKit.GHCJS (runWebGUI) +import GHCJS.DOM (runWebGUI) import Control.Concurrent (threadDelay, forkIO) -- Comments show how what these FFI calls should work when the -- code compiled is compiled with GHCJS main = do runWebGUI $ \ webView -> do - Just doc <- webViewGetDomDocument webView -- webView.document + Just doc <- domWindowGetDocument webView -- webView.document Just body <- documentGetBody doc -- doc.body -- If we are in the browser let's shrink the terminal window to make room diff --git a/webkit-sodium/webkit-sodium.cabal b/webkit-sodium/webkit-sodium.cabal index c7cbf49..45e6eb1 100644 --- a/webkit-sodium/webkit-sodium.cabal +++ b/webkit-sodium/webkit-sodium.cabal @@ -8,16 +8,24 @@ description: data-dir: "" library - build-depends: QuickCheck -any, base -any, glib -any, gtk -any, webkit -any, mtl -any, - sodium -any, array -any, filepath -any, random -any, ghcjs-dom -any, - webkit-javascriptcore -any, jsc -any, lens -any + build-depends: QuickCheck -any, base -any, mtl -any, + sodium -any, array -any, filepath -any, random -any, ghcjs-dom -any + + if !impl(ghcjs) + build-depends: glib -any, gtk -any, webkit -any, webkit-javascriptcore -any, jsc -any, + lens -any + exposed-modules: Engine, Freecell, Game hs-source-dirs: src executable freecell - build-depends: QuickCheck -any, base -any, glib -any, gtk -any, webkit -any, mtl -any, - sodium -any, array -any, filepath -any, random -any, ghcjs-dom -any, - webkit-javascriptcore -any, jsc -any, lens -any + build-depends: QuickCheck -any, base -any, mtl -any, + sodium -any, array -any, filepath -any, random -any, ghcjs-dom -any + + if !impl(ghcjs) + build-depends: glib -any, gtk -any, webkit -any, webkit-javascriptcore -any, jsc -any, + lens -any + main-is: Main.hs buildable: True hs-source-dirs: src