first commit
This commit is contained in:
Christian Lawson-Perfect
commit
5d69d2cad7
15 changed files with 56893 additions and 0 deletions
426
src/App.elm
Normal file
426
src/App.elm
Normal file
|
|
@ -0,0 +1,426 @@
|
|||
port module App exposing (..)
|
||||
|
||||
import Browser
|
||||
import Dict exposing (Dict)
|
||||
import Html as H exposing (Html)
|
||||
import Html.Attributes as HA
|
||||
import Html.Events as HE
|
||||
import Json.Decode as JD
|
||||
import Json.Encode as JE
|
||||
import LatLonDistance exposing (lat_lon_distance, LatLon)
|
||||
import List.Extra as LE
|
||||
import Tuple exposing (pair, first, second)
|
||||
|
||||
port receive_position : (JD.Value -> msg) -> Sub msg
|
||||
|
||||
port send_value : JD.Value -> Cmd msg
|
||||
|
||||
main = Browser.document
|
||||
{ init = init
|
||||
, update = update
|
||||
, subscriptions = subscriptions
|
||||
, view = view
|
||||
}
|
||||
|
||||
type alias Marker =
|
||||
{ pos : LatLon
|
||||
, icon : String
|
||||
, name : String
|
||||
, note : String
|
||||
}
|
||||
|
||||
type Selection
|
||||
= NoSelection
|
||||
| SelectedPosition LatLon
|
||||
| SelectedMarker Int
|
||||
| EditingMarker Int Marker
|
||||
|
||||
blank_marker =
|
||||
{ pos = {lat = 0, lon = 0}
|
||||
, icon = "📌"
|
||||
, name = ""
|
||||
, note = ""
|
||||
}
|
||||
|
||||
type MapCentre
|
||||
= NoCentre
|
||||
| CurrentPositionCentre
|
||||
| PositionCentre LatLon
|
||||
|
||||
type alias Model =
|
||||
{ markers : List Marker
|
||||
, emoji : List Emoji
|
||||
, current_position : LatLon
|
||||
, selection : Selection
|
||||
, new_marker : Marker
|
||||
, accuracy : Float
|
||||
, centre : MapCentre
|
||||
}
|
||||
|
||||
init_model =
|
||||
{ markers = []
|
||||
, emoji = []
|
||||
, current_position = {lat = 55.05155870729228, lon = -1.4652193740914812}
|
||||
, selection = NoSelection
|
||||
, new_marker = blank_marker
|
||||
, accuracy = 0
|
||||
, centre = CurrentPositionCentre
|
||||
}
|
||||
|
||||
type Msg
|
||||
= ReceivePosition JD.Value
|
||||
| MapClicked LatLon
|
||||
| MarkerClicked Int
|
||||
| AddMarker
|
||||
| UpdateNewMarker Marker
|
||||
| UpdateExistingMarker Int Marker
|
||||
| EditMarker Int Marker
|
||||
| RemoveMarker Int
|
||||
| ClickCurrentPosition
|
||||
|
||||
type alias Emoji =
|
||||
{ emoji : String
|
||||
, description : String
|
||||
}
|
||||
|
||||
decode_emoji =
|
||||
JD.map2 Emoji
|
||||
(JD.field "emoji" JD.string)
|
||||
(JD.field "description" JD.string)
|
||||
|
||||
type alias Flags =
|
||||
{ emoji : List Emoji
|
||||
, markers : List Marker
|
||||
}
|
||||
|
||||
decode_flags =
|
||||
JD.map2 Flags
|
||||
(JD.field "emoji" (JD.list decode_emoji))
|
||||
(JD.field "markers" (JD.list decode_marker))
|
||||
|
||||
init : (JD.Value) -> (Model, Cmd msg)
|
||||
init vflags =
|
||||
(case JD.decodeValue decode_flags vflags of
|
||||
Err _ -> init_model
|
||||
Ok flags -> { init_model | emoji = flags.emoji, markers = flags.markers }
|
||||
) |> nocmd
|
||||
|
||||
nocmd m = (m, Cmd.none)
|
||||
|
||||
save : Model -> (Model, Cmd Msg)
|
||||
save model =
|
||||
(model
|
||||
, send_value
|
||||
<| JE.object
|
||||
[ ("type", JE.string "save")
|
||||
, ("markers", JE.list identity <| List.indexedMap (\i m -> encode_marker (String.fromInt i) m) model.markers)
|
||||
]
|
||||
)
|
||||
|
||||
update msg model =
|
||||
case msg of
|
||||
ReceivePosition v -> case JD.decodeValue decode_position v of
|
||||
Ok (pos, accuracy) -> { model | current_position = pos, accuracy = accuracy } |> nocmd
|
||||
_ -> model |> nocmd
|
||||
|
||||
MapClicked pos -> case model.selection of
|
||||
NoSelection ->
|
||||
let
|
||||
m = model.new_marker
|
||||
in
|
||||
{ model | selection = SelectedPosition pos, new_marker = { m | pos = pos } } |> nocmd
|
||||
_ -> { model | selection = NoSelection } |> nocmd
|
||||
|
||||
MarkerClicked i ->
|
||||
let
|
||||
marker = LE.getAt i model.markers
|
||||
pos = marker |> Maybe.map .pos
|
||||
centre = case pos of
|
||||
Just p -> PositionCentre p
|
||||
Nothing -> model.centre
|
||||
in
|
||||
{ model | selection = SelectedMarker i, centre = centre } |> nocmd
|
||||
|
||||
AddMarker -> add_marker model |> save
|
||||
|
||||
UpdateNewMarker marker -> { model | new_marker = marker } |> nocmd
|
||||
|
||||
UpdateExistingMarker i marker -> { model | markers = LE.setAt i marker model.markers, selection = SelectedMarker i } |> save
|
||||
|
||||
EditMarker i marker -> { model | selection = EditingMarker i marker } |> nocmd
|
||||
|
||||
RemoveMarker i -> { model | markers = LE.removeAt i model.markers, selection = NoSelection } |> save
|
||||
|
||||
ClickCurrentPosition -> { model | centre = CurrentPositionCentre, selection = NoSelection } |> nocmd
|
||||
|
||||
add_marker model = case model.selection of
|
||||
SelectedPosition pos ->
|
||||
let
|
||||
nm = model.new_marker
|
||||
marker = { nm | pos = pos }
|
||||
in
|
||||
{ model | markers = marker::model.markers, selection = SelectedMarker 0, new_marker = blank_marker }
|
||||
|
||||
_ -> model
|
||||
|
||||
-- For coordinates from the geolocation API
|
||||
decode_latlon : JD.Decoder LatLon
|
||||
decode_latlon =
|
||||
JD.map2 LatLon
|
||||
(JD.field "latitude" JD.float)
|
||||
(JD.field "longitude" JD.float)
|
||||
|
||||
-- For coordinates from leafletjs
|
||||
decode_latlng : JD.Decoder LatLon
|
||||
decode_latlng =
|
||||
JD.map2 LatLon
|
||||
(JD.field "lat" JD.float)
|
||||
(JD.field "lng" JD.float)
|
||||
|
||||
decode_position : JD.Decoder (LatLon, Float)
|
||||
decode_position = JD.map2 pair decode_latlon (JD.field "accuracy" JD.float)
|
||||
|
||||
decode_map_click =
|
||||
JD.at ["detail", "latlng"] decode_latlng
|
||||
|> JD.map MapClicked
|
||||
|
||||
encode_latlng : LatLon -> JE.Value
|
||||
encode_latlng pos =
|
||||
JE.object
|
||||
[ ("lat", JE.float pos.lat)
|
||||
, ("lng", JE.float pos.lon)
|
||||
]
|
||||
|
||||
decode_marker : JD.Decoder Marker
|
||||
decode_marker =
|
||||
JD.map4 Marker
|
||||
(JD.field "pos" decode_latlng)
|
||||
(JD.field "icon" JD.string)
|
||||
(JD.field "name" JD.string)
|
||||
(JD.field "note" JD.string)
|
||||
|
||||
encode_marker : String -> Marker -> JD.Value
|
||||
encode_marker id marker =
|
||||
JE.object
|
||||
[ ("id", JE.string id)
|
||||
, ("pos", encode_latlng marker.pos)
|
||||
, ("icon", JE.string marker.icon)
|
||||
, ("note", JE.string marker.note)
|
||||
, ("name", JE.string marker.name)
|
||||
]
|
||||
|
||||
splitAt : String -> String -> (String, String)
|
||||
splitAt sep str =
|
||||
if str == "" then ("","") else
|
||||
if String.left (String.length sep) str == sep then
|
||||
("", String.dropLeft (String.length sep) str)
|
||||
else
|
||||
let
|
||||
(a,b) = splitAt sep (String.dropLeft 1 str)
|
||||
in
|
||||
((String.left 1 str)++a, b)
|
||||
|
||||
|
||||
decode_marker_click =
|
||||
JD.at ["detail","id"] JD.string
|
||||
|> JD.andThen
|
||||
(\id ->
|
||||
let
|
||||
(l,r) = splitAt "-" id
|
||||
in
|
||||
case id of
|
||||
"current-position" -> JD.succeed ClickCurrentPosition
|
||||
_ -> case l of
|
||||
"marker" -> case String.toInt r of
|
||||
Just i -> JD.succeed (MarkerClicked i)
|
||||
Nothing -> JD.fail <| "Invalid int "++r
|
||||
_ -> JD.fail <| "Invalid marker type "++l
|
||||
)
|
||||
|
||||
subscriptions model =
|
||||
Sub.batch
|
||||
[ receive_position ReceivePosition
|
||||
]
|
||||
|
||||
display_distance : Float -> String
|
||||
display_distance d =
|
||||
let
|
||||
digits = max 1 (floor (logBase 10 d))
|
||||
magnitude = (10^digits)
|
||||
in
|
||||
if digits < 4 then (d/(toFloat magnitude) |> round |> (*) magnitude |> String.fromInt) ++ "m"
|
||||
else ((d/1000) |> round |> String.fromInt) ++ "km"
|
||||
|
||||
string_from_coords : LatLon -> String
|
||||
string_from_coords c = (String.fromFloat c.lat) ++ "," ++ (String.fromFloat c.lon)
|
||||
|
||||
marker_link label i m =
|
||||
H.a
|
||||
[ HE.onClick (MarkerClicked i)
|
||||
, HA.href <| "#marker-"++(String.fromInt i)
|
||||
]
|
||||
[ H.text label ]
|
||||
|
||||
space = H.text " "
|
||||
|
||||
view : Model -> Browser.Document Msg
|
||||
view model =
|
||||
let
|
||||
new_marker = model.new_marker
|
||||
|
||||
selected_marker : List (String, Marker)
|
||||
selected_marker = case model.selection of
|
||||
SelectedPosition pos -> [("",{ new_marker | pos = pos })]
|
||||
_ -> []
|
||||
|
||||
existing_markers : List (String, Marker)
|
||||
existing_markers = List.indexedMap (\i m -> ("marker-"++(String.fromInt i), m)) model.markers
|
||||
|
||||
current_position_marker = [("current-position", { blank_marker | icon = "😀", pos = model.current_position })]
|
||||
|
||||
markers =
|
||||
(current_position_marker ++ existing_markers ++ selected_marker)
|
||||
|> JE.list (\(id,m) -> encode_marker id m)
|
||||
|> JE.encode 0
|
||||
|
||||
edit_marker_form marker update_msg submit extra_elements =
|
||||
H.form
|
||||
[ HE.onSubmit submit
|
||||
, HA.id "marker-form"
|
||||
, HA.class "marker-detail"
|
||||
]
|
||||
([ H.p [] [H.text <| Debug.toString marker.pos]
|
||||
, H.p
|
||||
[]
|
||||
[ H.label [ HA.for "marker-name" ] [ H.text "Name" ]
|
||||
, H.input
|
||||
[ HA.type_ "text"
|
||||
, HA.id "marker-name"
|
||||
, HA.value marker.name
|
||||
, HE.onInput (\s -> update_msg {marker | name = s })
|
||||
]
|
||||
[]
|
||||
, H.label [ HA.for "marker-icon" ] [ H.text "Icon" ]
|
||||
, H.input
|
||||
[ HA.type_ "text"
|
||||
, HA.id "marker-icon"
|
||||
, HA.list "emoji"
|
||||
, HA.value marker.icon
|
||||
, HE.onInput (\s -> update_msg {marker | icon = s })
|
||||
]
|
||||
[]
|
||||
]
|
||||
, H.p
|
||||
[]
|
||||
[ H.label [ HA.for "marker-note" ] [ H.text "Note" ]
|
||||
, H.textarea
|
||||
[ HA.id "marker-note"
|
||||
, HA.value marker.note
|
||||
, HE.onInput (\s -> update_msg {marker | note = s })
|
||||
]
|
||||
[]
|
||||
]
|
||||
, H.datalist
|
||||
[ HA.id "emoji" ]
|
||||
(model.emoji |> List.map (\e -> H.option [HA.value e.emoji] [H.text <| e.emoji ++ " " ++ e.description]))
|
||||
|
||||
]++extra_elements)
|
||||
|
||||
form = case model.selection of
|
||||
SelectedPosition pos ->
|
||||
edit_marker_form
|
||||
model.new_marker
|
||||
UpdateNewMarker
|
||||
AddMarker
|
||||
[ H.p [] [H.button [ HA.type_ "submit" ] [ H.text "Add a marker here" ]]
|
||||
]
|
||||
|
||||
SelectedMarker i -> case LE.getAt i model.markers of
|
||||
Just marker ->
|
||||
H.div
|
||||
[ HA.class "marker-detail" ]
|
||||
[ H.h2
|
||||
[]
|
||||
[ H.button
|
||||
[ HA.type_ "button"
|
||||
, HE.onClick (EditMarker i marker)
|
||||
]
|
||||
[ H.text "Edit" ]
|
||||
, space
|
||||
, H.span [ HA.class "icon" ] [H.text marker.icon ]
|
||||
, space
|
||||
, H.text marker.name
|
||||
]
|
||||
, H.node "mark-down"
|
||||
[]
|
||||
[ H.text marker.note ]
|
||||
]
|
||||
|
||||
Nothing -> H.div [] [H.text ""]
|
||||
|
||||
EditingMarker i marker ->
|
||||
edit_marker_form
|
||||
marker
|
||||
(EditMarker i)
|
||||
(UpdateExistingMarker i marker)
|
||||
[ H.p
|
||||
[]
|
||||
[ H.button [ HA.type_ "submit" ] [ H.text "Update" ]
|
||||
, space
|
||||
, H.button [ HA.type_ "button", HE.onClick (RemoveMarker i) ] [ H.text "Delete" ]
|
||||
, space
|
||||
, marker_link "Cancel" i marker
|
||||
]
|
||||
]
|
||||
|
||||
NoSelection ->
|
||||
H.div
|
||||
[ HA.id "menu"
|
||||
, HA.class "marker-detail"
|
||||
]
|
||||
[ H.h1 [] [ H.text "Closest markers" ]
|
||||
, H.ul
|
||||
[]
|
||||
(List.map (\(i,m) ->
|
||||
H.li []
|
||||
[ marker_link (m.icon ++ " " ++ m.name) i m ]
|
||||
)
|
||||
(closest_markers |> List.take 3)
|
||||
)
|
||||
]
|
||||
|
||||
closest_markers =
|
||||
model.markers
|
||||
|> List.indexedMap pair
|
||||
|> List.sortBy (second >> .pos >> lat_lon_distance model.current_position)
|
||||
|
||||
selection_str = case model.selection of
|
||||
NoSelection -> "none"
|
||||
SelectedPosition _ -> "position"
|
||||
SelectedMarker _ -> "viewing-marker"
|
||||
EditingMarker _ _ -> "editing-marker"
|
||||
|
||||
(centre_mode, centre) = case model.centre of
|
||||
NoCentre -> (False, model.current_position)
|
||||
CurrentPositionCentre -> (True, model.current_position)
|
||||
PositionCentre pos -> (True, pos)
|
||||
in
|
||||
{
|
||||
title = "CLP's map",
|
||||
body =
|
||||
[ H.main_
|
||||
[ HA.attribute "data-selection" selection_str
|
||||
]
|
||||
[ form
|
||||
, H.node "leaflet-map"
|
||||
[ HA.attribute "markers" <| markers
|
||||
, HA.attribute "lat" <| String.fromFloat centre.lat
|
||||
, HA.attribute "lon" <| String.fromFloat centre.lon
|
||||
, HA.attribute "centre" <| if centre_mode then "true" else "false"
|
||||
, HE.on "mapclick" decode_map_click
|
||||
, HE.on "markerclick" decode_marker_click
|
||||
]
|
||||
[]
|
||||
]
|
||||
]
|
||||
}
|
||||
50
src/LatLonDistance.elm
Normal file
50
src/LatLonDistance.elm
Normal file
|
|
@ -0,0 +1,50 @@
|
|||
module LatLonDistance exposing (lat_lon_distance, LatLon)
|
||||
|
||||
type alias LatLon = { lat : Float, lon : Float }
|
||||
|
||||
lat_lon_distance : LatLon -> LatLon -> Float
|
||||
lat_lon_distance p1 p2 =
|
||||
let
|
||||
a = 6378137.0
|
||||
b = 6356752.314245
|
||||
f = 1 / 298.257223563
|
||||
lat1 = degrees p1.lat
|
||||
lat2 = degrees p2.lat
|
||||
lon1 = degrees p1.lon
|
||||
lon2 = degrees p2.lon
|
||||
|
||||
dlon = (lon2 - lon1)
|
||||
|
||||
tanU1 = (1-f) * (tan lat1)
|
||||
cosU1 = 1 / (sqrt (1 + tanU1 * tanU1))
|
||||
sinU1 = tanU1 * cosU1
|
||||
|
||||
tanU2 = (1-f) * (tan lat2)
|
||||
cosU2 = 1 / (sqrt (1 + tanU2*tanU2))
|
||||
sinU2 = tanU2 * cosU2
|
||||
|
||||
approx lon =
|
||||
let
|
||||
sinlon = sin lon
|
||||
coslon = cos lon
|
||||
sinSqsigma = (cosU2*sinlon) * (cosU2*sinlon) + (cosU1*sinU2-sinU1*cosU2*coslon) ^ 2
|
||||
sinsigma = sqrt sinSqsigma
|
||||
cossigma = sinU1*sinU2 + cosU1*cosU2*coslon
|
||||
sigma = atan2 sinsigma cossigma
|
||||
sinalpha = cosU1 * cosU2 * sinlon / sinsigma
|
||||
cosSqalpha = 1 - sinalpha*sinalpha
|
||||
cos2sigma_m = cossigma - 2*sinU1*sinU2/cosSqalpha
|
||||
c = f/16*cosSqalpha*(4+f*(4-3*cosSqalpha))
|
||||
lon_ = dlon + (1-c) * f * sinalpha * (sigma + c*sinsigma*(cos2sigma_m+c*cossigma*(-1+2*cos2sigma_m*cos2sigma_m)))
|
||||
|
||||
uSq = cosSqalpha * (a*a - b*b) / (b*b)
|
||||
biga = 1 + uSq/16384*(4096+uSq*(-768+uSq*(320-175*uSq)))
|
||||
bigb = uSq/1024 * (256+uSq*(-128+uSq*(74-47*uSq)))
|
||||
deltasigma = bigb*sinsigma*(cos2sigma_m+bigb/4*(cossigma*(-1+2*cos2sigma_m*cos2sigma_m)-bigb/6*cos2sigma_m*(-3+4*sinsigma*sinsigma)*(-3+4*cos2sigma_m*cos2sigma_m)))
|
||||
|
||||
s = b*biga*(sigma-deltasigma)
|
||||
|
||||
in
|
||||
if abs (lon - lon_) > 1e-12 then (approx lon_) else s
|
||||
in
|
||||
approx dlon
|
||||
Loading…
Add table
Add a link
Reference in a new issue