Daniel Barlow
e5e1060c3f
this is an experiment in making them look less like road when the placement causes them to run off the end of the actual way
361 lines
9.9 KiB
Fennel
361 lines
9.9 KiB
Fennel
; (local { : view } (require :fennel))
|
|
(local { : fdopen } (require :posix.stdio))
|
|
(local cqueues (require :cqueues))
|
|
|
|
(local nmea (require :nmea))
|
|
(local tiles (require :tiles))
|
|
|
|
(import-macros { : define-tests : expect : expect= } :assert)
|
|
|
|
(local {
|
|
: Gtk
|
|
: Gdk
|
|
: Gio
|
|
: GLib
|
|
: cairo
|
|
}
|
|
(require :lgi))
|
|
|
|
(local CSS "
|
|
label.readout {
|
|
font: 48px \"Noto Sans\";
|
|
margin: 10px;
|
|
padding: 5px;
|
|
background-color: rgba(0, 0, 0, 0.2);
|
|
}
|
|
")
|
|
|
|
(local utc-offset
|
|
(let [now (os.time)
|
|
localt (os.date "*t" now)
|
|
utct (os.date "!*t" now)]
|
|
(tset localt :isdst false)
|
|
(os.difftime (os.time localt) (os.time utct))))
|
|
|
|
|
|
(local map-width 720)
|
|
(local map-height 800)
|
|
(local tile-size 256)
|
|
|
|
(fn styles []
|
|
(let [style_provider (Gtk.CssProvider)]
|
|
(Gtk.StyleContext.add_provider_for_screen
|
|
(Gdk.Screen.get_default)
|
|
style_provider
|
|
Gtk.STYLE_PROVIDER_PRIORITY_APPLICATION
|
|
)
|
|
(style_provider:load_from_data CSS)))
|
|
|
|
(local window (Gtk.Window {
|
|
:title "Map"
|
|
:name "toplevel"
|
|
:default_width map-width
|
|
:default_height map-height
|
|
|
|
:on_destroy Gtk.main_quit
|
|
}))
|
|
|
|
(local state-widgets { })
|
|
|
|
(local
|
|
app-state {
|
|
:time-of-day 0
|
|
:elapsed-time 0
|
|
:speed 14
|
|
:lat 49
|
|
:lon 0
|
|
:zoom 17
|
|
:course 22
|
|
}
|
|
)
|
|
|
|
(fn merge [table1 table2]
|
|
(collect [k v (pairs table2) &into table1]
|
|
k v))
|
|
|
|
|
|
|
|
(fn map-bounds [lat lon zoom]
|
|
(let [num-tiles-x (+ 1 (math.ceil (/ map-width tile-size)))
|
|
num-tiles-y (+ 1 (math.ceil (/ map-height tile-size)))
|
|
(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)
|
|
min-tile-x (math.floor (- tile-x (/ num-tiles-x 2)))
|
|
max-tile-x (+ min-tile-x num-tiles-x 4)
|
|
min-tile-y (math.floor (- tile-y (/ num-tiles-y 2)))
|
|
max-tile-y (+ min-tile-y num-tiles-y 4)]
|
|
{
|
|
:min { :x min-tile-x :y min-tile-y }
|
|
:max { :x max-tile-x :y max-tile-y }
|
|
: num-tiles-x : num-tiles-y
|
|
}))
|
|
|
|
(local cq (cqueues.new))
|
|
|
|
(fn cairo-roads-path [g lines bounds]
|
|
(each [_ line (pairs lines)]
|
|
(case line.points
|
|
[[sx sy] & more]
|
|
(do
|
|
(g:save)
|
|
(g:move_to (* tile-size (- sx bounds.min.x))
|
|
(* tile-size (- sy bounds.min.y)))
|
|
(each [_ [x y] (ipairs more)]
|
|
(let [x1 (* tile-size (- x bounds.min.x))
|
|
y1 (* tile-size (- y bounds.min.y))]
|
|
(g:line_to x1 y1)))
|
|
(g:stroke)
|
|
(g:restore)))))
|
|
|
|
(fn label-coords [{ : points } bounds]
|
|
(var biggest 0)
|
|
(var biggest-n 0)
|
|
|
|
(for [i 2 (# points)]
|
|
(let [[x1 y1] (. points (- i 1))
|
|
[x2 y2] (. points i)
|
|
dist
|
|
(+ (* (- x2 x1) (- x2 x1))
|
|
(* (- y2 y1) (- y2 y1)))]
|
|
(when (>= dist biggest)
|
|
(set biggest dist)
|
|
(set biggest-n (- i 1)))))
|
|
(let [[x y] (. points biggest-n)
|
|
[nx ny] (. points (+ 1 biggest-n))
|
|
angle (math.atan (- ny y) (- nx x))]
|
|
(if (> nx x)
|
|
(values
|
|
(* tile-size (- x bounds.min.x))
|
|
(* tile-size (- y bounds.min.y))
|
|
angle)
|
|
(values ; if way runs r->l, prefer label to read l->r
|
|
(* tile-size (- nx bounds.min.x))
|
|
(* tile-size (- ny bounds.min.y))
|
|
(+ math.pi angle)))))
|
|
|
|
|
|
|
|
(fn cairo-the-map [window]
|
|
(let [{ : lat : lon : zoom } app-state
|
|
{ : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom)
|
|
road-width 14
|
|
lines []]
|
|
|
|
(for [x bounds.min.x bounds.max.x]
|
|
(for [y bounds.min.y bounds.max.y]
|
|
(merge lines (tiles.polylines cq x y zoom))))
|
|
|
|
(let [map-surface
|
|
(window:create_similar_surface
|
|
cairo.Content.COLOR
|
|
(* tile-size (+ 4 num-tiles-x))
|
|
(* tile-size (+ 4 num-tiles-y)))
|
|
seen-road-names {}
|
|
g (cairo.Context.create map-surface)]
|
|
|
|
(g:set_source_rgb 0.7 0.8 0.8)
|
|
(g:rectangle 0 0 (* tile-size num-tiles-x) (* tile-size num-tiles-y))
|
|
(g:fill)
|
|
|
|
(g:set_source_rgb 0 0 0)
|
|
(g:set_line_width road-width)
|
|
(cairo-roads-path g lines bounds)
|
|
(g:set_source_rgb 1 1 1)
|
|
(g:set_line_width (- road-width 2))
|
|
(cairo-roads-path g lines bounds)
|
|
|
|
(g:set_source_rgb 0.2 0.2 0.2)
|
|
(g:set_font_size (+ road-width 1))
|
|
(each [_ line (pairs lines)]
|
|
(case line.name
|
|
n (let [(x y angle) (label-coords line bounds)
|
|
ext (g:text_extents n)
|
|
w ext.width
|
|
h ext.height]
|
|
(when (and x y (not (. seen-road-names n)))
|
|
(tset seen-road-names n true)
|
|
(g:save)
|
|
(g:set_line_width h)
|
|
(g:set_source_rgba 1 0.95 1 0.7)
|
|
(g:move_to (- x 1) (- y 1))
|
|
(g:rotate angle)
|
|
(g:rel_line_to (+ w 1) 0)
|
|
(g:stroke)
|
|
(g:restore)
|
|
|
|
(g:save)
|
|
(g:move_to x y)
|
|
(g:rotate angle)
|
|
(g:rel_move_to 0 3)
|
|
(g:text_path n)
|
|
(g:fill)
|
|
(g:restore)))))
|
|
|
|
map-surface)))
|
|
|
|
(var map-surface nil)
|
|
|
|
(fn on-osm-draw [widget g]
|
|
(when (not map-surface)
|
|
(let [window (widget:get_window)]
|
|
(set map-surface (cairo-the-map window))))
|
|
|
|
(let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)
|
|
bounds (map-bounds tile-x tile-y)
|
|
offset-x (- (* tile-size (- tile-x bounds.min.x)) (/ map-width 2))
|
|
offset-y (- (* tile-size (- tile-y bounds.min.y)) (/ map-height 2))]
|
|
|
|
(g:set_source_surface map-surface (- offset-x) (- offset-y))
|
|
(g:set_operator cairo.Operator.SOURCE)
|
|
(g:rectangle 0 0 map-width map-height)
|
|
(g:fill)))
|
|
|
|
|
|
|
|
(fn register-widget [name widget]
|
|
(tset state-widgets name widget)
|
|
widget)
|
|
|
|
(fn osm-widget []
|
|
(register-widget
|
|
:osm
|
|
(Gtk.DrawingArea {
|
|
:width map-width :height map-height
|
|
:on_draw on-osm-draw
|
|
})))
|
|
|
|
(fn readout [name text]
|
|
(register-widget
|
|
name
|
|
(doto (Gtk.Label {:label text : name})
|
|
(-> (: :get_style_context)
|
|
(: :add_class :readout)))))
|
|
|
|
(local knot-in-m-s
|
|
(/ 1852 ; metres in nautical mile
|
|
3600 ; seconds in an hour
|
|
))
|
|
|
|
(fn hhmmss [seconds-since-midnight]
|
|
(let [s (% seconds-since-midnight 60)
|
|
m (% (// (- seconds-since-midnight s) 60) 60)
|
|
h (// (- seconds-since-midnight (* m 60) s) 3600)]
|
|
(string.format "%d:%02d:%02d" h m s)))
|
|
|
|
(expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45")
|
|
|
|
|
|
|
|
|
|
|
|
(fn update-app-state [new-vals]
|
|
(let [old-bounds
|
|
(map-bounds app-state.lat app-state.lon app-state.zoom)]
|
|
(merge app-state new-vals)
|
|
(let [bounds
|
|
(map-bounds app-state.lat app-state.lon app-state.zoom)]
|
|
(when (or
|
|
(not (= old-bounds.min.x bounds.min.x))
|
|
(not (= old-bounds.min.y bounds.min.y)))
|
|
(set map-surface nil)))
|
|
(each [name widget (pairs state-widgets)]
|
|
(case name
|
|
:speed (widget:set_label
|
|
(string.format "%.1f km/h" (* app-state.speed 3.6)))
|
|
:osm (: (widget:get_window) :invalidate_rect nil)
|
|
:arrow (: (widget:get_window) :invalidate_rect nil)
|
|
:time (widget:set_label
|
|
(hhmmss (+ utc-offset app-state.time-of-day)))
|
|
))))
|
|
|
|
|
|
(fn readouts []
|
|
(doto (Gtk.Box
|
|
{
|
|
:orientation Gtk.Orientation.VERTICAL
|
|
:halign Gtk.Align.END
|
|
})
|
|
(-> (: :get_style_context) (: :add_class :readouts))
|
|
(: :add (readout :time ""))
|
|
(: :add (readout :elapsed-time ""))
|
|
(: :add (readout :speed "0"))))
|
|
|
|
(fn arrow []
|
|
(let [height 40]
|
|
(register-widget
|
|
:arrow
|
|
(Gtk.Label {
|
|
:halign Gtk.Align.CENTER
|
|
:valign Gtk.Align.CENTER
|
|
:width height :height height
|
|
:on_draw
|
|
(fn [self g]
|
|
(g:set_source_rgb 0.4 0.0 0.1)
|
|
(g:translate (// height 2) (// height 2))
|
|
(g:rotate (/ (* -2 app-state.course math.pi) 360) )
|
|
(g:translate (// height -2) (// height -2))
|
|
(g:set_line_width 4)
|
|
(g:move_to 10 height)
|
|
(g:line_to (// height 2) 0)
|
|
(g:line_to (- height 10) height)
|
|
(g:fill)
|
|
true)
|
|
}))))
|
|
|
|
|
|
(local socket-path (or (. arg 1) "/var/run/gnss-share.sock"))
|
|
|
|
(local gnss-socket
|
|
(let [addr (Gio.UnixSocketAddress {
|
|
:path socket-path
|
|
})]
|
|
(: (Gio.SocketClient) :connect addr nil)))
|
|
|
|
(fn read-gnss [socket]
|
|
(each [l #(socket:read "l")]
|
|
; (print "gnss" l)
|
|
(if (not (= l ""))
|
|
(let [message (nmea.parse l)]
|
|
(case message
|
|
{ : lat : lon : utc}
|
|
(update-app-state
|
|
{
|
|
: lat : lon
|
|
:time-of-day
|
|
(let [(h m s) (string.match utc "(..)(..)(..)")]
|
|
(+ s (* m 60) (* h 60 60)))
|
|
}
|
|
)
|
|
{ : speed-knots }
|
|
(update-app-state { :speed (* speed-knots knot-in-m-s) }))
|
|
(if message.bearing-true
|
|
(update-app-state { :course message.bearing-true }))
|
|
)))
|
|
true)
|
|
|
|
(let [sock (gnss-socket:get_socket)
|
|
fd (sock:get_fd)
|
|
events [ GLib.IOCondition.IN GLib.IOCondition.HUP]
|
|
channel (GLib.IOChannel.unix_new fd)
|
|
handle (fdopen fd :r)]
|
|
(GLib.io_add_watch channel 0 events #(read-gnss handle)))
|
|
|
|
|
|
(GLib.timeout_add
|
|
GLib.PRIORITY_DEFAULT
|
|
20 ; ms
|
|
(fn []
|
|
(cq:step 0)
|
|
true)
|
|
nil nil)
|
|
|
|
(window:add
|
|
(doto (Gtk.Overlay {})
|
|
(: :add (osm-widget))
|
|
(: :add_overlay (readouts))
|
|
(: :add_overlay (arrow))
|
|
))
|
|
|
|
(window:show_all)
|
|
(styles)
|
|
(Gtk:main)
|