Skip to content

GitLab

I
iTasks-SDK
Commit eb7fd96f authored by Bas Lijnse's avatar Bas Lijnse
Browse files
Options

Merge branch 'coordinates-mouseevents-svg' into 'master' 

Extend the mousehandlers with coordinates

See merge request clean-and-itasks/iTasks-SDK!327
parents be08aea5 dab3c31e
Pipeline #30016 passed with stage
    in 4 minutes and 36 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 75 additions and 22 deletions
    Examples/Applications/ShipAdventure/C2/Apps/ShipAdventure/Images.icl
    View file @ eb7fd96f
    ......@@ -166,7 +166,7 @@ sectionImage disabledSections hilite mngmnt zoomed exitLocks hopLocks inventoryM
    = { fill = toSVGColor (if isLocked "black" "white") }
    doorClick :: !Bool !Coord3D !Dir !(Image (a, MapAction SectionStatus)) -> Image (a, MapAction SectionStatus)
    doorClick False c3d dir img = img
    doorClick _ c3d dir img = img <@< { onclick = \(x, _) -> (x, ToggleDoor c3d dir), local = False}
    doorClick _ c3d dir img = img <@< { onclick = \_ (x, _) -> (x, ToggleDoor c3d dir), local = False}
    sectionImage` :: !(Bool Coord3D [Object ObjectType] [Device] Real (Image a) [Image a] (Image b) (Image (Maps2D, MapAction SectionStatus))
    (Image d) (Image e) (Image f) (Image g) -> Image (Maps2D, MapAction SectionStatus))
    ......@@ -388,9 +388,9 @@ editSectionImage hilite mngmnt zoomed allDevices network inventoryMap doorDims s
    <@< {onclick = onClick (FocusOnSection (floorIdx, c)), local = False}
    ) )
    rotateWall :: !Int Coord2D Dir !(!Maps2D, MapAction SectionStatus)
    rotateWall :: !Int Coord2D Dir (Span,Span) !(!Maps2D, MapAction SectionStatus)
    -> (!Maps2D, !MapAction SectionStatus)
    rotateWall m c d (maps, edit)
    rotateWall m c d _ (maps, edit)
    = case getMap2D m maps of
    Just map
    = case getSection c map of
    ......@@ -406,5 +406,5 @@ rotateWall m c d (maps, edit)
    rotate Wall = Door
    rotate Door = Open
    onClick :: !(MapAction SectionStatus) !(!a, MapAction SectionStatus) -> (!a, !MapAction SectionStatus)
    onClick clck (m, _) = (m, clck)
    onClick :: !(MapAction SectionStatus) (Span,Span) !(!a, MapAction SectionStatus) -> (!a, !MapAction SectionStatus)
    onClick clck _ (m, _) = (m, clck)
    Examples/Games/Ligretto/Ligretto/UI.icl
    View file @ eb7fd96f
    ......@@ -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 = play_row_card row_card.back no, local = False}
    {onclick = \_ st -> play_row_card row_card.back no st, 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 = play_concealed_pile color, local = False}
    , tuneIf interactive discard_pile {onclick = play_hand_card color, local = False}
    = [ tuneIf interactive conceal_pile {onclick = \_ st -> play_concealed_pile color st, local = False}
    , tuneIf interactive discard_pile {onclick = \_ st -> play_hand_card color st, local = False}
    ]
    player_arc :== 0.45 * pi
    ......
    Examples/Games/Trax/Trax/UI.icl
    View file @ eb7fd96f
    ......@@ -44,7 +44,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 = start_with_this tile, local = False}
    [ tileImage d tile <@< {onclick = \_ st -> start_with_this tile st, local = False}
    \\ tile <- gFDomain{|*|}
    ] NoHost
    | otherwise = voidImage d
    ......@@ -73,9 +73,9 @@ unselectedImage d = tileShape d <@< {fill = freeTileColor}
    freeImage :: Span Coordinate TraxSt -> Image TraxSt
    freeImage d coord {trax,choice}
    | isEmpty candidates = illegalImage d
    | maybe True ((<>) coord) choice = unselectedImage d <@< {onclick = setcell coord, local = False}
    | maybe True ((<>) coord) choice = unselectedImage d <@< {onclick = \_ st -> setcell coord st, local = False}
    | otherwise = above (repeat AtMiddleX) [] (Just d) []
    [tileImage (d /. no_of_candidates) tile <@< {onclick = settile coord tile, local = False} \\ tile <- candidates]
    [tileImage (d /. no_of_candidates) tile <@< {onclick = \_ st -> settile coord tile st, local = False} \\ tile <- candidates]
    (Host (unselectedImage d))
    where
    candidates = [tile \\ tile <- possible_tiles trax coord | isJust (mandatory_moves (add_tile coord tile trax) coord)]
    ......
    Examples/Graphics/BasicImagesExamples/Circles.icl 0 → 100644
    View file @ eb7fd96f
    module Circles
    import iTasks => qualified grid
    import Data.Func
    from Graphics.Scalable.Internal.Types import :: LookupSpan
    import iTasks.Extensions.SVG.SVGEditor
    Start w = doTasks gui6 w
    gui6 :: Task [(Span, Span, Span)]
    gui6 = updateInformation
    [UpdateUsing id (const id) (fromSVGEditor svged)]
    [(px 5.0, px 5.0, px 5.0)]
    svged :: SVGEditor [(Span, Span, Span)] [(Span, Span, Span)]
    svged = {initView=id, renderImage=renderImage, updModel= \m v->v}
    where
    renderImage _ images ts
    = overlay [(AtMiddleX, AtMiddleY)] [(px 0.0, px 0.0)] [img]
    $ Host $ rect (px 1000.0) (px 1000.0) <@< {fill=toSVGColor "white"}
    where
    img = collage [(x, y)\\(_, x, y)<-images] [circle r\\(r, _, _)<-images]
    $ Host $ rect (px 100.0) (px 100.0)
    <@< {fill=toSVGColor "white"}
    <@< {onclick= \(x, y) m->[(px 5.0, x, y):m],local=False}
    derive gEditor FontDef`
    derive gText FontDef`
    derive class iTask Span, LookupSpan, ImageTag
    Libraries/iTasks/Extensions/SVG/SVGEditor.icl
    View file @ eb7fd96f
    ......@@ -723,7 +723,7 @@ where
    = 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
    doMouseEvent` svglet=:{SVGEditor | initView,renderImage,updModel} me svg elemId uniqId p cb_data local _ world
    doMouseEvent` svglet=:{SVGEditor | initView,renderImage,updModel} me svg elemId uniqId p cb_data local args world
    #! world = jsTrace` ("doMouseEvent` " +++ "[" +++ join "," (map toString p) +++ "] " +++ toString cb_data) world
    #! world = timeTrace "doMouseEvent` started at " world
    #! (cidJS,world) = me .# "attributes.taskId" .? world
    ......@@ -734,8 +734,29 @@ where
    = case getImgEventhandler image` p of
    Nothing = timeTrace "doMouseEvent` reached illegal code section ended at " world // this code should never be reached
    Just f
    // Translate the raw DOM coordinates to SVG coordinates relative to the image of the handler
    // https://www.sitepoint.com/how-to-translate-from-dom-to-svg-coordinates-and-back-again
    // Get the absolute coordinates for the viewport
    #! (point, world) = (svg `createSVGPoint` ()) world
    #! world = (point .# "x" .= args.[0] .# "clientX") world
    #! world = (point .# "y" .= args.[0] .# "clientY") world
    #! (m, world) = (svg `getScreenCTM` ()) world
    #! (inv, world) = (m `inverse` ()) world
    #! (point, world) = (point `matrixTransform` inv) world
    #! (ax, world) = point .# "x" .? world
    #! (ay, world) = point .# "y" .? world
    #! (ax, ay) = (jsValToReal` 0.0 ax, jsValToReal` 0.0 ay)
    // Get the coordinates for the image that was clicked in
    #! (bRect, world) = (args.[0] .# "target" .# "getBoundingClientRect" .$ ()) world
    #! (ix, world) = bRect .# "left" .? world
    #! (iy, world) = bRect .# "top" .? world
    #! (ix, iy) = (jsValToReal` 0.0 ix, jsValToReal` 0.0 iy)
    // Compensate for the scrolling
    #! (sx, world) = jsWindow .# "scrollX" .? world
    #! (sy, world) = jsWindow .# "scrollY" .? world
    #! (sx, sy) = (jsValToReal` 0.0 sx, jsValToReal` 0.0 sy)
    // Update the view & the model
    #! view = applyImgEventhandler f cb_data view
    #! view = applyImgEventhandler (px (ax - (ix + sx)), px (ay - (iy + sy))) f cb_data view
    #! model = updModel model view
    #! (jsView,world) = jsMakeCleanReference view me world
    #! (jsModel,world)= jsMakeCleanReference model me world
    ......@@ -750,15 +771,15 @@ where
    #! world = timeTrace "doMouseEvent` calls server round trip started at " world
    = world // rendering is completed by clientHandleAttributeChange
    where
    applyImgEventhandler :: !(ImgEventhandler m) !MouseCallbackData m -> 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
    applyImgEventhandler (ImgEventhandlerOnMouseMoveAttr {OnMouseMoveAttr | onmousemove = f}) _ m = f m
    applyImgEventhandler (ImgEventhandlerOnMouseOutAttr {OnMouseOutAttr | onmouseout = f}) _ m = f m
    applyImgEventhandler _ _ m = m // this case should never be reached (including ImgEventhandlerDraggableAttr)
    applyImgEventhandler :: (!Span, !Span) !(ImgEventhandler m) !MouseCallbackData m -> m
    applyImgEventhandler span (ImgEventhandlerOnClickAttr {OnClickAttr | onclick = f}) _ m = f span m
    applyImgEventhandler _ (ImgEventhandlerOnNClickAttr {OnNClickAttr | onNclick = f}) (MouseOnClickData n) m = f n m
    applyImgEventhandler span (ImgEventhandlerOnMouseDownAttr {OnMouseDownAttr | onmousedown = f}) _ m = f span m
    applyImgEventhandler span (ImgEventhandlerOnMouseUpAttr {OnMouseUpAttr | onmouseup = f}) _ m = f span m
    applyImgEventhandler span (ImgEventhandlerOnMouseOverAttr {OnMouseOverAttr | onmouseover = f}) _ m = f span m
    applyImgEventhandler span (ImgEventhandlerOnMouseMoveAttr {OnMouseMoveAttr | onmousemove = f}) _ m = f span m
    applyImgEventhandler span (ImgEventhandlerOnMouseOutAttr {OnMouseOutAttr | onmouseout = f}) _ m = f span m
    applyImgEventhandler _ _ _ m = m // this case should never be reached (including ImgEventhandlerDraggableAttr)
    // client side entire rendering of model value:
    clientHandleModel :: !(SVGEditor s v) !JSVal !s !v !*JSWorld -> *JSWorld | JSONEncode{|*|} s
    ......
    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