set viewBox for graphs to show full time range

todo: also scale the y axis correctly

elm.json

@@ -1,7 +1,8 @@
 {
     "type": "application",
     "source-directories": [
-        "frontend/src"
+        "frontend/src",
+	"frontend/tests"
     ],
     "elm-version": "0.19.1",
     "dependencies": {

frontend/src/Main.elm

@@ -9,6 +9,7 @@ import Html.Events.Extra.Pointer as Pointer
 import Maybe exposing (Maybe)
 import Json.Decode as D
 import Http
+import Point exposing(Point, Pos ,decoder)
 import Svg exposing (Svg, svg, rect, circle, g, polyline)
 import Svg.Attributes as S exposing
     ( viewBox
@@ -153,42 +154,9 @@ fetchTrack start duration = Http.get
                      String.fromInt start ++
                      "&duration=" ++
                      String.fromInt duration)
-        , expect = Http.expectJson Loaded trackDecoder
+        , expect = Http.expectJson Loaded (D.list Point.decoder)
         }
 
-type alias Pos =
-    { lat : Float
-    , lon : Float
-    , ele : Maybe Float
-    }
-
-
-type alias Point =
-    { time : Float
-    , pos : Pos
-    , cadence : Maybe Int
-    , power : Maybe Int
-    , heartRate : Maybe Int
-    }
-
-posDecoder : D.Decoder Pos
-posDecoder = D.map3 Pos
-             (D.field "lat" D.float)
-             (D.field "lon" D.float)
-             (D.field "ele" (D.maybe D.float))
-
-
-pointDecoder : D.Decoder Point
-pointDecoder = D.map5 Point
-               (D.field "time" D.float)
-               (D.field "pos" posDecoder)
-               (D.field "cadence" (D.maybe D.int))
-               (D.field "power" (D.maybe D.int))
-               (D.field "heartRate" (D.maybe D.int))
-
-trackDecoder : D.Decoder (List Point)
-trackDecoder = D.list pointDecoder
-
 
 
 -- UPDATE
@@ -252,8 +220,49 @@ tileImg zoom tilenumber = img [ width 256,
                                 height 256,
                                 src (tileUrl tilenumber zoom) ] []
 
-trackView : List Point -> Int -> Int -> Zoom -> Svg Msg
-trackView points leftedge topedge zoom =
+
+measureView : (Point -> Maybe Float) -> List Point -> Svg Msg
+measureView fn allPoints =
+    let filteredPoints = Point.downsample 300 allPoints
+        startTime = case allPoints of
+                        (p::_) -> p.time
+                        _ -> 0
+        coords p = case (fn p) of
+                       Just c ->
+                           (String.fromFloat (p.time - startTime)) ++ "," ++
+                           (String.fromFloat c) ++ ", "
+                       Nothing -> ""
+        string = String.concat (List.map coords filteredPoints)
+    in
+        svg
+        [ H.style "width" (px portalWidth)
+        , viewBox ("0 0 " ++ (String.fromFloat (Point.duration allPoints)) ++ " 150")
+        ]
+        [ g
+          [ fill "none"
+          , stroke "red"
+          , strokeWidth "3"
+          ]
+          [
+           polyline
+               [ fill "none"
+               , S.points string
+               ] []
+          ]
+        ]
+
+cadenceView : List Point -> Svg Msg
+cadenceView =
+    measureView (.cadence >> Maybe.map toFloat)
+
+powerView = measureView (.power >> Maybe.map toFloat)
+
+eleView =
+    measureView (.pos >> .ele)
+
+
+trackView : Int -> Int -> Zoom -> List Point -> Svg Msg
+trackView leftedge topedge zoom points =
     let plot p =
             let (x, y) = pixelFromCoord (toCoord p.pos.lat p.pos.lon) zoom
                 x_ = x - leftedge
@@ -289,6 +298,13 @@ tiles xs ys zoom =
              (List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
         ys
 
+ifTrack track content =
+    case track of
+        Present t -> content t
+        Failure f -> Debug.log f (div [] [ text "failure", text f])
+        Loading -> div [] [text "loading"]
+        Empty -> div [] [text "no points"]
+
 
 canvas centre zoom width height track =
     let (mintile, maxtile) = boundingTiles centre zoom width height
@@ -304,11 +320,7 @@ canvas centre zoom width height track =
         xs = List.range mintile.x maxtile.x
         ys = List.range mintile.y maxtile.y
         epos e = Tuple.mapBoth floor floor e.pointer.clientPos
-        tv = case track of
-                 Present t -> trackView t leftedge topedge zoom
-                 Failure f -> Debug.log f (div [] [ text "failure", text f])
-                 Loading -> div [] [text "loading"]
-                 Empty -> div [] [text "no points"]
+        tv = ifTrack track (trackView leftedge topedge zoom)
     in  div [style "position" "absolute"
             ,style "width" (px pixWidth)
             ,style "height" (px pixHeight)
@@ -327,25 +339,31 @@ viewDiv : Model -> Html Msg
 viewDiv model =
     let coord = translate model.centre (pixelsToCoord model.zoom (dragDelta model.drag))
         canvasV = canvas coord model.zoom portalWidth portalHeight model.track
-    in div []
-        [ (div [ style "width" (px portalWidth)
-               , style "height" (px portalHeight)
-               , style "display" "inline-block"
-               , style "position" "relative"
-               , style "overflow" "hidden"]
-               [canvasV])
-        , div [] [ text (String.fromInt model.zoom ) ]
-        , div [] [ case model.track of
-                       -- Present tk -> text (String.fromInt (List.length tk))
-                       _ -> text "dgdfg"
-                 ]
-        , button [ onClick ZoomOut ] [ text "-" ]
-        , button [ onClick ZoomIn ] [ text "+" ]
-        , button [ onClick (Scroll 0 -10) ] [ text "^" ]
-        , button [ onClick (Scroll 0 10) ] [ text "V" ]
-        , button [ onClick (Scroll -10 0) ] [ text "<" ]
-        , button [ onClick (Scroll 10 0) ] [ text ">" ]
---        , div [] [ text (Debug.toString (List.length model.track)) ]
+    in div [ style "display" "flex" ]
+        [ div [ style "display" "flex"
+              , style "flex-direction" "column"]
+              [ div [ style "width" (px portalWidth)
+                    , style "height" (px portalHeight)
+                    , style "display" "inline-block"
+                    , style "position" "relative"
+                    , style "overflow" "hidden"]
+                    [canvasV]
+              , text ("Zoom level " ++ (String.fromInt model.zoom))
+              , span []
+                  [ button [ onClick ZoomOut ] [ text "-" ]
+                  , button [ onClick ZoomIn ] [ text "+" ]
+                  , button [ onClick (Scroll 0 -10) ] [ text "^" ]
+                  , button [ onClick (Scroll 0 10) ] [ text "V" ]
+                  , button [ onClick (Scroll -10 0) ] [ text "<" ]
+                  , button [ onClick (Scroll 10 0) ] [ text ">" ]
+                  ]
+              ]
+        , div [ style "display" "flex"
+              , style "flex-direction" "column"]
+            [ div [] [ ifTrack model.track cadenceView ]
+            , div [] [ ifTrack model.track powerView ]
+            , div [] [ ifTrack model.track eleView ]
+            ]
         ]
 
 view : Model -> Browser.Document Msg

frontend/src/Point.elm

@@ -0,0 +1,64 @@
+module Point exposing(Pos, Point, decoder, downsample, duration)
+
+import Json.Decode as D
+
+type alias Pos =
+    { lat : Float
+    , lon : Float
+    , ele : Maybe Float
+    }
+
+
+type alias Point =
+    { time : Float
+    , pos : Pos
+    , cadence : Maybe Int
+    , power : Maybe Int
+    , heartRate : Maybe Int
+    }
+
+posDecoder : D.Decoder Pos
+posDecoder = D.map3 Pos
+             (D.field "lat" D.float)
+             (D.field "lon" D.float)
+             (D.field "ele" (D.maybe D.float))
+
+
+decoder : D.Decoder Point
+decoder = D.map5 Point
+          (D.field "time" D.float)
+          (D.field "pos" posDecoder)
+          (D.field "cadence" (D.maybe D.int))
+          (D.field "power" (D.maybe D.int))
+          (D.field "heartRate" (D.maybe D.int))
+
+
+last x xs =
+    case xs of
+        [] -> 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 n points =
+    let
+        nextpoint step prev points_ =
+            case points_ of
+                (next::rest) ->
+                    if next.time - prev.time > step
+                    then prev :: (nextpoint step next rest)
+                    else nextpoint step prev rest
+                _ -> [prev]
+    in
+        case points of
+            (first::rest) ->
+                let step = (duration points) / (toFloat n)
+                in nextpoint step first rest
+            [] -> []
+
+duration points =
+    case points of
+        (p::ps) -> (last p ps).time - p.time
+        _ -> 0

frontend/src/Track.elm

@@ -1,43 +0,0 @@
-module Track exposing (Track, Point, parse)
-
-import Result
-import Xml.Decode as XD exposing (path, list, single, floatAttr, stringAttr)
-import Time
-import Iso8601
-
-type alias Position = (Float, Float, Maybe Float) -- lat, lon, ele
-
-type alias Point =
-    { loc : Position
-    , time : Maybe Time.Posix
-    , power : Maybe Int
-    , cadence : Maybe Int
-    , hr : Maybe Int
-    }
-
-type alias Track =  List Point
-
-timeDecoder : XD.Decoder Time.Posix
-timeDecoder = XD.andThen (\ts ->
-                          case Iso8601.toTime ts of
-                              Result.Ok time -> XD.succeed time
-                              Result.Err f -> XD.fail "err"
-                         )
-              XD.string
-
-triple x y z = (x,y,z)
-
-pointDecoder = XD.map5 Point
-               (XD.map3 triple (floatAttr "lat") (floatAttr "lon")
-                        (XD.maybe (path ["ele"] (single XD.float))))
-               (XD.maybe (path ["time"] (single timeDecoder)))
-               (XD.maybe (path ["extensions", "gpxtpx:TrackPointExtension", "pwr:PowerInWatts"] (single XD.int)))
-               (XD.maybe (path ["extensions", "gpxtpx:TrackPointExtension", "gpxtpx:cad"] (single XD.int)))
-               (XD.maybe (path ["extensions", "gpxtpx:TrackPointExtension", "gpxtpx:hr"] (single XD.int)))
-
-
-gpxDecoder =
-             (path [ "trk", "trkseg", "trkpt" ] (list pointDecoder))
-
-
-parse str = XD.run gpxDecoder str

frontend/tests/Fixtures.elm

@@ -1,89 +0,0 @@
-module Fixtures exposing (threepoints, threepoints_expected)
-import Track exposing (Track, Point)
-import Time
-import Maybe
-
-
-threepoints = """
-<?xml version="1.0" encoding="UTF-8"?>
-<gpx
-version="1.1"
-creator="OpenTracks"
-xmlns="http://www.topografix.com/GPX/1/1"
-xmlns:topografix="http://www.topografix.com/GPX/Private/TopoGrafix/0/1"
-xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
-xmlns:opentracks="http://opentracksapp.com/xmlschemas/v1"
-xmlns:gpxtpx="http://www.garmin.com/xmlschemas/TrackPointExtension/v2"
-xmlns:gpxtrkx="http://www.garmin.com/xmlschemas/TrackStatsExtension/v1"
-xmlns:cluetrust="http://www.cluetrust.com/Schemas/"
-xmlns:pwr="http://www.garmin.com/xmlschemas/PowerExtension/v1"
-xsi:schemaLocation="http://www.topografix.com/GPX/1/1 http://www.topografix.com/GPX/1/1/gpx.xsd http://www.topografix.com/GPX/Private/TopoGrafix/0/1 http://www.topografix.com/GPX/Private/TopoGrafix/0/1/topografix.xsd http://www.garmin.com/xmlschemas/TrackPointExtension/v2 https://www8.garmin.com/xmlschemas/TrackPointExtensionv2.xsd http://www.garmin.com/xmlschemas/PowerExtension/v1 https://www8.garmin.com/xmlschemas/PowerExtensionv1.xsd http://www.garmin.com/xmlschemas/TrackStatsExtension/v1 http://www.cluetrust.com/Schemas http://www.cluetrust.com/Schemas/gpxdata10.xsd http://opentracksapp.com/xmlschemas/v1 http://opentracksapp.com/xmlschemas/OpenTracks_v1.xsd">
-<trk>
-<name><![CDATA[2024-10-23T08:34+01]]></name>
-<desc><![CDATA[]]></desc>
-<type><![CDATA[unknown]]></type>
-<extensions>
-</extensions>
-<trkseg>
-<trkpt lat="51.600643" lon="-0.01856">
-<ele>64.8</ele>
-<time>2024-10-23T08:40:52.256+01:00</time>
-<extensions><gpxtpx:TrackPointExtension>
-<gpxtpx:speed>8.49</gpxtpx:speed>
-<gpxtpx:cad>110</gpxtpx:cad>
-<pwr:PowerInWatts>89</pwr:PowerInWatts>
-<opentracks:accuracy_horizontal>3.216</opentracks:accuracy_horizontal><opentracks:distance>17.08</opentracks:distance>
-<cluetrust:distance>1,468.88</cluetrust:distance>
-</gpxtpx:TrackPointExtension></extensions>
-</trkpt>
-<trkpt lat="51.600679" lon="-0.018179">
-<ele>65.5</ele>
-<time>2024-10-23T08:40:55.259+01:00</time>
-<extensions><gpxtpx:TrackPointExtension>
-<gpxtpx:speed>8.57</gpxtpx:speed>
-<gpxtpx:cad>111</gpxtpx:cad>
-<pwr:PowerInWatts>86</pwr:PowerInWatts>
-<opentracks:accuracy_horizontal>3.216</opentracks:accuracy_horizontal><opentracks:distance>17.08</opentracks:distance>
-<cluetrust:distance>1,485.96</cluetrust:distance>
-</gpxtpx:TrackPointExtension></extensions>
-</trkpt>
-<!-- insert-segment -->
-<trkpt lat="51.600697" lon="-0.018064">
-<ele>66.2</ele>
-<time>2024-10-23T08:40:56.231+01:00</time>
-<extensions><gpxtpx:TrackPointExtension>
-<gpxtpx:speed>8.62</gpxtpx:speed>
-<gpxtpx:cad>111</gpxtpx:cad>
-<pwr:PowerInWatts>86</pwr:PowerInWatts>
-<opentracks:accuracy_horizontal>3.216</opentracks:accuracy_horizontal><opentracks:distance>10.675</opentracks:distance>
-<cluetrust:distance>1,496.635</cluetrust:distance>
-</gpxtpx:TrackPointExtension></extensions>
-</trkpt>
-</trkseg>
-</trk>
-</gpx>
-"""
-
-threepoints_expected  =
-    [ (Point
-           (51.600643, -0.01856, Just 64.8)
-           (Just (Time.millisToPosix 1729669252256))
-           (Just 89)
-           (Just 110)
-           Nothing
-      )
-    , (Point
-           (51.600679, -0.018179, Just 65.5)
-           (Just (Time.millisToPosix 1729669255259))
-           (Just 86)
-           (Just 111)
-           Nothing
-      )
-    , (Point
-           (51.600697, -0.018064, Just 66.2)
-           (Just (Time.millisToPosix 1729669256231))
-           (Just 86)
-           (Just 111)
-           Nothing
-      )
-    ]

frontend/tests/PointTest.elm

@@ -0,0 +1,35 @@
+module PointTest exposing (specs)
+
+import Point exposing (Point, Pos, downsample)
+import Test exposing (..)
+import Expect exposing (Expectation)
+
+newPoint i = Point
+             (1731437067 + (toFloat i)*1.2)
+             (Pos 52 1 (Just 10))
+             (Just (round(sin((toFloat i)/10)*10))) (Just i) Nothing
+
+
+points n = List.map newPoint (List.range 0 n)
+
+maybe default val =
+    case val of
+        Just v -> v
+        Nothing -> default
+
+specs: Test
+specs =
+    describe "downsample"
+        [ test "it returns no more points than requested" <|
+              \_ ->
+              let orig = (points 10)
+                  sampled = Point.downsample 5 orig
+              in Expect.equal 5 (List.length sampled)
+        , test "it drops points which are too close together" <|
+              \_ ->
+              let orig = List.map newPoint [ 0, 1, 2, 3, 4, 10, 500, 1000 ]
+                  sampled = Point.downsample 10 orig
+                  idx p = maybe 0 p.power
+              in Expect.equalLists [0, 500, 1000] (List.map idx sampled)
+
+        ]

frontend/tests/TrackTest.elm

@@ -1,57 +0,0 @@
-module TrackTest exposing (specs)
-import Fixtures
-
-import Track exposing (Track, Point)
-import Test exposing (..)
-import Expect exposing (Expectation)
-import Time
-
-specs: Test
-specs =
-    describe "XML Parsing"
-        [ test "it parses points" <|
-              \_ ->
-              case Track.parse Fixtures.threepoints of
-                  (Ok trk) -> Expect.equalLists Fixtures.threepoints_expected trk
-                  _ -> Expect.fail "not ok"
-        , test "missing child ele node in track point" <|
-              \_ ->
-              let
-                  xml = String.replace
-                        "<ele>64.8</ele>"
-                        ""
-                        Fixtures.threepoints
-              in
-                  case Track.parse xml of
-                      Ok (p::pts) ->
-                          case p.loc of
-                              (_, _, ele) -> Expect.equal ele Nothing
-                      Ok _ -> Expect.fail "empty list"
-                      (Err f) -> Expect.fail f
-        , test "heart rate" <|
-              \_ ->
-              let
-                  xml = String.replace
-                        "</gpxtpx:TrackPointExtension>"
-                        "<gpxtpx:hr>97</gpxtpx:hr></gpxtpx:TrackPointExtension>"
-                        Fixtures.threepoints
-              in
-                  case Track.parse xml of
-                      Ok (p::pts) ->
-                          Expect.equal p.hr (Just 97)
-                      Ok _ -> Expect.fail "no points"
-                      (Err f) -> Expect.fail f
-
-        , test "multiple trksegs are coalesced" <|
-              \_ ->
-              let
-                  xml = String.replace
-                        "<!-- insert-segment -->"
-                        "</trkseg><trkseg>"
-                        Fixtures.threepoints
-              in
-                  case Track.parse xml of
-                      (Ok trk) -> Expect.equalLists Fixtures.threepoints_expected trk
-                      _ -> Expect.fail "not ok"
-
-        ]