README.md

@@ -104,7 +104,7 @@ _Do not look below this line_
   sessions are then presented to the rider who may approve them
   as-is - perhaps involving other data collection as well ("perceived
   effort" or "which bike setup was this" or ...) - or chop them up
-  using information they have but that the computer doesn't
+  using information thy have but the computer doesn't
 
 in theory we don't even need draft sessions and we could have the
 rider create sessions from the calendar page. However, that's a GET
@@ -119,10 +119,38 @@ we show time spent in HR zones ...
 
 ----
 
-start and end marks can be drag targets but we also need to know where
+time axis wants to show ticks which are at least (portalWidth/4)
-they are when they're not being dragged
+pixels apart, and choose the smallest of the following time intervals
+which are greater than that width
 
-selectedRange start, duration
+1 second
+5 seconds
+15 seconds
+30 seconds
+60 seconds
+5 minutes
+15 minutes
+1 hour
+3 hours
+6 hours
+24 hours
+
+if the full width is 240 seconds, show a tick every 60 second
+if the full width is 20 seconds, show a tick every 5 seconds
+
+if the width grows past 20 seconds, the distance between points shrinks
+and therefore we put ticks less often
+
+if width <= 4 * 5, 5 second tick
+if width <= 4 * 15, 15 second tick
+etc ...
+
+to convert time to pixels, multiply by portalWidth / duration
+
+
+
+
+portalWidth / duration
 
 
 

default.nix

@@ -18,7 +18,6 @@ in haskellEnv.overrideAttrs(o: {
                   elm-format
                   elm-optimize-level-2
                   elm-review
-                  elm-analyse
                   elm-test
                 ]);
 })

elm.json

@@ -17,7 +17,9 @@
             "elm/url": "1.0.0",
             "elm-community/list-extra": "8.7.0",
             "elm-explorations/test": "2.2.0",
-            "mpizenberg/elm-pointer-events": "5.0.0"
+            "mpizenberg/elm-pointer-events": "5.0.0",
+            "rtfeldman/elm-iso8601-date-strings": "1.1.4",
+            "ymtszw/elm-xml-decode": "3.2.2"
         },
         "indirect": {
             "elm/bytes": "1.0.8",

frontend/src/Lib.elm

@@ -4,12 +4,19 @@
 module Lib exposing(looseLabels)
 
 
+maybe default val =
+    case val of
+        Just v -> v
+        Nothing -> default
+
 -- https://github.com/cenfun/nice-ticks/blob/master/docs/Nice-Numbers-for-Graph-Labels.pdf
 
+log10 x = logBase 10 x
+expt b x = b^(toFloat x)
+
 niceNumber x round =
-    let expt b ex = b^ toFloat ex
+    let exp = floor (log10 x)
-        exp = floor (logBase 10 x)
+        f = x / (expt 10.0 exp)
-        f = x / expt 10.0 exp
         nfRound = if f < 1.5
                   then 1
                   else if f < 3

frontend/src/Main.elm

@@ -2,7 +2,7 @@ module Main exposing (view)
 
 import Browser
 import Browser.Navigation as Nav
-import Html exposing (Html, button, div, span, text, img)
+import Html exposing (Html, button, div, span, text, img, pre)
 import Html.Attributes as H exposing (src, style, width, height)
 import Html.Events exposing (onClick, on)
 import Html.Events.Extra.Pointer as Pointer
@@ -12,20 +12,24 @@ import List.Extra exposing(find)
 import Json.Decode as D
 import Http
 import Point exposing(Point, Pos ,decoder)
-import Svg exposing (Svg, svg, rect, g, polyline, line)
+import Svg exposing (Svg, svg, rect, circle, g, polyline, line)
 import Svg.Attributes as S exposing
     ( viewBox
     , preserveAspectRatio
     , transform
     , x, y
     , x1, y1 , x2, y2
+    , r, rx, ry
+    , cx, cy
     , fill
+    , points
     , stroke, strokeWidth, strokeOpacity)
-import Time
+import Time exposing(Posix)
-import Url.Parser exposing (Parser, (<?>), int, map, s, string)
+import Url.Parser exposing (Parser, (</>), (<?>), int, map, oneOf, s, string)
 import Url.Parser.Query as Query
 import Url exposing (Url)
 
+
 type Route = Timeline (Maybe Int) (Maybe Int)
 
 routeParser : Parser (Route -> a) a
@@ -41,10 +45,12 @@ main =
       { init = init
       , update = update
       , subscriptions = subscriptions
-      , onUrlRequest = \ _ ->  NewUrlRequest
+      , onUrlRequest = (\ ur ->  NewUrlRequest)
-      , onUrlChange = \ _ -> UrlChanged
+      , onUrlChange = (\ u -> UrlChanged)
       , view = view }
 
+
+
 -- MATHS
 
 -- Coordinates in a Mercator projection
@@ -66,6 +72,9 @@ incZoom (FineZoomLevel z) delta =
 
 type alias TileNumber = { x: Int, y: Int }
 
+type alias Lat = Float
+type alias Lng = Float
+
 -- project lat/long to co-ordinates based on pseudocode at
 -- https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Zoom_levels
 
@@ -117,7 +126,7 @@ boundingTiles centre z width height =
 
 -- MODEL
 
-type DragTarget = Map | Graph | StartMark | EndMark | NoTarget
+type DragTarget = Map | Graph | StartMark | EndMark
 
 type Drag
     = None
@@ -128,7 +137,7 @@ dragTo : Drag ->  (Int, Int) -> Drag
 dragTo d dest =
     case d of
         None -> None
-        Dragging target from _ -> Dragging target from dest
+        Dragging target from to -> Dragging target from dest
 
 dragDelta target d =
     case d of
@@ -146,21 +155,20 @@ type alias Model =
     { centre: Coord
     , zoom: FineZoomLevel
     , drag: Drag
-    , startTime : Float
+    , startTime : Int
-    , duration : Float
+    , duration : Int
-    , markedTime : (Float, Float)
     , track: TrackState }
 
 init : () -> Url -> Nav.Key -> (Model, Cmd Msg)
 init _ url navKey =
     let (start, duration) =
             case Url.Parser.parse routeParser url of
-                Just (Timeline (Just s) (Just d)) -> (toFloat s, toFloat d)
+                Just (Timeline (Just s) (Just d)) -> (s, d)
                 _ -> (10,10)
     in
         ((Model
               (toCoord (Pos 0 0 Nothing))
-              (FineZoomLevel (1*8)) None 0 0 (0,0) Loading),
+              (FineZoomLevel (1*8)) None 0 0 Empty),
              (fetchTrack start duration))
 
 -- SUBSCRIPTIONS
