dan/souplesse
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

allow dragging the selection markers (no live update)

Browse Source
This commit is contained in:
Daniel Barlow 2024-11-21 23:03:15 +00:00
parent 70a654c472
commit 2c49318823
1 changed files with 70 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
frontend/src/Main.elm
View File

@ -117,7 +117,7 @@ boundingTiles centre z width height =
-- MODEL
type DragTarget = Map | Graph | StartMark | EndMark
type DragTarget = Map | Graph | StartMark | EndMark | NoTarget
type Drag
= None
@ -148,6 +148,7 @@ type alias Model =
, drag: Drag
, startTime : Float
, duration : Float
, markedTime : (Float, Float)
, track: TrackState }
init : () -> Url -> Nav.Key -> (Model, Cmd Msg)
@ -159,7 +160,7 @@ init _ url navKey =
in
((Model
(toCoord (Pos 0 0 Nothing))
(FineZoomLevel (1*8)) None 0 0 Nothing Loading),
(FineZoomLevel (1*8)) None 0 0 (0,0) Loading),
(fetchTrack start duration))
-- SUBSCRIPTIONS
@ -220,6 +221,25 @@ updateModel msg model =
let (delta, _) = subTuple start end
in model.startTime + toFloat delta * model.duration / portalWidth
}
Dragging StartMark start end ->
{ model |
drag = None,
markedTime =
let delta = Tuple.first (subTuple start end)
deltat = toFloat delta * model.duration / portalWidth
(s, d) = model.markedTime
in (s - deltat, d + deltat)
}
Dragging EndMark start end ->
{ model |
drag = None,
markedTime =
let delta = Tuple.first (subTuple start end)
deltat = toFloat delta * model.duration / portalWidth
(s, d) = model.markedTime
in (s, d - deltat)
}
_ -> model
TimeScale factor ->
let fudge = factor
@ -238,10 +258,10 @@ updateModel msg model =
{ model
| track = Present trk
, centre = toCoord (Point.centre trk)
, zoom = FineZoomLevel ( 13 * 8)
, zoom = FineZoomLevel (13 * 8)
, startTime = start
, duration = duration
-- , markedTime = Just (start + 300, duration - 600)
, markedTime = (start + 300, duration - 900)
}
Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") }
Err e -> { model | track = Debug.log "unknown error" (Failure "e") }
@ -400,10 +420,41 @@ measureView title colour fn points =
, xtick 5
]
timeClickDecoder =
D.map Dribble (D.at ["target", "id"] D.string)
type alias TargetedPointerEvent =
{ pointerEvent : Pointer.Event
, targetId : String
}
timeAxis points =
targetedEventDecoder =
D.map2 TargetedPointerEvent
Pointer.eventDecoder
(D.at ["target", "id"] D.string)
targetFor : String -> DragTarget
targetFor s =
case s of
"left-marker" -> StartMark
"right-marker" -> EndMark
_ -> NoTarget
onDownWithTarget tag =
let
decoder =
targetedEventDecoder
|> D.map tag
|> D.map options
options message =
{ message = message
, stopPropagation = True
, preventDefault = True
}
in
Html.Events.custom "pointerdown" decoder
timeAxis model points =
let graphHeight = 30
startTime = Maybe.withDefault 0 (Point.startTime points)
maxX = Point.duration points
@ -459,15 +510,23 @@ timeAxis points =
, H.id "right-marker"
, strokeWidth "3"
] []
markStartPix = case model.markedTime of
(s, d) ->
floor ((s - startTime) * portalWidth/maxX)
markEndPix = case model.markedTime of
(s, d) ->
ceiling ((s - startTime + d) * portalWidth/maxX)
epos e = Tuple.mapBoth floor floor e.pointer.clientPos
in
svg
[ width portalWidth
, height (graphHeight + 20)
, on "pointerdown" timeClickDecoder
, onDownWithTarget (\e -> DragStart (targetFor e.targetId) (epos e.pointerEvent))
, viewBox ("0 -10 " ++ (String.fromInt portalWidth) ++
" " ++ (String.fromInt (graphHeight + 10)))
]
(bg::(markStart 22)::(markEnd 422)::xticks)
(bg::(markStart markStartPix)::(markEnd markEndPix)::xticks)
cadenceView : List Point -> Svg Msg
@ -609,10 +668,10 @@ viewDiv model =
[ div [] [ ifTrack model cadenceView ]
, div [] [ ifTrack model powerView ]
, div [] [ ifTrack model eleView ]
, div [] [ ifTrack model timeAxis ]
, div [] [ ifTrack model (timeAxis model) ]
]
]
view : Model -> Browser.Document Msg
view model =
Browser.Document "Souplesse elm" [ (viewDiv model) ]
Browser.Document "Souplesse" [ (viewDiv model) ]