WIP before change of direction

elm.json

@@ -1,7 +1,7 @@
 {
     "type": "application",
     "source-directories": [
-        "src"
+        "frontend/src"
     ],
     "elm-version": "0.19.1",
     "dependencies": {
@@ -9,13 +9,17 @@
             "elm/browser": "1.0.2",
             "elm/core": "1.0.5",
             "elm/html": "1.0.0",
+            "elm/http": "2.0.0",
+            "elm/svg": "1.0.1",
             "elm/time": "1.0.0",
             "elm-explorations/test": "2.2.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",
+            "elm/file": "1.0.5",
             "elm/json": "1.1.3",
             "elm/parser": "1.1.0",
             "elm/random": "1.0.0",

frontend/src/Main.elm

@@ -0,0 +1,291 @@
+module Main exposing (view)
+
+import Browser
+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)
+import Html.Events.Extra.Pointer as Pointer
+import Maybe exposing (Maybe)
+import Http
+import Svg exposing (Svg, svg, rect, circle, g)
+import Svg.Attributes as S exposing
+    ( viewBox
+    , x, y
+    , r, rx, ry
+    , cx, cy
+    , fill
+    , stroke, strokeWidth, strokeOpacity)
+
+import Track exposing (Track)
+-- import ExampleTrack
+
+
+-- MAIN
+
+
+main =
+  Browser.element { init = init
+                  , update = update
+                  , subscriptions = subscriptions
+                  , view = view }
+
+
+
+-- MATHS
+
+-- Coordinates in a Mercator projection
+type alias Coord = { x: Float, y: Float }
+
+-- zoom level
+type alias Zoom = Int
+
+type alias TileNumber = { x: Int, y: Int }
+
+type alias Lat = Float
+type alias Lng = Float
+
+-- project latling to co-ordinates based on pseudocode at
+-- https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Zoom_levels
+
+sec x = 1 / (cos x)
+
+toCoord : Lat -> Lng -> Coord
+toCoord lat lng =
+    let
+        lat_rad = lat * pi / 180
+        x = (lng + 180) / 360
+        y = (1 - (logBase e ((tan lat_rad) + (sec lat_rad))) / pi) / 2
+    in
+        Coord x y
+
+pixelsToCoord z (x,y) =
+    let x_float = toFloat x / toFloat ( 2 ^ (z + 8))
+        y_float = toFloat y / toFloat ( 2 ^ (z + 8))
+    in Coord x_float y_float
+
+reflect : Coord -> Coord
+reflect c = Coord -c.x -c.y
+
+-- translate : a -> a -> a
+translate base offset =
+    { base | x = (base.x + offset.x), y = (base.y + offset.y) }
+
+translatePixels : Coord -> Zoom -> (Int, Int) -> Coord
+translatePixels old z (x, y) = translate old (pixelsToCoord z (x, y))
+
+
+tileCovering : Coord -> Zoom -> TileNumber
+tileCovering c z =
+    TileNumber (truncate (toFloat (2 ^ z) * c.x)) (truncate (toFloat (2 ^ z) * c.y))
+
+pixelFromCoord : Coord -> Zoom -> (Int, Int)
+pixelFromCoord c z =
+    let {x,y} = tileCovering c (z + 8)
+    in (x,y)
+
+boundingTiles : Coord -> Zoom -> Int -> Int -> (TileNumber, TileNumber)
+boundingTiles centre z width height =
+    -- find the tiles needed to cover the area (`width` x `height`)
+    -- about the point at `centre`
+    let delta = pixelsToCoord z ((width // 2), (height // 2))
+        minCoord = translate centre (reflect delta)
+        maxCoord = translate centre delta
+    in ((tileCovering minCoord z),
+        (translate (tileCovering maxCoord z) (TileNumber 1 1)))
+
+-- MODEL
+
+type Drag
+    = None
+    | Dragging  (Int, Int)  (Int, Int)
+
+dragTo : Drag ->  (Int, Int) -> Drag
+dragTo d dest =
+    case d of
+        None -> None
+        Dragging from to -> Dragging from dest
+
+dragDelta d =
+    case d of
+        None -> (0,0)
+        Dragging (fx,fy) (tx,ty) -> (fx-tx, fy-ty)
+
+type TrackState = Empty | Loading | Failure String | Present Track
+type alias Model =
+    { centre: Coord
+    , zoom: Zoom
+    , drag: Drag
+    , track: TrackState }
+
+init : () -> (Model, Cmd Msg)
+init _ = ((Model (toCoord 51.60 -0.01) 16 None Empty), fetchTrack)
+
+-- SUBSCRIPTIONS
+
+subscriptions : Model -> Sub Msg
+subscriptions model = Sub.none
+
+
+fetchTrack = Http.get
+        { url = "/track.gpx.xml"
+        , expect = Http.expectString Loaded
+        }
+
+
+-- UPDATE
+
+type Msg
+  = ZoomIn
+  | ZoomOut
+  | Scroll Int Int
+  | PointerDown (Int, Int)
+  | PointerMove (Int, Int)
+  | PointerUp (Int, Int)
+  | Loaded (Result Http.Error String)
+
+
+update : Msg -> Model -> (Model, Cmd Msg)
+
+update msg model = (newModel msg model, Cmd.none)
+
+newModel msg model =
+    case msg of
+        ZoomIn ->
+            { model | zoom = model.zoom + 1 }
+
+        ZoomOut ->
+            { model | zoom = model.zoom - 1 }
+
+        Scroll x y ->
+            { model | centre = translatePixels model.centre model.zoom (x,y) }
+
+        PointerDown (x,y) ->
+            { model | drag = Dragging (x,y) (x,y) }
+
+        PointerMove (x,y) ->
+            { model | drag = dragTo model.drag (x,y) }
+
+        PointerUp (x,y) ->
+            { model | drag = None,
+                  centre = translatePixels model.centre model.zoom (dragDelta model.drag) }
+
+        Loaded result ->
+            case result of
+                Ok trk -> { model
+                              | track = case Track.parse trk of
+                                            Ok track -> Present track
+                                            Err _ -> Failure "parse failed"
+                          }
+                Err e -> { model | track = Failure "e" }
+
+-- VIEW
+
+tileUrl : TileNumber -> Zoom -> String
+tileUrl {x,y} z =
+    String.concat ["https://a.tile.openstreetmap.org",
+                       "/", String.fromInt z,
+                       "/", String.fromInt x,
+                       "/", String.fromInt y,
+                       ".png" ]
+
+tileImg zoom tilenumber = img [ width 256,
+                                height 256,
+                                src (tileUrl tilenumber zoom) ] []
+
+trackView : Track -> Svg Msg
+
+
+trackView track =
+    svg
+    [H.style "width" "100%"
+    ,H.style "height" "100%"
+    ,H.style "position" "absolute"
+    ]
+    [ g
+      [fill "none"
+      ,stroke "blue"
+      ,strokeWidth "7"
+      ,strokeOpacity "0.5"]
+      [ rect
+        [ x "10"
+        , y "10"
+        , S.width "100"
+        , S.height "100"
+        , rx "15"
+        , ry "15"
+        ]
+        []
+      , circle
+        [ cx "50"
+        , cy "50"
+        , r "50"
+        ]
+        []
+    ]]
+
+px x = String.fromInt x ++ "px"
+
+tiles xs ys zoom =
+    List.map
+        (\ y -> div []
+             (List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
+        ys
+
+
+canvas centre zoom width height track =
+    let (mintile, maxtile) = boundingTiles centre zoom width height
+        -- offset is pixel difference between centre (which *should*
+        -- be the middle of the image) and actual middle of the canvas
+        (pixelCentreX,pixelCentreY) = pixelFromCoord centre zoom
+        leftedge = mintile.x * 256
+        topedge = mintile.y * 256
+        offsetX = pixelCentreX - (width // 2) - leftedge
+        offsetY = pixelCentreY - (height // 2) - topedge
+        pixWidth = (1 + maxtile.x - mintile.x) * 256
+        pixHeight = (1 + maxtile.y - mintile.y) * 256
+        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
+                 Failure f -> div [] [ text "failure", text f]
+                 Loading -> div [] [text "loading"]
+                 Empty -> div [] [text "no points"]
+    in  div [style "position" "absolute"
+            ,style "width" (px pixWidth)
+            ,style "height" (px pixHeight)
+            ,style "left" (px -offsetX)
+            ,style "top" (px -offsetY)
+            ,style "lineHeight" (px 0)
+            ,Pointer.onUp (\e -> PointerUp (epos e))
+            ,Pointer.onMove (\e -> PointerMove (epos e))
+            ,Pointer.onDown (\e -> PointerDown (epos e)) ]
+        (tv :: tiles xs ys zoom)
+
+portalWidth = 600
+portalHeight = 600
+
+view : Model -> Html Msg
+view 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)) ]
+        ]

src/Main.elm

@@ -1,56 +0,0 @@
-module Main exposing (..)
-
-import Browser
-import Html exposing (Html, button, div, text)
-import Html.Events exposing (onClick)
-import Track exposing (Track)
-
--- MAIN
-
-
-main =
-  Browser.sandbox { init = init, update = update, view = view }
-
-
-
--- MODEL
-
-
-type alias Model = Track
-
-
-init : Model
-init =
-  Track.read "hello"
-
-
-
--- UPDATE
-
-
-type Msg
-  = Increment
-  | Decrement
-
-
-update : Msg -> Model -> Model
-update msg model =
-  case msg of
-    Increment ->
-      model
-
-    Decrement ->
-      model
-
-
-
--- VIEW
-
-
-view : Model -> Html Msg
-view model =
-  div []
-    [ button [ onClick Decrement ] [ text "-" ]
-    , div [] [ text (String.fromInt (List.length model)) ]
-    , button [ onClick Increment ] [ text "+" ]
-    ]