dan/biscuit
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
173a440bd6
biscuit/pkgs/maps/main.fnl
Daniel Barlow 173a440bd6 rotate the offscreen map 
this takes us from 60% cpu to about 20% (on my laptop, your hardware
may vary) when we're travelling in a straight line, as we render the
offscreen map only when the bounds change or the target orientation
changes, not every time we move
2025-06-15 17:52:06 +01:00

519 lines
16 KiB
Fennel
Raw Blame History

; (local { : view } (require :fennel))
(local { : fdopen } (require :posix.stdio))
(local ptime (require :posix.time))
(local cqueues (require :cqueues))
(local nmea (require :nmea))
(local tiles (require :tiles))
(import-macros { : define-tests : expect : expect= } :assert)
(local profile
(and (os.getenv "IN_NIX_SHELL")
(require :libluaperf)))
(macro with-timing [label & body]
`(let [before# (ptime.clock_gettime ptime.CLOCK_PROCESS_CPUTIME_ID)
ret# (table.pack (do ,body))]
(let [after# (ptime.clock_gettime ptime.CLOCK_PROCESS_CPUTIME_ID)]
(print ,label (.. (- after#.tv_sec before#.tv_sec) "s "
(// (- after#.tv_nsec before#.tv_nsec) 1000) "us "))
(table.unpack ret#))))
; (with-timing :loop (for [i 1 100] (print i)))
(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 viewport-width 720)
(local viewport-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)))
(fn main-quit []
(when profile (profile:stop))
(Gtk.main_quit))
(local window (Gtk.Window {
:title "Map"
:name "toplevel"
:default_width viewport-width
:default_height viewport-height
:on_destroy main-quit
}))
(local state-widgets { })
(local
app-state {
:time-of-day 0
:elapsed-time 0
:speed 14
:lat 49
:lon 0
:zoom 17
:course 0 ; direction of travel
:orientation-target 0 ; map rotation angle from north
:orientation-actual 0 ; map rotation angle from north
:tiles {}
}
)
(fn merge [table1 table2]
(collect [k v (pairs table2) &into table1]
k v))
(fn map-bounds-tile [tile-x tile-y]
;; we fetch enough tiles around the current location that the screen
;; can be freely rotated without needing to fetch more.
;; when facing north, we have e.g.
;; 720 width is 2.8 * 256 pixel tiles
;; 800 height is 3.125 tiles
;;
;; however:
;; - when the map is rotated 90 degrees we instead have
;; 3.125 tiles horizontally and 2.8 vertically
;; - at e.g a 45 degree angle ... something else?
;;
;; the furthest points visible from the centre of the screen are the
;; corners. So, we draw a circle about the centre which goes
;; through those points. To ensure we have enough tiles to fill the
;; screen at any angle, we fetch every tile that's (partly
;; or entirely) inside that circle
(let [radius (/ (math.sqrt (+ (^ viewport-width 2) (^ viewport-height 2)))
tile-size 2)
min-tile-x (math.floor (- tile-x radius))
max-tile-x (math.floor (+ tile-x radius))
min-tile-y (math.floor (- tile-y radius))
max-tile-y (math.floor (+ tile-y radius))
num-tiles-x (+ 1 (- max-tile-x min-tile-x))
num-tiles-y (+ 1 (- max-tile-y min-tile-y))]
{
:min { :x min-tile-x :y min-tile-y }
:max { :x max-tile-x :y max-tile-y }
: num-tiles-x
: num-tiles-y
:pixels {
:x (* tile-size num-tiles-x)
:y (* tile-size num-tiles-y)
}
:centre {
:x (/ (+ min-tile-x max-tile-x 1) 2)
:y (/ (+ min-tile-y max-tile-y 1) 2)
}
}))
;; diagonal radius is 538 pixels, 2.1 tiles
(let [bounds (map-bounds-tile 65539.5 45014.5)]
(expect= bounds.min {:x 65537 :y 45012})
(expect= bounds.max {:x 65541 :y 45016})
(expect= bounds.centre {:x 65539.5 :y 45014.5}))
(let [bounds (map-bounds-tile 65539.0 45014.0)]
(expect= bounds.min {:x 65536 :y 45011})
(expect= bounds.max {:x 65541 :y 45016})
(expect= bounds.centre {:x 65539 :y 45014})
)
(fn map-bounds [lat lon zoom]
(let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)]
(map-bounds-tile tile-x tile-y)))
(fn bounds= [a b]
(and (= a.min.x b.min.x)
(= a.min.y b.min.y)
(= a.max.x b.max.x)
(= a.max.y b.max.y)))
(local cq (cqueues.new))
(fn road-width-for [line]
(case (?. line :tags :highway)
:motorway 18
:trunk 17
:primary 16
:secondary 14
:cycleway 4
:footway 4
other 12))
(fn cairo-road-path [g [[sx sy] & points] bounds]
(let [min bounds.min
{ : line_to } g]
(g:move_to (* tile-size (- sx min.x))
(* tile-size (- sy min.y)))
(each [_ [x y] (ipairs points)]
(let [x1 (* tile-size (- x min.x))
y1 (* tile-size (- y min.y))]
(line_to g x1 y1)))))
(fn cairo-roads [g lines bounds]
(g:set_source_rgb 0 0 0)
(each [_ line (pairs lines)]
(g:set_line_width (road-width-for line))
(cairo-road-path g line.points bounds )
(g:stroke))
(g:set_source_rgb 1 1 1)
(each [_ line (pairs lines)]
(g:set_line_width (- (road-width-for line) 2))
(cairo-road-path g line.points bounds)
(g:stroke)))
(var map-surface nil)
(fn fetch-tiles [bounds tbl zoom]
(for [x bounds.min.x bounds.max.x]
(for [y bounds.min.y bounds.max.y]
(let [k (tiles.name x y zoom)]
(when (not (. tbl k))
(tiles.fetch cq x y zoom #(tset tbl k $1)))))))
(fn draw-onto-map-surface [surface bounds zoom]
(let [{ : num-tiles-x : num-tiles-y } bounds
road-width 14
lines []]
(for [x bounds.min.x bounds.max.x]
(for [y bounds.min.y bounds.max.y]
(merge lines (or (. app-state.tiles (tiles.name x y zoom)) {}))))
(let [seen-road-names {}
g (cairo.Context.create surface)]
(g:set_source_rgb 0.7 0.8 0.8)
(g:rectangle 0 0 bounds.pixels.x bounds.pixels.y)
(g:fill)
(g:translate (+ (// bounds.pixels.x 2)) (+ (// bounds.pixels.y 2)))
(g:rotate (* (/ (- app-state.orientation-target) 180) math.pi))
(g:translate (- (// bounds.pixels.x 2)) (- (// bounds.pixels.y 2)))
(cairo-roads 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 [[tx ty angle] line.label-place
ext (g:text_extents n)
w ext.width
h ext.height]
(when (and tx ty (not (. seen-road-names n)))
(let [x (* tile-size (- tx bounds.min.x))
y (* tile-size (- ty bounds.min.y))]
(tset seen-road-names n true)
(g:save)
(g:move_to x y)
(g:rotate angle)
(g:rel_move_to (- (// w 2)) 3)
(g:text_path n)
(g:fill)
(g:restore))))))
surface)))
(fn on-osm-draw [widget g]
(let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)
bounds (map-bounds-tile tile-x tile-y)
offset-x (/ (- viewport-width bounds.pixels.x) 2)
offset-y (/ (- viewport-height bounds.pixels.y) 2)
x-to-centre (- tile-x bounds.centre.x)
y-to-centre (- tile-y bounds.centre.y)
angle (- (/ (* math.pi app-state.orientation-target) 180))
x-to-centre-rot (- (* x-to-centre (math.cos angle))
(* y-to-centre (math.sin angle)))
y-to-centre-rot (+ (* x-to-centre (math.sin angle))
(* y-to-centre (math.cos angle)))
]
(when (not map-surface)
(let [window (widget:get_window)]
(set map-surface
(doto
(window:create_similar_surface
cairo.Content.COLOR
bounds.pixels.x
bounds.pixels.y)
(draw-onto-map-surface bounds app-state.zoom)))))
(when (not (= app-state.orientation-actual app-state.orientation-target))
(print (- app-state.orientation-actual app-state.orientation-target))
(g:translate (+ (/ viewport-width 2)) (+ (/ viewport-height 2)))
(g:rotate (* (/ (- 360 (- app-state.orientation-actual app-state.orientation-target)) 180) math.pi))
(g:translate (- (/ viewport-width 2)) (- (/ viewport-height 2))))
(g:set_source_surface map-surface
(- offset-x (* tile-size x-to-centre-rot))
(- offset-y (* tile-size y-to-centre-rot)))
(g:set_operator cairo.Operator.SOURCE)
(g:paint)))
(fn register-widget [name widget]
(tset state-widgets name widget)
widget)
(fn osm-widget []
(register-widget
:osm
(Gtk.DrawingArea {
:width viewport-width :height viewport-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 turn-smoothly [from to]
(if (< (math.abs (- from to)) 10) to
(+ from (* 0.05 (- to from)))))
(fn update-app-state [new-vals]
(let [old-state (merge {} app-state)
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 (not (bounds= old-bounds bounds))
(fetch-tiles bounds app-state.tiles app-state.zoom)
(set map-surface nil)))
(when (> (math.abs (- app-state.orientation-target app-state.course)) 20)
(set app-state.orientation-target app-state.course)
; (-> state-widgets.rose (: :get_window) (: :invalidate_rect nil))
(set map-surface nil))
(when (not (= app-state.orientation-target app-state.orientation-actual))
(set app-state.orientation-actual
(turn-smoothly app-state.orientation-actual app-state.orientation-target)))
(each [name widget (pairs state-widgets)]
(case name
:speed (widget:set_label
(string.format "%.1f km/h" (* app-state.speed 3.6)))
:osm
(when (not (and ; false
(= old-state.lat app-state.lat)
(= old-state.lon app-state.lon)
(= old-state.orientation-actual
app-state.orientation-actual)
))
(: (widget:get_window) :invalidate_rect nil))
:arrow (: (widget:get_window) :invalidate_rect nil)
:rose (: (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 (* (/ (- app-state.course app-state.orientation-actual)
180) math.pi))
(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)
}))))
(fn deg->rad [degrees]
(* math.pi (/ degrees 180)))
(fn rose []
(let [height 60]
(register-widget
:rose
(Gtk.Label {
:halign Gtk.Align.START
:valign Gtk.Align.START
:width height :height height
:on_draw
(fn [self g]
(g:save)
(g:set_line_width 1)
(g:set_source_rgb 0.4 0.0 0.1)
(g:arc (// height 2) (// height 2) 15
0 (* 2 math.pi))
(g:stroke)
(g:translate (// height 2) (// height 2))
(g:rotate (- (deg->rad app-state.orientation-actual)))
(g:translate (// height -2) (// height -2))
(g:set_line_width 2)
(g:move_to (// height 2) height)
(g:line_to (// height 2) 0)
(g:move_to 10 20)
(g:line_to (// height 2) 0)
(g:line_to (- height 10) 20)
(g:stroke)
(g:set_source_rgb 1 1 0)
(g:move_to (// height -2) (// height -2))
(g:text_path "N")
(g:fill)
(g:restore)
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
100 ; ms
(fn []
;; run cqueues scheduler
(cq:step 0)
;; for smoother rotation when course changes, repaint more often than
;; once per gnss message
(update-app-state {})
true)
nil nil)
(fn collect-profile []
(GLib.timeout_add
GLib.PRIORITY_DEFAULT
(* 60 1000) main-quit
nil nil)
(print "profiling for 60 seconds")
(profile.start 0))
(window:add
(doto (Gtk.Overlay {})
(: :add (osm-widget))
(: :add_overlay (readouts))
(: :add_overlay (arrow))
(: :add_overlay (rose))
))
(window:show_all)
(styles)
(when (os.getenv "MAP_PROFILE") (collect-profile))
(Gtk:main)
Reference in New Issue View Git Blame Copy Permalink