; (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)