use Pos instead of curried lat/long

we can only drag one thing at a time anyway

frontend/src/Main.elm

@@ -80,11 +80,11 @@ type alias Lng = Float
 
 sec x = 1 / (cos x)
 
-toCoord : Lat -> Lng -> Coord
-toCoord lat lng =
+toCoord : Pos -> Coord
+toCoord pos =
     let
-        lat_rad = lat * pi / 180
-        x = (lng + 180) / 360
+        lat_rad = pos.lat * pi / 180
+        x = (pos.lon + 180) / 360
         y = (1 - (logBase e ((tan lat_rad) + (sec lat_rad))) / pi) / 2
     in
         Coord x y
@@ -126,27 +126,35 @@ boundingTiles centre z width height =
 
 -- MODEL
 
+type DragTarget = Map | Graph | StartMark | EndMark
+
 type Drag
     = None
-    | Dragging  (Int, Int)  (Int, Int)
+    | Dragging DragTarget (Int, Int)  (Int, Int)
+
 
 dragTo : Drag ->  (Int, Int) -> Drag
 dragTo d dest =
     case d of
         None -> None
-        Dragging from to -> Dragging from dest
+        Dragging target from to -> Dragging target from dest
 
-dragDelta d =
+dragDelta target d =
     case d of
-        None -> (0,0)
-        Dragging (fx,fy) (tx,ty) -> (fx-tx, fy-ty)
+        Dragging target_ (fx,fy) (tx,ty) ->
+            if target == target_
+            then (fx-tx, fy-ty)
+            else (0, 0)
+        _ -> (0, 0)
+
+subTuple (fx,fy) (tx,ty) = (fx-tx, fy-ty)
+
 
 type TrackState = Empty | Loading | Failure String | Present (List Point)
 type alias Model =
     { centre: Coord
     , zoom: FineZoomLevel
     , drag: Drag
-    , timeDrag: Drag
     , startTime : Int
     , duration : Int
     , track: TrackState }
@@ -158,7 +166,9 @@ init _ url navKey =
                 Just (Timeline (Just s) (Just d)) -> (s, d)
                 _ -> (10,10)
     in
-        ((Model (toCoord 51.60 -0.01) (FineZoomLevel (13*8)) None None start duration Empty),
+        ((Model
+              (toCoord (Pos 0 0 Nothing))
+              (FineZoomLevel (1*8)) None 0 0 Empty),
              (fetchTrack start duration))
 
 -- SUBSCRIPTIONS
@@ -181,37 +191,45 @@ fetchTrack start duration = Http.get
 
 type Msg
   = MapScale Int
-  | MapDragStart (Int, Int)
-  | MapDrag (Int, Int)
-  | MapDragFinish (Int, Int)
+  | DragStart DragTarget (Int, Int)
+  | Drag (Int, Int)
+  | DragFinish (Int, Int)
   | TimeScale (Float)
-  | TimeDragStart (Int, Int)
-  | TimeDrag (Int, Int)
-  | TimeDragFinish (Int, Int)
   | Loaded (Result Http.Error (List Point))
   | NewUrlRequest
   | UrlChanged
+  | Dribble String
 
 
 update : Msg -> Model -> (Model, Cmd Msg)
 
-update msg model = (newModel msg model, Cmd.none)
+update msg model = (updateModel msg model, Cmd.none)
 
-newModel msg model =
+updateModel msg model =
     case msg of
         MapScale y ->
             { model | zoom = incZoom model.zoom y }
 
-        MapDragStart (x,y) ->
-            { model | drag = Dragging (x,y) (x,y) }
+        DragStart target (x,y) ->
+            { model | drag = Dragging target (x,y) (x,y) }
 
-        MapDrag (x,y) ->
+        Drag (x,y) ->
             { model | drag = dragTo model.drag (x,y) }
 
-        MapDragFinish (x,y) ->
-            { model | drag = None,
-                  centre = translatePixels model.centre (toZoom model.zoom) (dragDelta model.drag) }
-
+        DragFinish (x,y) ->
+            case model.drag of
+                Dragging Map start end ->
+                    { model |
+                          drag = None,
+                          centre = translatePixels model.centre (toZoom model.zoom) (subTuple start end) }
+                Dragging Graph start end ->
+                    { model |
+                          drag = None,
+                          startTime =
+                          let (delta, _) = subTuple start end
+                          in model.startTime + delta * model.duration // portalWidth
+                    }
+                _ -> model
         TimeScale factor ->
             let fudge = factor
                 len = model.duration - floor(fudge)
@@ -220,25 +238,26 @@ newModel msg model =
                ,     duration = len
                }
 
