Commit 8c6e4fa8 authored by Peter Achten's avatar Peter Achten Committed by Camil Staps

distinguish between onclick mouse handler (that responds immediately) and...

distinguish between onclick mouse handler (that responds immediately) and onNclick mouse handler (that must use a small device dependent delay to determine double click events)
parent c2864e8c
......@@ -74,7 +74,7 @@ pile_image side pile
row_images :: !Bool !RowPlayer -> [Image GameSt]
row_images interactive row
= [ tuneIf interactive (card_image Front row_card)
{onclick = const (play_row_card row_card.back no), local = False}
{onclick = play_row_card row_card.back no, local = False}
\\ row_card <- row
& no <- [1..]
]
......@@ -83,8 +83,8 @@ hand_images :: !Bool !Hand !Color -> [Image GameSt]
hand_images interactive {conceal,discard} color
#! conceal_pile = pile_image Back conceal
#! discard_pile = pile_image Front discard
= [ tuneIf interactive conceal_pile {onclick = const (play_concealed_pile color), local = False}
, tuneIf interactive discard_pile {onclick = const (play_hand_card color), local = False}
= [ tuneIf interactive conceal_pile {onclick = play_concealed_pile color, local = False}
, tuneIf interactive discard_pile {onclick = play_hand_card color, local = False}
]
player_arc :== 0.45 * pi
......
......@@ -41,7 +41,7 @@ board :: Bool Span TraxSt -> Image TraxSt
board it_is_my_turn d st=:{trax}
| no_of_tiles trax == zero
| it_is_my_turn = grid (Rows 2) (RowMajor, LeftToRight, TopToBottom) [] [] [] []
[ tileImage d tile <@< {onclick = const (start_with_this tile), local = False}
[ tileImage d tile <@< {onclick = start_with_this tile, local = False}
\\ tile <- gFDomain{|*|}
] NoHost
| otherwise = voidImage d
......@@ -66,12 +66,12 @@ freeImage d coord {trax,choice}
| maybe True (\c -> coord <> c) choice
= unselected
| otherwise = above (repeat AtMiddleX) [] (Just d) []
[tileImage (d /. nr_of_candidates) tile <@< {onclick = const (settile coord tile), local = False} \\ tile <- candidates]
[tileImage (d /. nr_of_candidates) tile <@< {onclick = settile coord tile, local = False} \\ tile <- candidates]
(Host unselected)
where
candidates = possible_tiles (linecolors trax coord)
nr_of_candidates = length candidates
unselected = tileShape d <@< {fill = freeTileColor} <@< {onclick = const (setcell coord), local = False}
unselected = tileShape d <@< {fill = freeTileColor} <@< {onclick = setcell coord, local = False}
tileImage :: Span TraxTile -> Image a
tileImage d tile = fromJust (lookup tile [ (horizontal,rotate (deg 0.0) horizontal_tile)
......
......@@ -26,7 +26,7 @@ Start world
@image displays the number of times that you've clicked on the text. The initial value is @n.
*/
count :: Int *TagSource -> Image Int
count n _ = margin (px 20.0) (beside [] [] Nothing [] (map digit (digits n)) NoHost <@< {onclick = (+), local = False})
count n _ = margin (px 20.0) (beside [] [] Nothing [] (map digit (digits n)) NoHost <@< {onNclick = (+), local = False})
digits :: Int -> [Int]
digits n = [toInt c - toInt '0' \\ c <-: toString n]
......
......@@ -32,8 +32,8 @@ toggleOf :: Who Toggles -> Bool
toggleOf A t = t.Toggles.update_a_locally
toggleOf B t = t.Toggles.update_b_locally
toggleIncr :: Int Toggles -> Toggles
toggleIncr n t=:{Toggles | value_in_sds = m} = {Toggles | t & value_in_sds = n+m}
toggleIncr :: Toggles -> Toggles
toggleIncr t=:{Toggles | value_in_sds = m} = {Toggles | t & value_in_sds = m+1}
toggle :: Who Toggles -> Toggles
toggle A t=:{Toggles | update_a_locally} = {Toggles | t & update_a_locally = not update_a_locally}
......@@ -76,7 +76,7 @@ count label toggles _
[ beside [] [] Nothing [] (map digit (digits n)) NoHost <@< {onclick = toggleIncr, local = toggleOf label toggles}
, margin (px 10.0) (
circle (h /. 5)
<@< {onclick = const (toggle label), local = False}
<@< {onclick = toggle label, local = False}
<@< {stroke = if (toggleOf label toggles) black none}
<@< {strokewidth = if (toggleOf label toggles) (h /. 25) (h /. 50)}
<@< {fill = yellow}
......
......@@ -29,6 +29,6 @@ tons_of_circles model tags
\\ i <- [0..100], j <- [0..100]
]
host
) <@< {onclick= \_ m = m,local=False}
) <@< {onclick=id,local=False}
where
host = Host (rect (px 808.0) (px 808.0) <@< {fill=white})
......@@ -75,11 +75,16 @@ svgns =: "http://www.w3.org/2000/svg"
(`getItem`) obj args :== obj .# "getItem" .$ args
(`now`) obj args :== obj .# "now" .$ args
addEventListener :: !JSObj !String !Bool !({!JSVal} *JSWorld -> *JSWorld) !JSVal !*JSWorld -> *JSWorld
:: EventCapture = EventBubbling | EventCapturing
instance toBool EventCapture
where toBool EventBubbling = False
toBool EventCapturing = True
addEventListener :: !JSObj !String !EventCapture !({!JSVal} *JSWorld -> *JSWorld) !JSVal !*JSWorld -> *JSWorld
addEventListener svg event useCapture callback me world
// add event listener
#! (jsCallback,world) = jsWrapFun callback me world
#! world = (svg .# "addEventListener" .$! (event,jsCallback,useCapture)) world
#! world = (svg .# "addEventListener" .$! (event,jsCallback,toBool useCapture)) world
// store callback so that it can be freed in clientUpdateSVGString
#! (refs,world) = jsGetCleanReference (me .# "refs") world
#! refs = case refs of
......@@ -633,8 +638,8 @@ where
| isAnyMember draggableAttrs required
// all draggable elements share a common mousemove and mouseup event:
#! idMap = invertToMapSet (fmap (mkUniqId taskId) tags)
#! world = addEventListener svg "mousemove" True (doMouseDragMove svglet me svg) me world
#! world = addEventListener svg "mouseup" True (doMouseDragUp svglet me svg idMap) me world
#! world = addEventListener svg "mousemove" EventCapturing (doMouseDragMove svglet me svg) me world
#! world = addEventListener svg "mouseup" EventCapturing (doMouseDragUp svglet me svg idMap) me world
= world
| otherwise
= world
......@@ -653,63 +658,63 @@ where
= 'Data.Foldable'.foldr (register` svglet me svg (mkUniqId taskId uniqId) uniqId) world es`
where
register` :: !(SVGEditor s v) !JSVal !JSObj !String !ImgTagNo !(ImgNodePath,ImgEventhandler`) !*JSWorld -> *JSWorld | JSONEncode{|*|} s
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler = ImgEventhandlerOnClickAttr`,local}) world
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler = ImgEventhandlerOnNClickAttr`,local}) world
= registerNClick` svglet me svg elemId uniqId p local world
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler = ImgEventhandlerOnMouseDownAttr`,local}) world
= registerMouse` svglet me svg elemId "mousedown" uniqId p local world
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler = ImgEventhandlerOnMouseUpAttr`,local}) world
= registerMouse` svglet me svg elemId "mouseup" uniqId p local world
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler = ImgEventhandlerOnMouseOverAttr`,local}) world
= registerMouse` svglet me svg elemId "mouseover" uniqId p local world
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler = ImgEventhandlerOnMouseMoveAttr`,local}) world
= registerMouse` svglet me svg elemId "mousemove" uniqId p local world
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler = ImgEventhandlerOnMouseOutAttr`,local}) world
= registerMouse` svglet me svg elemId "mouseout" uniqId p local world
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler = ImgEventhandlerDraggableAttr`}) world
= registerDraggable` svglet me svg elemId uniqId p world
register` svglet me svg elemId uniqId (p,{ImgEventhandler` | handler,local}) world
= registerMouse` svglet me svg elemId eventname capture uniqId p local world
where
(eventname,capture) = case handler of
ImgEventhandlerOnClickAttr` = ("click", EventBubbling)
ImgEventhandlerOnMouseDownAttr` = ("mousedown",EventCapturing)
ImgEventhandlerOnMouseUpAttr` = ("mouseup", EventCapturing)
ImgEventhandlerOnMouseOverAttr` = ("mouseover",EventCapturing)
ImgEventhandlerOnMouseMoveAttr` = ("mousemove",EventCapturing)
ImgEventhandlerOnMouseOutAttr` = ("mouseout", EventCapturing)
registerNClick` :: !(SVGEditor s v) !JSVal !JSObj !String !ImgTagNo !ImgNodePath !Bool !*JSWorld -> *JSWorld | JSONEncode{|*|} s
registerNClick` svglet me svg elemId uniqId p local world
#! (elem,world) = (svg .# "getElementById" .$ elemId) world
#! world = addEventListener elem "click" False (mkNClickCB` svglet me svg elemId uniqId p local) me world
#! world = addEventListener elem "click" EventBubbling (mkNClickCB` svglet me svg elemId uniqId p local) me world
= world
registerMouse` :: !(SVGEditor s v) !JSVal !JSObj !String !String !ImgTagNo !ImgNodePath !Bool !*JSWorld -> *JSWorld | JSONEncode{|*|} s
registerMouse` svglet me svg elemId evt uniqId p local world
registerMouse` :: !(SVGEditor s v) !JSVal !JSObj !String !String !EventCapture !ImgTagNo !ImgNodePath !Bool !*JSWorld -> *JSWorld | JSONEncode{|*|} s
registerMouse` svglet me svg elemId evt capture uniqId p local world
#! (elem,world) = (svg .# "getElementById" .$ elemId) world
#! world = addEventListener elem evt True (doMouseEvent` svglet me svg elemId uniqId p MouseNoData local) me world
#! world = addEventListener elem evt capture (doMouseEvent` svglet me svg elemId uniqId p MouseNoData local) me world
= world
registerDraggable` :: !(SVGEditor s v) !JSVal !JSObj !String !ImgTagNo !ImgNodePath !*JSWorld -> *JSWorld
registerDraggable` svglet me svg elemId uniqId p world
#! (elem, world) = (svg .# "getElementById" .$ elemId) world
#! world = addEventListener elem "mousedown" True (doMouseDragEvent` svglet me svg uniqId p elemId elem) me world
#! world = addEventListener elem "mousedown" EventCapturing (doMouseDragEvent` svglet me svg uniqId p elemId elem) me world
= world
mkNClickCB` :: !(SVGEditor s v) !JSVal !JSObj !String !ImgTagNo !ImgNodePath !Bool !{!JSVal} !*JSWorld -> *JSWorld | JSONEncode{|*|} s
mkNClickCB` svglet me svg elemId uniqId p local args world
#! world = if (size args>0) ((args.[0] .# "stopPropagation" .$! ()) world) world
#! world = if (size args>0) ((args.[0] .# "stopPropagation" .$! ()) world) world
// If another click already registered a timeout, clear that timeout
#! (to,world) = me .# "clickTimeOut" .? world
#! world = if (jsIsUndefined to || jsIsNull to) world ((jsGlobal "clearTimeout" .$! to) world)
#! (to,world) = me .# "clickTimeOut" .? world
#! world = if (jsIsUndefined to || jsIsNull to) world ((jsGlobal "clearTimeout" .$! to) world)
// Register a callback for the click after a small timeout
#! (cb,world) = jsWrapFun (doNClickEvent` svglet me svg elemId uniqId p local) me world
#! world = (me .# "clickHandler" .= cb) world
#! (to,world) = (jsGlobal "setTimeout" .$ (cb, CLICK_DELAY)) world
#! world = (me .# "clickTimeOut" .= to) world
#! (cb,world) = jsWrapFun (doNClickEvent` svglet me svg elemId uniqId p local) me world
#! world = (me .# "clickHandler" .= cb) world
#! (to,world) = (jsGlobal "setTimeout" .$ (cb, CLICK_DELAY)) world
#! world = (me .# "clickTimeOut" .= to) world
// Increase click counter, so we can determine how many times the element was clicked when the timeout passes
#! (nc,world) = me .# "clickCount" .? world
#! world = (me .# "clickCount" .= jsValToInt` 0 nc + 1) world
#! (nc,world) = me .# "clickCount" .? world
#! world = (me .# "clickCount" .= jsValToInt` 0 nc + 1) world
= world
doNClickEvent` :: !(SVGEditor s v) !JSVal !JSObj !String !ImgTagNo !ImgNodePath !Bool !{!JSVal} !*JSWorld-> *JSWorld | JSONEncode{|*|} s
doNClickEvent` svglet me svg elemId uniqId p local args world
// Get click count
#! (nc,world) = me .# "clickCount" .? world
#! (nc,world) = me .# "clickCount" .? world
// Reset click count
#! world = (me .# "clickCount" .= 0) world
#! world = (me .# "clickHandler" .= jsNull) world
#! nc = jsValToInt` 0 nc
#! world = (me .# "clickCount" .= 0) world
#! world = (me .# "clickHandler" .= jsNull) world
#! nc = jsValToInt` 0 nc
= doMouseEvent` svglet me svg elemId uniqId p (MouseOnClickData nc) local args world
doMouseEvent` :: !(SVGEditor s v) !JSVal !JSObj !String !ImgTagNo !ImgNodePath !MouseCallbackData !Bool !{!JSVal} !*JSWorld -> *JSWorld | JSONEncode{|*|} s
......@@ -740,7 +745,8 @@ where
= world // rendering is completed by clientHandleAttributeChange
where
applyImgEventhandler :: !(ImgEventhandler m) !MouseCallbackData m -> m
applyImgEventhandler (ImgEventhandlerOnClickAttr {OnClickAttr | onclick = f}) (MouseOnClickData n) m = f n m
applyImgEventhandler (ImgEventhandlerOnClickAttr {OnClickAttr | onclick = f}) _ m = f m
applyImgEventhandler (ImgEventhandlerOnNClickAttr {OnNClickAttr | onNclick = f}) (MouseOnClickData n) m = f n m
applyImgEventhandler (ImgEventhandlerOnMouseDownAttr {OnMouseDownAttr | onmousedown = f}) _ m = f m
applyImgEventhandler (ImgEventhandlerOnMouseUpAttr {OnMouseUpAttr | onmouseup = f}) _ m = f m
applyImgEventhandler (ImgEventhandlerOnMouseOverAttr {OnMouseOverAttr | onmouseover = f}) _ m = f m
......
......@@ -18,7 +18,7 @@ import qualified Graphics.Scalable.Image as GS
from Graphics.Scalable.Image import :: Image, :: TagSource (..), :: TagRef (..), :: ImageTag, :: Span, :: Angle (..)
from Graphics.Scalable.Image import px, text, class toSVGColor(..), instance toSVGColor String, beside, <@<, textxspan, class tuneImage(..)
from Graphics.Scalable.Image import instance tuneImage YRadiusAttr, instance tuneImage XRadiusAttr, instance tuneImage StrokeAttr
from Graphics.Scalable.Image import instance tuneImage StrokeWidthAttr, instance tuneImage FillAttr, instance tuneImage OnClickAttr
from Graphics.Scalable.Image import instance tuneImage StrokeWidthAttr, instance tuneImage FillAttr, instance tuneImage OnClickAttr, instance tuneImage OnNClickAttr
from Graphics.Scalable.Image import instance tuneImage DashAttr
from Graphics.Scalable.Image import overlay, polygon, xline, rect, deg, rotate, yline, tag, imageyspan, imagexspan, maxSpan
from Graphics.Scalable.Image import empty, above, class margin(..), circle, tuneIf
......@@ -26,7 +26,7 @@ from Graphics.Scalable.Image import instance margin Span, instance margin (Span,
from Graphics.Scalable.Image import instance + Span, instance - Span, instance ~ Span, instance zero Span, instance *. Span, instance /. Span
from Graphics.Scalable.Image import :: FontDef(..), :: Host(..), :: YAlign(..), :: XAlign(..), :: ImageOffset(..), :: DashAttr(..), :: FillAttr(..)
from Graphics.Scalable.Image import :: XYAlign(..), :: StrokeAttr(..), :: LineEndMarker(..), :: LineMidMarker(..), :: LineStartMarker(..), :: GridMajor(..), :: GridXLayout(..), :: GridYLayout(..)
from Graphics.Scalable.Image import :: GridDimension(..), :: StrokeWidthAttr(..), :: OnClickAttr(..), :: XRadiusAttr(..), :: YRadiusAttr(..)
from Graphics.Scalable.Image import :: GridDimension(..), :: StrokeWidthAttr(..), :: OnClickAttr(..), :: OnNClickAttr(..), :: XRadiusAttr(..), :: YRadiusAttr(..)
from Graphics.Scalable.Image import class *.(..), class /.(..)
import Graphics.Scalable.Internal.Image`
import Graphics.Scalable.Internal.Types
......@@ -563,7 +563,7 @@ renderParallelContainer inh eid moduleName taskName descr syn_branches uContextT
&& bpident_compId == fmap getComputationId inh.inh_bpinst
&& click_origin_mbnodeId == Just eid
_ = False
#! valAnchor = rect (px 8.0) (px 8.0) <@< { onclick = openDetails clickMeta, local = False }
#! valAnchor = rect (px 8.0) (px 8.0) <@< { onNclick = openDetails clickMeta, local = False }
<@< { fill = case stability of
TNoVal -> TonicWhite
TStable -> TonicBlue
......@@ -645,7 +645,7 @@ tTaskDef inh moduleName taskName resultTy args argvars tdbody [(nameTag, uNameTa
where
mkArgAndTy :: !(!TExpr, !TExpr) !Int !(Maybe TExpr) -> [Image ModelTy]
mkArgAndTy (arg, ty) i mvar
#! clickHandler = { onclick = selectArg inh i, local = False}
#! clickHandler = { onNclick = selectArg inh i, local = False}
= [ text ArialRegular10px (ppTExpr arg) <@< clickHandler
, text ArialRegular10px " :: " <@< clickHandler
, text ArialRegular10px (ppTExpr ty) <@< clickHandler
......@@ -743,7 +743,7 @@ renderTaskApp inh eid moduleName taskName taskArgs displayName tsrc
[Just x:_] -> (x, tsrc)
_ -> tDefaultMApp isDynamic inh.inh_in_branch inh.inh_compact isActive wasActive inh.inh_inaccessible inh.inh_future_unreachable eid inh.inh_bpref.bpr_moduleName inh.inh_bpref.bpr_taskName moduleName displayName taskArgs taskArgs` augments tsrc
#! clickMeta = mkClickMeta inh (Just eid) moduleName taskName (fmap getComputationId inh.inh_bpinst) mbNavTo
#! taskApp = taskApp <@< { onclick = navigateOrSelect clickMeta, local = False }
#! taskApp = taskApp <@< { onNclick = navigateOrSelect clickMeta, local = False }
#! valNodeIsSelected = case inh.inh_selDetail of
Just (Left
{ click_origin_mbbpident = Just {bpident_moduleName, bpident_compName, bpident_compId}
......@@ -753,7 +753,7 @@ renderTaskApp inh eid moduleName taskName taskArgs displayName tsrc
&& bpident_compId == fmap getComputationId inh.inh_bpinst
&& click_origin_mbnodeId == Just eid
_ -> False
#! valAnchor = rect (px 8.0) (px 8.0) <@< { onclick = openDetails clickMeta, local = False }
#! valAnchor = rect (px 8.0) (px 8.0) <@< { onNclick = openDetails clickMeta, local = False }
<@< { fill = case stability of
TNoVal -> TonicWhite
TStable -> TonicBlue
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment