Daniel Barlow
acbe27e6e2
This massively reduces cpu usage, however it doesn't yet work if we've moved far enough that we'd need to fetch new tiles.
274 lines
7.5 KiB
Fennel
274 lines
7.5 KiB
Fennel
; (local { : view } (require :fennel))
|
|
(local { : fdopen } (require :posix.stdio))
|
|
(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))
|
|
|
|
(var map-surface nil)
|
|
|
|
(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
|
|
}))
|
|
|
|
(fn cairo-the-map [window]
|
|
(let [{ : lat : lon : zoom } app-state
|
|
{ : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom)
|
|
lines []]
|
|
|
|
(for [x bounds.min.x bounds.max.x]
|
|
(for [y bounds.min.y bounds.max.y]
|
|
(merge lines (tiles.polylines 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)))
|
|
g (cairo.Context.create map-surface)]
|
|
|
|
(g:set_source_rgb 1 1 1)
|
|
(g:rectangle 0 0 (* tile-size num-tiles-x) (* tile-size num-tiles-y))
|
|
(g:fill)
|
|
|
|
(g:set_source_rgb 0.2 0.2 0.6)
|
|
(g:set_line_width 2)
|
|
(each [_ line (pairs lines)]
|
|
(case line
|
|
[[sx sy] & more]
|
|
(do
|
|
(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)
|
|
map-surface)))
|
|
|
|
|
|
(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]
|
|
(merge app-state new-vals)
|
|
(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)))
|
|
|
|
|
|
(window:add
|
|
(doto (Gtk.Overlay {})
|
|
(: :add (osm-widget))
|
|
(: :add_overlay (readouts))
|
|
(: :add_overlay (arrow))
|
|
))
|
|
|
|
(window:show_all)
|
|
(styles)
|
|
(Gtk:main)
|