diff --git a/frontend/src/Main.elm b/frontend/src/Main.elm index 0355696..9b9e012 100644 --- a/frontend/src/Main.elm +++ b/frontend/src/Main.elm @@ -63,11 +63,7 @@ init _ url navKey = case Url.Parser.parse routeParser url of Just (Timeline (Just s) (Just d)) -> (toFloat s, toFloat d) _ -> (10,10) - in - ((Model - (toCoord (Pos 0 0 Nothing)) - (ZoomLevel 0) Nothing 0 0 (0,0) Loading), - (fetchTrack start duration)) + in (Model.empty, fetchTrack start duration) -- SUBSCRIPTIONS @@ -116,18 +112,17 @@ dragUpdate model (newx, newy) = let t = subtractTuple fromxy (newx, newy) in { model | centre = translate fromcoord (pixelsToCoord model.zoom t) } Just (DragGraph (fromx,_) fromtime) -> - let time = secondsFromPixels model (fromx - newx) - in { model | startTime = fromtime + time } - Just (DragLeftMark (fromx,_) (fromtime, fromduration)) -> let time = secondsFromPixels model (fromx - newx) in { model | - markedTime = ((fromtime - time), - (max (fromduration + time) 0)) + startTime = fromtime + time } - Just (DragRightMark (fromx,_) fromduration) -> + Just (DragLeftMark (fromx,_) fromtime) -> let time = secondsFromPixels model (fromx - newx) - in { model | markedTime = (Tuple.first model.markedTime, - (max (fromduration - time) 0)) } + in { model | leftMark = fromtime - time + , rightMark = max (fromtime - time) model.rightMark } + Just (DragRightMark (fromx,_) fromtime) -> + let time = secondsFromPixels model (fromx - newx) + in { model | rightMark = max (fromtime - time) model.leftMark } @@ -149,13 +144,12 @@ updateModel msg model = TimeScale factor -> let startTime = model.startTime + factor / 2 duration = model.duration - factor + clampVisible = clamp startTime (startTime + duration) in { model | startTime = startTime , duration = duration - , markedTime = - let (s, d) = model.markedTime - in ( max s startTime - , (min (s + d) (startTime + duration)) - s) + , leftMark = clampVisible model.leftMark + , rightMark = clampVisible model.rightMark } Loaded result -> @@ -170,7 +164,8 @@ updateModel msg model = , zoom = ZoomLevel (13 * 8) , startTime = start , duration = duration - , markedTime = (start + 300, duration - 900) + , leftMark = start + , rightMark = start + duration } Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") } Err e -> { model | track = Debug.log "unknown error" (Failure "e") } @@ -346,9 +341,9 @@ handleDragMark model e = let epos ev = Tuple.mapBoth floor floor ev.pointer.clientPos in case e.targetId of "left-marker" -> - DragStart (DragLeftMark (epos e.pointerEvent) model.markedTime) + DragStart (DragLeftMark (epos e.pointerEvent) model.leftMark) "right-marker" -> - DragStart (DragRightMark (epos e.pointerEvent) (Tuple.second model.markedTime)) + DragStart (DragRightMark (epos e.pointerEvent) model.rightMark) _ -> Dribble "drag with unknown target" @@ -409,13 +404,9 @@ timeAxis model points = , strokeWidth "3" ] [] markStartPix = - case model.markedTime of - (s, d) -> - floor ((s - startTime) * portalWidth/maxX) + floor ((model.leftMark - startTime) * portalWidth/maxX) markEndPix = - case model.markedTime of - (s, d) -> - ceiling ((s - startTime + d) * portalWidth/maxX) + ceiling ((model.rightMark - startTime) * portalWidth/maxX) in svg [ width portalWidth diff --git a/frontend/src/Model.elm b/frontend/src/Model.elm index de95cc6..332ae2c 100644 --- a/frontend/src/Model.elm +++ b/frontend/src/Model.elm @@ -3,14 +3,16 @@ module Model exposing Model , TrackState(..) , DragState(..) + , empty ) -import TileMap exposing (ZoomLevel, Coord) +import TileMap exposing (ZoomLevel(..), Coord, toCoord) import Point exposing (Point) +import Pos exposing (Pos) type DragState = DragMap (Int, Int) Coord | DragGraph (Int, Int) Float - | DragLeftMark (Int, Int) (Float, Float) + | DragLeftMark (Int, Int) Float | DragRightMark (Int, Int) Float type TrackState = Empty | Loading | Failure String | Present (List Point) @@ -21,5 +23,14 @@ type alias Model = , drag: Maybe DragState , startTime : Float , duration : Float - , markedTime : (Float, Float) + , leftMark : Float + , rightMark : Float , track: TrackState } + +empty = Model + (toCoord (Pos 0 0 Nothing)) + (ZoomLevel 0) + Nothing + 0 0 + 0 0 + Loading