-        TimeDragStart (x,y) ->
-            { model | timeDrag = Dragging (x,y) (x,y) }
-
-        TimeDrag (x,y) ->
-            { model | timeDrag = dragTo model.timeDrag (x,y) }
-
-        TimeDragFinish (x,y) ->
-            { model | timeDrag = None,
-                  startTime =
-                  let (delta, _) = dragDelta model.timeDrag
-                  in model.startTime + delta * model.duration // portalWidth
-            }
         Loaded result ->
             case result of
-                Ok trk -> { model | track = Present trk }
+                Ok trk ->
+                    let start = Maybe.withDefault 0 (Point.startTime trk)
+                        duration = Point.duration trk
+                    in
+                    { model
+                        | track = Present trk
+                        , centre = toCoord (Point.centre trk)
+                        , zoom = FineZoomLevel ( 13  * 8)
+                        , startTime = floor start
+                        , duration = ceiling duration
+                    }
                 Err (Http.BadBody e) -> { model | track = Debug.log e (Failure "e") }
                 Err e -> { model | track = Debug.log "unknown error" (Failure "e") }
         NewUrlRequest -> model
         UrlChanged ->  model
+        Dribble message ->
+            let _ = Debug.log "dribble" message
+            in model
 
 
 -- VIEW
@@ -289,23 +308,20 @@ tileImg zoom tilenumber = img [ width 256,
 type alias Colour = String
 
 measureView : String -> Colour -> (Point -> Maybe Float) -> List Point -> Svg Msg
-measureView title colour fn allPoints =
-    let filteredPoints = Point.downsample 300 allPoints
-        graphHeight = 180
-        startTime = case allPoints of
-                        (p::_) -> p.time
-                        _ -> 0
+measureView title colour fn points =
+    let graphHeight = 180
+        startTime = Maybe.withDefault 0 (Point.startTime points)
         coords p = case (fn p) of
                        Just c ->
                            (String.fromFloat (p.time - startTime)) ++ "," ++
                            (String.fromFloat c) ++ ", "
                        Nothing -> ""
-        maxY = List.foldr max 0 (List.filterMap fn filteredPoints)
-        minY = List.foldr min maxY (List.filterMap fn filteredPoints)
+        maxY = List.foldr max 0 (List.filterMap fn points)
+        minY = List.foldr min maxY (List.filterMap fn points)
         (minYaxis, maxYaxis, tickY) = looseLabels 4 minY maxY
         rangeYaxis = maxYaxis - minYaxis
-        maxX = Point.duration allPoints
-        string = String.concat (List.map coords filteredPoints)
+        maxX = Point.duration points
+        string = String.concat (List.map coords points)
         ttick = timeTick maxX
         firstTimeTick = (toFloat (floor(startTime / ttick))) * ttick - startTime
         ybar n = line
@@ -392,13 +408,13 @@ measureView title colour fn allPoints =
         , xtick 5
         ]
 
-timeAxis allPoints =
-    let filteredPoints = Point.downsample 300 allPoints
-        graphHeight = 30
-        startTime = case allPoints of
-                        (p::_) -> p.time
-                        _ -> 0
-        maxX = Point.duration allPoints
+timeClickDecoder  =
+    D.map Dribble  (D.at ["target", "id"] D.string)
+
+timeAxis points =
+    let graphHeight = 30
+        startTime = Maybe.withDefault 0 (Point.startTime points)
+        maxX = Point.duration points
         ttick = timeTick maxX
         firstTimeTick = (toFloat (floor(startTime / ttick))) * ttick - startTime
         xtick n =
@@ -431,13 +447,35 @@ timeAxis allPoints =
              , fill "#eef"
              , stroke "none"
              ] []
+        markStart x =
+            let x1 = String.fromInt x
+            in Svg.path
+                [ S.d ("M " ++ x1 ++ " 40 " ++
+                         "v -50 h 10 v 10 h -10 v -10")
+                , fill "#7c7"
+                , stroke "#4e4"
+                , H.id "left-marker"
+                , strokeWidth "3"
+                ] []
+        markEnd x =
+            let x1 = String.fromInt x
+            in Svg.path
+                [ S.d ("M " ++ x1 ++ " 40 " ++
+                         "v -50 h -10 v 10 h 10 v -10")
+                , fill "#c77"
+                , stroke "#e44"
+                , H.id "right-marker"
+                , strokeWidth "3"
+                ] []
     in
         svg
         [ width portalWidth
-        , height graphHeight
-        , preserveAspectRatio "none"
+        , height (graphHeight + 20)
+        , on "pointerdown" timeClickDecoder
+        , viewBox ("0 -10 " ++ (String.fromInt portalWidth) ++
+                       "  " ++ (String.fromInt (graphHeight + 10)))
         ]
