draw map once only and copy it to screen in on_draw

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.
This commit is contained in:
Daniel Barlow 2025-05-30 21:24:28 +01:00
parent 2a86a2bfde
commit acbe27e6e2
2 changed files with 62 additions and 34 deletions

View File

@ -2,6 +2,7 @@
, pkg-config
, buildPackages
, callPackage
, cairo
, clutter
, fetchFromGitHub
, fetchurl
@ -52,8 +53,8 @@ in stdenv.mkDerivation {
buildInputs = [
lua
gtk3.dev
cairo.dev
gobject-introspection
osm-gps-map
glib-networking
];
nativeBuildInputs = [

View File

@ -10,6 +10,7 @@
: Gdk
: Gio
: GLib
: cairo
}
(require :lgi))
@ -70,48 +71,74 @@ label.readout {
(collect [k v (pairs table2) &into table1]
k v))
;; given lat/lon
;; we want the tile containing lat to be roughly centred
;; on the screen, and enough tiles either side of it
;; to fill the width of the screen plus a bit
(var map-surface nil)
(fn cairo-the-map [self g]
(let [{ : lat : lon : zoom } app-state
num-tiles-x (+ 0 (math.ceil (/ map-width tile-size)))
num-tiles-y (+ 0 (math.ceil (/ map-height tile-size)))
(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 (math.ceil (+ 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 (math.ceil (+ tile-y (/ num-tiles-y 2)))
left-edge (- tile-x (/ map-width 2 tile-size))
top-edge (- tile-y (/ map-height 2 tile-size))
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 min-tile-x max-tile-x]
(for [y min-tile-y max-tile-y]
(for [x bounds.min.x bounds.max.x]
(for [y bounds.min.y bounds.max.y]
(merge lines (tiles.polylines x y zoom))))
;; put tile-x and tile-y in the centre of the visible area.
(g:translate (* tile-size (- min-tile-x left-edge))
(* tile-size (- min-tile-y top-edge)))
(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)))
(g:set_source_rgb 0.2 0.2 0.4)
(g:set_line_width 3)
(each [_ line (pairs lines)]
(case line
[[sx sy] & more]
(do
(g:move_to (* tile-size (- sx min-tile-x))
(* tile-size (- sy min-tile-y)))
(each [_ [x y] (ipairs more)]
(let [x1 (* tile-size (- x min-tile-x))
y1 (* tile-size (- y min-tile-y))]
(g:line_to x1 y1))))))
(g:stroke)
true))
(fn register-widget [name widget]
(tset state-widgets name widget)
@ -122,7 +149,7 @@ label.readout {
:osm
(Gtk.DrawingArea {
:width map-width :height map-height
:on_draw cairo-the-map
:on_draw on-osm-draw
})))
(fn readout [name text]