283 lines
7.8 KiB
Fennel
283 lines
7.8 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))
|
|
|
|
|
|
|
|
(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)))
|
|
|
|
(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)))
|
|
|
|
|
|
(window:add
|
|
(doto (Gtk.Overlay {})
|
|
(: :add (osm-widget))
|
|
(: :add_overlay (readouts))
|
|
(: :add_overlay (arrow))
|
|
))
|
|
|
|
(window:show_all)
|
|
(styles)
|
|
(Gtk:main)
|