-- >
--- >
...
+-- >
...
+-- >
...
-- >
-- >
-- > ...
diff --git a/src/Graphics/UI/Threepenny/Elements.hs b/src/Graphics/UI/Threepenny/Elements.hs
--- a/src/Graphics/UI/Threepenny/Elements.hs
+++ b/src/Graphics/UI/Threepenny/Elements.hs
@@ -6,23 +6,24 @@
new,
-- * Primitive HTML elements
- address, a, anchor, applet, area,
+ address, a, anchor, applet, area, audio,
basefont, big, blockquote, body, bold, br, button,
- caption, center, cite, ddef, define, div, dlist,
+ canvas, caption, center, cite, code,
+ ddef, define, div, dlist,
dterm, emphasize, fieldset, font, form, frame, frameset,
h1, h2, h3, h4, h5, h6, header, hr,
img, image, input, italics,
- keyboard, legend, li, meta, noframes, olist, option,
+ keyboard, legend, li, link, map, meta, noframes, olist, option,
p, paragraph, param, pre,
sample, select, small, source, span, strong, sub, sup,
- table, td, textarea, th, thebase, thecode,
- thehtml, thelink, themap, thetitle, tr, tt, ul,
+ table, td, textarea, th, thebase,
+ thehtml, title_, tr, tt, ul,
underline, variable, video,
) where
import Control.Monad
import Control.Monad.Trans.Reader
-import Prelude hiding (span,div)
+import Prelude hiding (span,div,map)
import Graphics.UI.Threepenny.Core
{-----------------------------------------------------------------------------
@@ -63,6 +64,7 @@
anchor = tag "a"
applet = tag "applet"
area = itag "area"
+audio = tag "audio"
basefont = itag "basefont"
big = tag "big"
blockquote = tag "blockquote"
@@ -70,9 +72,11 @@
bold = tag "b"
br = itag "br"
button = tag "button"
+canvas = tag "canvas"
caption = tag "caption"
center = tag "center"
cite = tag "cite"
+code = tag "code"
ddef = tag "dd"
define = tag "dfn"
div = tag "div"
@@ -99,6 +103,8 @@
keyboard = tag "kbd"
legend = tag "legend"
li = tag "li"
+link = tag "link"
+map = tag "map"
meta = itag "meta"
noframes = tag "noframes"
olist = tag "ol"
@@ -119,12 +125,9 @@
textarea = tag "textarea"
th = tag "th"
thebase = itag "base"
-thecode = tag "code"
thehtml = tag "html"
-thelink = tag "link"
-themap = tag "map"
span = tag "span"
-thetitle = tag "title"
+title_ = tag "title"
tr = tag "tr"
tt = tag "tt"
ul = tag "ul"
diff --git a/src/Graphics/UI/Threepenny/Events.hs b/src/Graphics/UI/Threepenny/Events.hs
--- a/src/Graphics/UI/Threepenny/Events.hs
+++ b/src/Graphics/UI/Threepenny/Events.hs
@@ -3,7 +3,8 @@
-- | Common DOM events, for convenience.
-- * Documentation
- click, hover, blur, leave,
+ click, mousemove, hover, blur, leave,
+ keyup, keydown,
) where
import Graphics.UI.Threepenny.Core
@@ -18,6 +19,18 @@
hover :: Element -> Event ()
hover = silence . domEvent "mouseenter"
+-- | Event that periodically occurs while the mouse is moving over an element.
+--
+-- The event value represents the mouse coordinates
+-- relative to the upper left corner of the entire page.
+--
+-- Note: The @@ element responds to mouse move events,
+-- but only in the area occupied by actual content,
+-- not the whole browser window.
+mousemove :: Element -> Event (Int,Int)
+mousemove = fmap readPair . domEvent "mousemove"
+ where readPair (EventData (Just x:Just y:_)) = (read x, read y)
+
-- | Mouse leaving an element.
leave :: Element -> Event ()
leave = silence . domEvent "mouseleave"
@@ -25,3 +38,16 @@
-- | Element loses focus.
blur :: Element -> Event ()
blur = silence . domEvent "blur"
+
+
+type KeyCode = Int
+
+-- | Key pressed while element has focus.
+keydown :: Element -> Event KeyCode
+keydown = fmap read1 . domEvent "keydown"
+
+-- | Key released while element has focus.
+keyup :: Element -> Event KeyCode
+keyup = fmap read1 . domEvent "keyup"
+
+read1 (EventData (Just s:_)) = read s
diff --git a/src/Graphics/UI/Threepenny/Internal/Core.hs b/src/Graphics/UI/Threepenny/Internal/Core.hs
--- a/src/Graphics/UI/Threepenny/Internal/Core.hs
+++ b/src/Graphics/UI/Threepenny/Internal/Core.hs
@@ -26,6 +26,7 @@
-- $settingattributes
,setStyle
,setAttr
+ ,setProp
,setText
,setHtml
,setTitle
@@ -44,6 +45,7 @@
,getElementsByTagName
,getElementsById
,getWindow
+ ,getProp
,getValue
,getValuesList
,readValue
@@ -54,11 +56,16 @@
-- * Utilities
,debug
,clear
- ,callFunction
- ,runFunction
,callDeferredFunction
,atomic
+
+ -- * JavaScript FFI
+ ,ToJS, FFI, ffi, JSFunction
+ ,runFunction, callFunction
+ -- * Oddball
+ ,audioPlay
+
-- * Types
,Window
,Element
@@ -260,10 +267,10 @@
writeJson instructions
-- Write JSON to output.
-writeJson :: (MonadSnap m, Data a) => a -> m ()
+writeJson :: (MonadSnap m, JSON a) => a -> m ()
writeJson json = do
modifyResponse $ setContentType "application/json"
- (writeString . encodeJSON) json
+ (writeString . (\x -> showJSValue x "") . showJSON) json
-- Write a string to output.
writeString :: (MonadSnap m) => String -> m ()
@@ -305,19 +312,21 @@
readInput :: (MonadSnap f,Read a) => ByteString -> f (Maybe a)
readInput = fmap (>>= readMay) . getInput
---------------------------------------------------------------------------------
--- Event handling
---
--- $eventhandling
---
--- To bind events to elements, use the 'bind' function.
---
--- To handle DOM events, use the 'handleEvent' function, or the
--- 'handleEvents' function which will block forever.
---
--- See the rest of this section for some helpful functions that do
--- common binding, such as clicks, hovers, etc.
+{-----------------------------------------------------------------------------
+ Event handling
+------------------------------------------------------------------------------}
+{- $eventhandling
+
+ To bind events to elements, use the 'bind' function.
+
+ To handle DOM events, use the 'handleEvent' function, or the
+ 'handleEvents' function which will block forever.
+
+ See the rest of this section for some helpful functions that do
+ common binding, such as clicks, hovers, etc.
+-}
+
-- | Handle events signalled from the client.
handleEvents :: Window -> IO ()
handleEvents window = forever $ handleEvent window
@@ -358,13 +367,14 @@
_ <- register (sEvent key) $ \(EventData xs) -> thunk xs
return (Closure key)
---------------------------------------------------------------------------------
--- Setting attributes
---
--- $settingattributes
---
--- Text, HTML and attributes of DOM nodes can be set using the
--- functions in this section.
+{-----------------------------------------------------------------------------
+ Setting attributes
+------------------------------------------------------------------------------}
+{- $settingattributes
+
+ Text, HTML and attributes of DOM nodes can be set using the
+ functions in this section.
+-}
-- | Set the style of the given element.
setStyle :: [(String, String)] -- ^ Pairs of CSS (property,value).
@@ -379,6 +389,14 @@
-> IO ()
setAttr key value e@(Element el session) = run session $ SetAttr el key value
+-- | Set the property of the given element.
+setProp :: String -- ^ The property name.
+ -> JSValue -- ^ The property value.
+ -> Element -- ^ The element to update.
+ -> IO ()
+setProp key value e@(Element el session) =
+ runFunction session $ ffi "$(%1).prop(%2,%3);" el key value
+
-- | Set the text of the given element.
setText :: String -- ^ The plain text.
-> Element -- ^ The element to update.
@@ -407,12 +425,12 @@
delete e@(Element el session) = run session $ Delete el
---------------------------------------------------------------------------------
--- Manipulating tree structure
---
+{-----------------------------------------------------------------------------
+ Manipulating tree structure
+------------------------------------------------------------------------------}
-- $treestructure
---
--- Functions for creating, deleting, moving, appending, prepending, DOM nodes.
+--
+-- Functions for creating, deleting, moving, appending, prepending, DOM nodes.
-- | Create a new element of the given tag name.
newElement :: Window -- ^ Browser window in which context to create the element
@@ -434,10 +452,17 @@
-- Implement transfer of elements across browser windows
run session $ Append parent child
-
---------------------------------------------------------------------------------
--- Querying the DOM
---
+
+{-----------------------------------------------------------------------------
+ Oddball
+------------------------------------------------------------------------------}
+-- | Invoke the JavaScript expression @audioElement.play();@.
+audioPlay :: Element -> IO ()
+audioPlay (Element el session) = runFunction session $ ffi "%1.play();" el
+
+{-----------------------------------------------------------------------------
+ Querying the DOM
+------------------------------------------------------------------------------}
-- $querying
--
-- The DOM can be searched for elements of a given name, and nodes can
@@ -475,6 +500,14 @@
Value str -> return (Just str)
_ -> return Nothing
+-- | Get the property of an element. Blocks.
+getProp
+ :: String -- ^ The property name.
+ -> Element -- ^ The element to get the value of.
+ -> IO JSValue -- ^ The plain text value.
+getProp prop e@(Element el window) =
+ callFunction window (ffi "$(%1).prop(%2)" el prop)
+
-- | Get 'Window' associated to an 'Element'.
getWindow :: Element -> Window
getWindow (Element _ window) = window
@@ -551,10 +584,9 @@
getRequestCookies :: Window -> IO [(String,String)]
getRequestCookies = return . snd . sStartInfo
-
---------------------------------------------------------------------------------
--- Utilities
-
+{-----------------------------------------------------------------------------
+ Utilities
+------------------------------------------------------------------------------}
-- | Send a debug message to the client. The behaviour of the client
-- is unspecified.
debug
@@ -567,26 +599,23 @@
clear :: Window -> IO ()
clear window = run window $ Clear ()
--- | Call the given function and wait for results. Blocks.
-callFunction
- :: Window -- ^ Browser window
- -> String -- ^ The function name.
- -> [String] -- ^ Parameters.
- -> IO [Maybe String] -- ^ Return tuple.
-callFunction window func params =
- call window (CallFunction (func,params)) $ \signal ->
- case signal of
- FunctionCallValues vs -> return (Just vs)
- _ -> return Nothing
+-- | Run the given JavaScript function and carry on. Doesn't block.
+--
+-- The client window uses JavaScript's @eval()@ function to run the code.
+runFunction :: Window -> JSFunction () -> IO ()
+runFunction session = run session . RunJSFunction . unJSCode . code
--- | Call the given function and carry on. Doesn't block.
-runFunction
- :: Window -- ^ Browser window
- -> String -- ^ The function name.
- -> [String] -- ^ Parameters.
- -> IO ()
-runFunction window func params =
- run window $ CallFunction (func,params)
+-- | Run the given JavaScript function and wait for results. Blocks.
+--
+-- The client window uses JavaScript's @eval()@ function to run the code.
+callFunction :: Window -> JSFunction a -> IO a
+callFunction window (JSFunction code marshal) =
+ call window (CallJSFunction . unJSCode $ code) $ \signal ->
+ case signal of
+ FunctionResult v -> case marshal window v of
+ Ok a -> return $ Just a
+ Error _ -> return Nothing
+ _ -> return Nothing
-- | Call the given function with the given continuation. Doesn't block.
callDeferredFunction
diff --git a/src/Graphics/UI/Threepenny/Internal/Types.hs b/src/Graphics/UI/Threepenny/Internal/Types.hs
--- a/src/Graphics/UI/Threepenny/Internal/Types.hs
+++ b/src/Graphics/UI/Threepenny/Internal/Types.hs
@@ -1,16 +1,9 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
--- | All Threepenny's types. See "Graphics.UI.Threepenny.Types" for only public
--- types. Non-public types can be manipulated at your own risk, if you
--- know what you're doing and you want to add something that the
--- library doesn't do.
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-module Graphics.UI.Threepenny.Internal.Types
- where
+module Graphics.UI.Threepenny.Internal.Types where
-import Prelude hiding ((++),init)
+import Prelude hiding (init)
import Control.Applicative
import Control.Concurrent
@@ -23,8 +16,9 @@
import Network.URI
import Text.JSON.Generic
---------------------------------------------------------------------------------
--- Public types
+{-----------------------------------------------------------------------------
+ Public types
+------------------------------------------------------------------------------}
-- | Reference to an element in the DOM of the client window.
data Element = Element
@@ -87,9 +81,18 @@
-- | Data from an event. At the moment it is empty.
data EventData = EventData [Maybe String]
---------------------------------------------------------------------------------
--- Internal types
+-- | Record for configuring the Threepenny GUI server.
+data Config = Config
+ { tpPort :: Int -- ^ Port number.
+ , tpCustomHTML :: Maybe FilePath -- ^ Custom HTML file to replace the default one.
+ , tpStatic :: FilePath -- ^ Directory that is served under @/static@.
+ }
+
+{-----------------------------------------------------------------------------
+ Communication between client and server
+------------------------------------------------------------------------------}
+
-- | An instruction that is sent to the client as JSON.
data Instruction
= Debug String
@@ -109,12 +112,17 @@
| GetValues [ElementId]
| SetTitle String
| GetLocation ()
- | CallFunction (String,[String])
+ | RunJSFunction String
+ | CallJSFunction String
| CallDeferredFunction (Closure,String,[String])
| EmptyEl ElementId
| Delete ElementId
deriving (Typeable,Data,Show)
+instance JSON Instruction where
+ readJSON _ = error "JSON.Instruction.readJSON: No method implemented."
+ showJSON x = toJSON x
+
-- | A signal (mostly events) that are sent from the client to the server.
data Signal
= Init ()
@@ -124,6 +132,7 @@
| Values [String]
| Location String
| FunctionCallValues [Maybe String]
+ | FunctionResult JSValue
deriving (Show)
instance JSON Signal where
@@ -141,7 +150,9 @@
values = Values <$> valFromObj "Values" obj
fcallvalues = do
FunctionCallValues <$> (valFromObj "FunctionCallValues" obj >>= mapM nullable)
- init <|> elements <|> event <|> value <|> values <|> location <|> fcallvalues
+ fresult = FunctionResult <$> valFromObj "FunctionResult" obj
+ init <|> elements <|> event <|> value <|> values <|> location
+ <|> fcallvalues <|> fresult
-- | Read a JSValue that may be null.
nullable :: JSON a => JSValue -> Result (Maybe a)
@@ -151,11 +162,99 @@
-- | An opaque reference to a closure that the event manager uses to
-- trigger events signalled by the client.
data Closure = Closure (String,String)
- deriving (Typeable,Data,Show)
+ deriving (Typeable,Data,Show)
--- | Record for configuring the Threepenny GUI server.
-data Config = Config
- { tpPort :: Int -- ^ Port number.
- , tpCustomHTML :: Maybe FilePath -- ^ Custom HTML file to replace the default one.
- , tpStatic :: FilePath -- ^ Directory that is served under @/static@.
- }
+{-----------------------------------------------------------------------------
+ JavaScript Code and Foreign Function Interface
+------------------------------------------------------------------------------}
+-- | JavaScript code snippet.
+newtype JSCode = JSCode { unJSCode :: String }
+ deriving (Eq, Ord, Show, Data, Typeable)
+
+-- | Class for rendering Haskell types as JavaScript code.
+class ToJS a where
+ render :: a -> JSCode
+
+instance ToJS String where render = JSCode . show
+instance ToJS Int where render = JSCode . show
+instance ToJS Bool where render b = JSCode $ if b then "false" else "true"
+instance ToJS JSValue where render x = JSCode $ showJSValue x ""
+instance ToJS ElementId where
+ render (ElementId x) = apply "elidToElement(%1)" [render x]
+instance ToJS Element where render (Element e _) = render e
+
+
+-- | Representation of a JavaScript expression
+-- with a girven output type.
+data JSFunction a = JSFunction
+ { code :: JSCode -- code snippet
+ , marshal :: Window -> JSValue -> Result a -- convert to Haskell value
+ }
+
+instance Functor JSFunction where
+ fmap f = fmapWindow (const f)
+
+fmapWindow :: (Window -> a -> b) -> JSFunction a -> JSFunction b
+fmapWindow f (JSFunction c m) = JSFunction c (\w v -> f w <$> m w v)
+
+fromJSCode :: JSCode -> JSFunction ()
+fromJSCode c = JSFunction { code = c, marshal = \_ _ -> Ok () }
+
+-- | Helper class for making a simple JavaScript FFI
+class FFI a where
+ fancy :: ([JSCode] -> JSCode) -> a
+
+instance (ToJS a, FFI b) => FFI (a -> b) where
+ fancy f a = fancy $ f . (render a:)
+
+instance FFI (JSFunction ()) where fancy f = fromJSCode $ f []
+instance FFI (JSFunction String) where fancy = mkResult "%1.toString()"
+instance FFI (JSFunction JSValue) where fancy = mkResult "%1"
+instance FFI (JSFunction ElementId) where
+ fancy = mkResult "{ Element: elementToElid(%1) }"
+instance FFI (JSFunction Element) where
+ fancy = fmapWindow (\w elid -> Element elid w) . fancy
+
+mkResult :: JSON a => String -> ([JSCode] -> JSCode) -> JSFunction a
+mkResult client f = JSFunction
+ { code = apply client [f []]
+ , marshal = \w -> readJSON
+ }
+
+-- | Simple JavaScript FFI with string substitution.
+--
+-- Inspired by the Fay language.
+--
+-- > example :: String -> Int -> JSFunction String
+-- > example = ffi "$(%1).prop('checked',%2)"
+--
+-- The 'ffi' function takes a string argument representing the JavaScript
+-- code to be executed on the client.
+-- Occurrences of the substrings @%1@ to @%9@ will be replaced by
+-- subequent arguments.
+--
+-- Note: Always specify a type signature! The types automate
+-- how values are marshalled between Haskell and JavaScript.
+-- The class instances for the 'FFI' class show which conversions are supported.
+--
+ffi :: FFI a => String -> a
+ffi macro = fancy (apply macro)
+
+testFFI :: String -> Int -> JSFunction String
+testFFI = ffi "$(%1).prop('checked',%2)"
+
+-- | String substitution.
+-- Substitute occurences of %1, %2 up to %9 with the argument strings.
+-- The types ensure that the % character has no meaning in the generated output.
+--
+-- > apply "%1 and %2" [x,y] = x ++ " and " ++ y
+apply :: String -> [JSCode] -> JSCode
+apply code args = JSCode $ go code
+ where
+ argument i = unJSCode (args !! i)
+
+ go [] = []
+ go ('%':c:cs) = argument index ++ go cs
+ where index = fromEnum c - fromEnum '1'
+ go (c:cs) = c : go cs
+
diff --git a/src/Graphics/UI/Threepenny/JQuery.hs b/src/Graphics/UI/Threepenny/JQuery.hs
--- a/src/Graphics/UI/Threepenny/JQuery.hs
+++ b/src/Graphics/UI/Threepenny/JQuery.hs
@@ -45,9 +45,9 @@
-- | Focus an element.
setFocus :: Element -> IO ()
setFocus = updateElement $ \(Core.Element el window) ->
- runFunction window "jquery_setFocus" [encode el]
+ runFunction window (ffi "$(%1).focus()" el)
-- | Scroll to the bottom of an element.
scrollToBottom :: Element -> IO ()
scrollToBottom = updateElement $ \(Core.Element area window) ->
- runFunction window "jquery_scrollToBottom" [encode area]
+ runFunction window (ffi "jquery_scrollToBottom(%1)" area)
diff --git a/src/Graphics/UI/Threepenny/Timer.hs b/src/Graphics/UI/Threepenny/Timer.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/UI/Threepenny/Timer.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Graphics.UI.Threepenny.Timer (
+ -- * Synopsis
+ -- | Implementation of a simple timer which runs on the server-side.
+
+ -- * Documentation
+ Timer, timer,
+ interval, running, tick, start, stop,
+ ) where
+
+
+import Control.Monad (when, forever, void)
+import Control.Event
+import Control.Concurrent
+import Control.Concurrent.STM
+
+import Graphics.UI.Threepenny.Core
+
+
+data Timer = Timer
+ { tRunning :: TVar Bool
+ , tInterval :: TVar Int -- in ms
+ , tTick :: Event ()
+ }
+
+-- | Create a new timer
+timer :: IO Timer
+timer = do
+ tRunning <- newTVarIO False
+ tInterval <- newTVarIO 1000
+ (tTick, fire) <- newEvent
+
+ forkIO $ forever $ do
+ wait <- atomically $ do
+ b <- readTVar tRunning
+ when (not b) retry
+ readTVar tInterval
+ threadDelay (wait * 1000)
+ fire ()
+
+ return $ Timer {..}
+
+tick = tTick
+
+-- | Timer interval in milliseconds.
+interval :: Attr Timer Int
+interval = fromTVar tInterval
+
+-- | Whether the timer is running or not.
+running :: Attr Timer Bool
+running = fromTVar tRunning
+
+-- | Start the timer.
+start :: Timer -> IO ()
+start = set' running True
+
+-- | Stop the timer.
+stop :: Timer -> IO ()
+stop = set' running False
+
+fromTVar :: (x -> TVar a) -> Attr x a
+fromTVar f = mkReadWriteAttr
+ (atomically . readTVar . f)
+ (\i x -> atomically $ writeTVar (f x) i)
+
+
+{-----------------------------------------------------------------------------
+ Small test
+------------------------------------------------------------------------------}
+testTimer = do
+ t <- timer
+ void $ register (tick t) $ const $ putStr "Hello"
+ return t
+ # set interval 1000
+ # set running True
diff --git a/src/Graphics/UI/driver.js b/src/Graphics/UI/driver.js
--- a/src/Graphics/UI/driver.js
+++ b/src/Graphics/UI/driver.js
@@ -59,27 +59,7 @@
window.do_logging = function(x){
$.cookie('tp_log',x.toString());
};
-
- window.jquery_animate = function(el_id,props,duration,easing,complete){
- var el = elidToElement(JSON.parse(el_id));
- $(el).animate(JSON.parse(props),
- duration * 1,
- easing * 1,
- complete);
- }
-
- window.jquery_scrollToBottom = function(el_id,cont){
- var el = elidToElement(JSON.parse(el_id));
- $(el).scrollTop(el.scrollHeight);
- cont();
- };
-
- window.jquery_setFocus = function(el_id,cont){
- var el = elidToElement(JSON.parse(el_id));
- $(el).focus();
- cont();
- };
-
+
function waitForEvents(){
console_log("Polling… (%d signals so far)",signal_count);
var data = { token: sessionToken };
@@ -126,6 +106,7 @@
console_log("Event: %s",JSON.stringify(event));
for(var key in event){
switch(key){
+
case "EmptyEl": {
var id = event.EmptyEl;
var el = elidToElement(id);
@@ -153,20 +134,16 @@
continuation();
break;
}
- case "CallFunction": {
- var call = event.CallFunction;
- var theFunction = eval(call[0]);
- var params = call[1];
- theFunction.apply(window, params.concat(function(){
- var args = Array.prototype.slice.call(arguments,0);
- signal({
- FunctionCallValues: args
- },function(){
- continuation();
- });
- }));
+ case "RunJSFunction": {
+ eval(event.RunJSFunction);
+ continuation();
break;
}
+ case "CallJSFunction": {
+ var result = eval(event.CallJSFunction);
+ signal({FunctionResult : result}, continuation);
+ break;
+ }
case "Delete": {
event_delete(event);
continuation();
@@ -231,11 +208,11 @@
break;
}
case "SetAttr": {
- var set = event.SetAttr;
- var id = set[0];
- var key = set[1];
+ var set = event.SetAttr;
+ var id = set[0];
+ var key = set[1];
var value = set[2];
- var el = elidToElement(id);
+ var el = elidToElement(id);
$(el).attr(key,value);
continuation();
break;
@@ -297,8 +274,8 @@
break;
}
case "Bind": {
- var bind = event.Bind;
- var eventType = bind[0];
+ var bind = event.Bind;
+ var eventType = bind[0];
var handlerGuid = bind[2];
var el = elidToElement(bind[1]);
console_log('event type: ' + eventType);
@@ -329,6 +306,24 @@
});
return true;
});
+ } else if(eventType.match('mousemove')) {
+ $(el).bind(eventType,function(e){
+ signal({
+ Event: handlerGuid.concat([[e.pageX.toString(), e.pageY.toString()]])
+ },function(){
+ // no action
+ });
+ return true;
+ });
+ } else if(eventType.match('keydown|keyup')) {
+ $(el).bind(eventType,function(e){
+ signal({
+ Event: handlerGuid.concat([[e.keyCode.toString()]])
+ },function(){
+ // no action
+ });
+ return true;
+ });
} else {
$(el).bind(eventType,function(e){
signal({
@@ -430,6 +425,37 @@
if (tp_enable_log) {
window.console.log.apply(window.console,arguments);
}
+ };
+
+
+ ////////////////////////////////////////////////////////////////////////////////
+ // Additional functions
+
+ window.jquery_animate = function(el_id,props,duration,easing,complete){
+ var el = elidToElement(JSON.parse(el_id));
+ $(el).animate(JSON.parse(props),
+ duration * 1,
+ easing * 1,
+ complete);
+ }
+
+ window.jquery_scrollToBottom = function(el){
+ $(el).scrollTop(el.scrollHeight);
+ };
+
+ // see http://stackoverflow.com/a/9722502/403805
+ CanvasRenderingContext2D.prototype.clear =
+ CanvasRenderingContext2D.prototype.clear || function (preserveTransform) {
+ if (preserveTransform) {
+ this.save();
+ this.setTransform(1, 0, 0, 1, 0, 0);
+ }
+
+ this.clearRect(0, 0, this.canvas.width, this.canvas.height);
+
+ if (preserveTransform) {
+ this.restore();
+ }
};
})();
diff --git a/threepenny-gui.cabal b/threepenny-gui.cabal
--- a/threepenny-gui.cabal
+++ b/threepenny-gui.cabal
@@ -1,5 +1,5 @@
Name: threepenny-gui
-Version: 0.1.0.1
+Version: 0.2.0.0
Synopsis: Small GUI framework that uses the web browser as a display.
Description:
Threepenny-GUI is a small GUI framework that uses the web browser as a display.
@@ -14,6 +14,16 @@
Stability forecast: This is an experimental release! Send us your feedback!
Basic functionality should work.
Significant API changes are likely in future versions.
+ .
+ NOTE: This library contains examples, but they are not built by default.
+ To build and install the example, use the @buildExamples@ flag like this
+ .
+ @cabal install reactive-banana-threepenny -fbuildExamples@
+ .
+ Changelog:
+ .
+ * 0.2.0.0 - Snapshot release. First stab at easy JavaScript FFI.
+ * 0.1.0.0 - Initial release.
License: BSD3
License-file: LICENSE
@@ -32,8 +42,10 @@
,src/Graphics/UI/*.html
,src/Graphics/UI/*.css
,wwwroot/css/*.css
+ ,wwwroot/css/*.png
,wwwroot/*.html
,wwwroot/*.txt
+ ,wwwroot/*.wav
flag buildExamples
@@ -52,10 +64,12 @@
,Graphics.UI.Threepenny
,Graphics.UI.Threepenny.Attributes
,Graphics.UI.Threepenny.Core
+ ,Graphics.UI.Threepenny.Canvas
,Graphics.UI.Threepenny.DragNDrop
,Graphics.UI.Threepenny.Elements
,Graphics.UI.Threepenny.Events
,Graphics.UI.Threepenny.JQuery
+ ,Graphics.UI.Threepenny.Timer
Other-modules:
Control.Concurrent.Chan.Extra
,Control.Monad.Extra
@@ -81,6 +95,7 @@
,filepath
,data-default
,transformers
+ ,stm
Executable threepenny-examples-bartab
if flag(buildExamples)
@@ -118,6 +133,17 @@
other-modules: Paths_threepenny_gui, Paths
hs-source-dirs: src
+Executable threepenny-examples-drummachine
+ if flag(buildExamples)
+ cpp-options: -DCABAL
+ build-depends: base >= 4 && < 5
+ ,threepenny-gui
+ ,filepath
+ else
+ buildable: False
+ main-is: DrumMachine.hs
+ other-modules: Paths_threepenny_gui, Paths
+ hs-source-dirs: src
Executable threepenny-examples-missing-dollars
if flag(buildExamples)
diff --git a/wwwroot/css/fade.png b/wwwroot/css/fade.png
new file mode 100644
Binary files /dev/null and b/wwwroot/css/fade.png differ
diff --git a/wwwroot/css/stripes-bg.png b/wwwroot/css/stripes-bg.png
new file mode 100644
Binary files /dev/null and b/wwwroot/css/stripes-bg.png differ
diff --git a/wwwroot/css/wood-bg.png b/wwwroot/css/wood-bg.png
new file mode 100644
Binary files /dev/null and b/wwwroot/css/wood-bg.png differ
diff --git a/wwwroot/hihat.wav b/wwwroot/hihat.wav
new file mode 100644
Binary files /dev/null and b/wwwroot/hihat.wav differ
diff --git a/wwwroot/kick.wav b/wwwroot/kick.wav
new file mode 100644
Binary files /dev/null and b/wwwroot/kick.wav differ
diff --git a/wwwroot/snare.wav b/wwwroot/snare.wav
new file mode 100644
Binary files /dev/null and b/wwwroot/snare.wav differ