From acbe27e6e2ade5d677c65d030db9459c4f957011 Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Fri, 30 May 2025 21:24:28 +0100 Subject: [PATCH] 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. --- pkgs/maps/default.nix | 3 +- pkgs/maps/main.fnl | 93 ++++++++++++++++++++++++++++--------------- 2 files changed, 62 insertions(+), 34 deletions(-) diff --git a/pkgs/maps/default.nix b/pkgs/maps/default.nix index cff5f31..2f79f00 100644 --- a/pkgs/maps/default.nix +++ b/pkgs/maps/default.nix @@ -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 = [ diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl index 73f19d4..dc35283 100644 --- a/pkgs/maps/main.fnl +++ b/pkgs/maps/main.fnl @@ -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]