extract TileMap and Pos modules

This commit is contained in:
Daniel Barlow 2024-11-22 23:39:30 +00:00
parent c81b37a65e
commit ff0e5fe75c
6 changed files with 121 additions and 95 deletions

View File

@ -3,6 +3,7 @@ default: frontend/frontend.js dist-newstyle/build/x86_64-linux/ghc-9.6.5/souples
dist-newstyle/build/x86_64-linux/ghc-9.6.5/souplesse-0.1.0.0/x/souplesse/build/souplesse/souplesse: app/*.hs lib/*.hs dist-newstyle/build/x86_64-linux/ghc-9.6.5/souplesse-0.1.0.0/x/souplesse/build/souplesse/souplesse: app/*.hs lib/*.hs
cabal build cabal build
frontend/frontend.js: frontend/src/Main.elm frontend/src/Lib.elm frontend/src/Point.elm FRONTEND=Main.elm Lib.elm Point.elm Pos.elm TileMap.elm
frontend/frontend.js: $(patsubst %,frontend/src/%,$(FRONTEND))
elm-test frontend/tests/ elm-test frontend/tests/
elm make --output=$@ $< elm make --output=$@ $<

View File

@ -11,7 +11,8 @@ import Lib exposing(..)
import List.Extra exposing(find) import List.Extra exposing(find)
import Json.Decode as D import Json.Decode as D
import Http import Http
import Point exposing(Point, Pos ,decoder) import Point exposing (Point, decoder)
import Pos exposing (Pos)
import Svg exposing (Svg, svg, rect, g, polyline, line) import Svg exposing (Svg, svg, rect, g, polyline, line)
import Svg.Attributes as S exposing import Svg.Attributes as S exposing
( viewBox ( viewBox
@ -22,6 +23,7 @@ import Svg.Attributes as S exposing
, fill , fill
, stroke, strokeWidth, strokeOpacity) , stroke, strokeWidth, strokeOpacity)
import Time import Time
import TileMap exposing (..) -- (tiles, FineZoomLevel, toZoomCoord, toCoord)
import Url.Parser exposing (Parser, (<?>), int, map, s, string) import Url.Parser exposing (Parser, (<?>), int, map, s, string)
import Url.Parser.Query as Query import Url.Parser.Query as Query
import Url exposing (Url) import Url exposing (Url)
@ -47,73 +49,6 @@ main =
-- MATHS -- MATHS
-- Coordinates in a Mercator projection
type alias Coord = { x: Float, y: Float }
-- zoom level
type alias ZoomLevel = Int
type FineZoomLevel = FineZoomLevel Int
zoomStep = 8
toZoom : FineZoomLevel -> ZoomLevel
toZoom (FineZoomLevel f) = f // zoomStep
incZoom : FineZoomLevel -> Int -> FineZoomLevel
incZoom (FineZoomLevel z) delta =
FineZoomLevel (clamp 0 (20 * zoomStep) (z + delta))
type alias TileNumber = { x: Int, y: Int }
-- project lat/long to co-ordinates based on pseudocode at
-- https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Zoom_levels
sec x = 1 / (cos x)
toCoord : Pos -> Coord
toCoord pos =
let
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
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 -> ZoomLevel -> (Int, Int) -> Coord
translatePixels old z (x, y) = translate old (pixelsToCoord z (x, y))
tileCovering : Coord -> ZoomLevel -> TileNumber
tileCovering c z =
TileNumber (truncate (toFloat (2 ^ z) * c.x)) (truncate (toFloat (2 ^ z) * c.y))
pixelFromCoord : Coord -> ZoomLevel -> (Int, Int)
pixelFromCoord c z =
let {x,y} = tileCovering c (z + 8)
in (x,y)
boundingTiles : Coord -> ZoomLevel -> 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 -- MODEL
@ -314,18 +249,6 @@ timeTick duration =
Just n -> n Just n -> n
Nothing -> width Nothing -> width
tileUrl : TileNumber -> ZoomLevel -> 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) ] []
type alias Colour = String type alias Colour = String
measureView : String -> Colour -> (Point -> Maybe Float) -> List Point -> Svg Msg measureView : String -> Colour -> (Point -> Maybe Float) -> List Point -> Svg Msg
@ -578,12 +501,6 @@ trackView leftedge topedge zoom points =
px x = String.fromInt x ++ "px" px x = String.fromInt x ++ "px"
tiles xs ys zoom =
List.map
(\ y -> div []
(List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
ys
ifTrack : Model -> (List Point -> Html msg) -> Html msg ifTrack : Model -> (List Point -> Html msg) -> Html msg
ifTrack model content = ifTrack model content =
case model.track of case model.track of

View File

@ -1,12 +1,7 @@
module Point exposing(Pos, Point, decoder, downsample, duration, subseq, startTime, centre) module Point exposing(Point, decoder, downsample, duration, subseq, startTime, centre)
import Json.Decode as D import Json.Decode as D
import Pos exposing (Pos)
type alias Pos =
{ lat : Float
, lon : Float
, ele : Maybe Float
}
type alias Point = type alias Point =

7
frontend/src/Pos.elm Normal file
View File

@ -0,0 +1,7 @@
module Pos exposing (Pos)
type alias Pos =
{ lat : Float
, lon : Float
, ele : Maybe Float
}

105
frontend/src/TileMap.elm Normal file
View File

@ -0,0 +1,105 @@
module TileMap exposing (tiles
, FineZoomLevel(..)
, ZoomLevel
, Coord
, toCoord
, toZoom
, translate
, translatePixels
, incZoom
, boundingTiles
, pixelsToCoord
, pixelFromCoord
, zoomStep)
import Html exposing (img, div)
import Html.Attributes as H exposing (src, style, width, height)
import Pos exposing (Pos)
type alias TileNumber = { x: Int, y: Int }
-- Coordinates in a Mercator projection
type alias Coord = { x: Float, y: Float }
-- zoom level
type alias ZoomLevel = Int
type FineZoomLevel = FineZoomLevel Int
zoomStep = 8
toZoom : FineZoomLevel -> ZoomLevel
toZoom (FineZoomLevel f) = f // zoomStep
incZoom : FineZoomLevel -> Int -> FineZoomLevel
incZoom (FineZoomLevel z) delta =
FineZoomLevel (clamp 0 (20 * zoomStep) (z + delta))
-- project lat/long to co-ordinates based on pseudocode at
-- https://wiki.openstreetmap.org/wiki/Slippy_map_tilenames#Zoom_levels
sec x = 1 / (cos x)
toCoord : Pos -> Coord
toCoord pos =
let
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
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 -> ZoomLevel -> (Int, Int) -> Coord
translatePixels old z (x, y) = translate old (pixelsToCoord z (x, y))
tileCovering : Coord -> ZoomLevel -> TileNumber
tileCovering c z =
TileNumber (truncate (toFloat (2 ^ z) * c.x)) (truncate (toFloat (2 ^ z) * c.y))
pixelFromCoord : Coord -> ZoomLevel -> (Int, Int)
pixelFromCoord c z =
let {x,y} = tileCovering c (z + 8)
in (x,y)
boundingTiles : Coord -> ZoomLevel -> 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)))
tileUrl : TileNumber -> ZoomLevel -> 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) ] []
tiles xs ys zoom =
List.map
(\ y -> div []
(List.map (\ x -> tileImg zoom (TileNumber x y)) xs))
ys

View File

@ -1,6 +1,7 @@
module PointTest exposing (specs) module PointTest exposing (specs)
import Point exposing (Point, Pos, downsample, subseq) import Point exposing (Point, downsample, subseq)
import Pos exposing (Pos)
import Test exposing (..) import Test exposing (..)
import Expect exposing (Expectation) import Expect exposing (Expectation)