-        (bg::xticks)
+        (bg::(markStart 22)::(markEnd 422)::xticks)
 
 
 cadenceView : List Point -> Svg Msg
@@ -452,7 +490,7 @@ eleView = measureView "elevation" "#4444ee" (.pos >> .ele)
 trackView : Int -> Int -> ZoomLevel -> List Point -> Svg Msg
 trackView leftedge topedge zoom points =
     let plot p =
-            let (x, y) = pixelFromCoord (toCoord p.pos.lat p.pos.lon) zoom
+            let (x, y) = pixelFromCoord (toCoord p.pos) zoom
                 x_ = x - leftedge
                 y_ = y - topedge
             in (String.fromInt x_) ++ ", " ++
@@ -490,10 +528,11 @@ ifTrack : Model -> (List Point ->  Html msg) ->  Html msg
 ifTrack model content =
     case model.track of
         Present t ->
-            let (dt, _) = dragDelta model.timeDrag
+            let (dt, _) = dragDelta Graph model.drag
                 dpix = dt * model.duration // portalWidth
                 start = toFloat (model.startTime + dpix)
-                points = Point.subseq t start (toFloat model.duration)
+                points = Point.subseq t start (toFloat model.duration) |>
+                         Point.downsample 300
             in  content points
         Failure f -> Debug.log f (div [] [ Html.text "failure", Html.text f])
         Loading -> div [] [Html.text "loading"]
@@ -521,11 +560,12 @@ canvas centre zoom width height model =
             ,style "left" (px -offsetX)
             ,style "top" (px -offsetY)
             ,style "lineHeight" (px 0)
-            ,Pointer.onUp (\e -> MapDragFinish (epos e))
-            ,Pointer.onMove (\e -> MapDrag (epos e))
-            ,Pointer.onDown (\e -> MapDragStart (epos e)) ]
+            ,Pointer.onUp (\e -> DragFinish (epos e))
+            ,Pointer.onMove (\e -> Drag (epos e))
+            ,Pointer.onDown (\e -> DragStart Map (epos e)) ]
         (tv :: tiles xs ys zoom)
 
+
 portalWidth = 600
 portalHeight = 600
 
@@ -545,7 +585,7 @@ timeWheelDecoder =
 
 viewDiv : Model -> Html Msg
 viewDiv model =
-    let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta model.drag))
+    let coord = translate model.centre (pixelsToCoord (toZoom model.zoom) (dragDelta Map model.drag))
         canvasV = canvas coord (toZoom model.zoom) portalWidth portalHeight model
         epos e = Tuple.mapBoth floor floor e.pointer.clientPos
     in div [ style "display" "flex"
@@ -568,9 +608,9 @@ viewDiv model =
               ]
         , div [ style "display" "flex"
               , Html.Events.custom "wheel" timeWheelDecoder
-              , Pointer.onUp (\e -> TimeDragFinish (epos e))
-              , Pointer.onMove (\e -> TimeDrag (epos e))
-              , Pointer.onDown (\e -> TimeDragStart (epos e))
+              , Pointer.onUp (\e -> DragFinish (epos e))
+              , Pointer.onMove (\e -> Drag (epos e))
+              , Pointer.onDown (\e -> DragStart Graph (epos e))
               , style "flex-direction" "column"
               , style "row-gap" "10px"
               ]

frontend/src/Point.elm

@@ -1,4 +1,4 @@
-module Point exposing(Pos, Point, decoder, downsample, duration, subseq)
+module Point exposing(Pos, Point, decoder, downsample, duration, subseq, startTime, centre)
 
 import Json.Decode as D
 
@@ -63,6 +63,35 @@ duration points =
         (p::ps) -> (last p ps).time - p.time
         _ -> 0
 
+startTime points =
+    case points of
+        (p::ps) -> Just p.time
+        _ -> Nothing
+
+type Bound = Bound Pos Pos | NoBound
+
+extendBound : Pos -> Bound -> Bound
+extendBound pos b =
+    let {lat, lon} = pos
+    in case b of
+           (Bound p1 p2) ->
+               Bound
+               (Pos (min lat p1.lat)  (min lon p1.lon) Nothing)
+               (Pos (max lat p2.lat)  (max lon p2.lon) Nothing)
+           NoBound ->
+               Bound pos pos
+
+bounds points =
+    List.foldr extendBound NoBound (List.map .pos points)
+
+centre points =
+    case bounds points of
+        Bound min max -> Pos
+                         ((max.lat + min.lat) / 2)
+                         ((max.lon + min.lon) / 2)
+                             Nothing
+        NoBound -> Pos 0 0 Nothing
+
 subseq points start dur =
     case points of
         [] -> []