@@ -171,9 +179,9 @@ subscriptions model = Sub.none
 
 fetchTrack start duration = Http.get
         { url = ("http://localhost:3000/points?start=" ++
-                     String.fromInt (floor start) ++
+                     String.fromInt start ++
                      "&duration=" ++
-                     String.fromInt (ceiling duration))
+                     String.fromInt duration)
         , expect = Http.expectJson Loaded (D.list Point.decoder)
         }
 
@@ -219,33 +227,14 @@ updateModel msg model =
                           drag = None,
                           startTime =
                           let (delta, _) = subTuple start end
-                          in model.startTime + toFloat delta * model.duration / portalWidth
+                          in model.startTime + 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
-                len = model.duration - fudge
+                len = model.duration - floor(fudge)
             in { model |
-                     startTime = model.startTime + fudge / 2
+                     startTime = model.startTime + floor(fudge / 2)
                ,     duration = len
                }
 
@@ -259,9 +248,8 @@ updateModel msg model =
                         | track = Present trk
                         , centre = toCoord (Point.centre trk)
                         , zoom = FineZoomLevel ( 13  * 8)
-                        , startTime = start
+                        , startTime = floor start
-                        , duration = duration
+                        , duration = ceiling duration
-                        , 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") }
@@ -420,41 +408,10 @@ measureView title colour fn points =
         , xtick 5
         ]
 
-type alias TargetedPointerEvent =
+timeClickDecoder  =
-    { pointerEvent : Pointer.Event
+    D.map Dribble  (D.at ["target", "id"] D.string)
-    , targetId : String
-    }
 
-targetedEventDecoder =
+timeAxis points =
-    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
@@ -510,23 +467,15 @@ timeAxis model 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)
-        , onDownWithTarget (\e -> DragStart (targetFor e.targetId) (epos e.pointerEvent))
+        , on "pointerdown" timeClickDecoder
         , viewBox ("0 -10 " ++ (String.fromInt portalWidth) ++
                        "  " ++ (String.fromInt (graphHeight + 10)))
         ]
-        (bg::(markStart markStartPix)::(markEnd markEndPix)::xticks)
+        (bg::(markStart 22)::(markEnd 422)::xticks)
 
 
 cadenceView : List Point -> Svg Msg
@@ -580,9 +529,9 @@ ifTrack model content =
     case model.track of
         Present t ->
             let (dt, _) = dragDelta Graph model.drag
-                dpix = toFloat dt * model.duration / portalWidth
+                dpix = dt * model.duration // portalWidth
-                start = model.startTime +  dpix
+                start = toFloat (model.startTime + dpix)
-                points = Point.subseq t start 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])
@@ -668,10 +617,10 @@ viewDiv model =
             [ div [] [ ifTrack model cadenceView ]
             , div [] [ ifTrack model powerView ]
             , div [] [ ifTrack model eleView ]
-            , div [] [ ifTrack model (timeAxis model) ]
+            , div [] [ ifTrack model timeAxis ]
             ]
         ]
 
 view : Model -> Browser.Document Msg
 view model =
-    Browser.Document  "Souplesse" [  (viewDiv model) ]
+    Browser.Document  "Souplesse elm" [  (viewDiv model) ]

frontend/src/Point.elm

@@ -38,9 +38,10 @@ last x xs =
         [] -> x
         (x_::xs_) -> last x_ xs_
 
+tracef x = Debug.log (String.fromFloat x) x
+
 -- divide the points into n equal time buckets and return the first
 -- point in each
-downsample : Int -> List Point -> List Point
 downsample n points =
     let
         nextpoint step prev points_ =
@@ -57,16 +58,14 @@ downsample n points =
                 in nextpoint step first rest
             [] -> []
 
-duration : List Point -> Float
 duration points =
     case points of
         (p::ps) -> (last p ps).time - p.time
         _ -> 0
 
-startTime : List Point -> Maybe Float
 startTime points =
     case points of
-        (p::_) -> Just p.time
+        (p::ps) -> Just p.time
         _ -> Nothing
 
 type Bound = Bound Pos Pos | NoBound
@@ -82,11 +81,9 @@ extendBound pos b =
            NoBound ->
                Bound pos pos
 
-bounds : List Point -> Bound
 bounds points =
     List.foldr extendBound NoBound (List.map .pos points)
 
-centre : List Point -> Pos
 centre points =
     case bounds points of
         Bound min max -> Pos
@@ -95,7 +92,6 @@ centre points =
                              Nothing
         NoBound -> Pos 0 0 Nothing
 
-subseq : List Point -> Float -> Float -> List Point
 subseq points start dur =
     case points of
         [] -> []