From 398693bc0797747eda967ee93a8fad74eb42b694 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Wed, 28 May 2025 18:50:12 +0100
Subject: [PATCH 01/10] hook the ui up to the overpass data

---
 pkgs/maps/main.fnl  | 57 +++++++++++++++++++----------------
 pkgs/maps/tiles.fnl | 73 ++++++++++++++++++++++++++++-----------------
 2 files changed, 76 insertions(+), 54 deletions(-)

diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
index 316d115..fc2cf33 100644
--- a/pkgs/maps/main.fnl
+++ b/pkgs/maps/main.fnl
@@ -1,12 +1,12 @@
 ; (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
-        : OsmGpsMap
         : Gdk
         : Gio
         : GLib
@@ -52,20 +52,37 @@ label.readout {
 
 (local state-widgets { })
 
-(fn osm-widget []
-  (let [w
-        (doto (OsmGpsMap.Map {})
-          (tset :map-source  OsmGpsMap.MapSource_t.OPENSTREETMAP)
-          (: :set_center_and_zoom 52.595 -0.1 17)
-          (: :layer_add (OsmGpsMap.MapOsd {
-                                           :show_copyright true
-                                        ; :show_coordinates true
-                                           :show_scale true
-                                           }))
-          )]
-    (tset state-widgets :osm w)
-    w))
+(local
+ app-state {
+            :time-of-day 0
+            :elapsed-time 0
+            :speed 14
+            :lat 49
+            :lon 0
+            :course 22
+            }
+ )
 
+(fn osm-widget []
+  (let [height 256]
+    (Gtk.Label {
+                :width height :height height
+                :on_draw
+                (fn [self g]
+                  (print app-state.lat app-state.lon )
+                  (let [lines (tiles.polylines app-state.lat app-state.lon 17)]
+                    (g:set_source_rgb 0.2 0.2 0.4)
+                    (g:set_line_width 3)
+                    (each [_ line (ipairs lines)]
+                      (case line
+                        [[sx sy] & more]
+                        (do
+                          (g:move_to sx sy)
+                          (each [_ [x y] (ipairs more)]
+                            (g:line_to x y)))))
+                    (g:stroke)
+                    true))
+                })))
 
 (fn readout [name text]
   (let [w
@@ -89,18 +106,6 @@ label.readout {
 (expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45")
 
 
-(local
- app-state {
-            :time-of-day 0
-            :elapsed-time 0
-            :speed 14
-            :lat 49
-            :lon 0
-            :course 22
-            }
- )
-
-
 (fn merge [table1 table2]
   (collect [k v (pairs table2) &into table1]
     k v))
diff --git a/pkgs/maps/tiles.fnl b/pkgs/maps/tiles.fnl
index 5325e85..79a444c 100644
--- a/pkgs/maps/tiles.fnl
+++ b/pkgs/maps/tiles.fnl
@@ -5,35 +5,8 @@
 (import-macros { : define-tests : expect : expect= : expect-near } :assert)
 (local { : view } (require :fennel))
 
+(local f% string.format)
 
-(local
- query
- (->
-  [
-   "[bbox:30.618338,-96.323712,30.591028,-96.330826]"
-   "[out:json]"
-   "[timeout:90];"
-   "("
-   "way ("
-   "30.626917110746,"
-   "-96.348809105664,"
-   "30.634468750236,"
-   "-96.339893442898"
-   ");"
-   ");"
-   "out ;"
-   ]
-  (table.concat "\n")))
-
-(let [r 
-       (req.new_from_uri
-        "https://overpass-api.de/api/interpreter")]
-  (tset r.headers ":method" "POST")
-  (r:set_body (dict_to_query { :data query }))
-  (let [(headers stream) (r:go)]
-    (print (view headers))
-    (print (view (json.decode (stream:get_body_as_string))))))
-      
 (fn sinh [x] (/ (- 1 (math.exp (* -2 x))) (* 2 (math.exp (- x)))))
 
 (expect (< (math.abs  (- (sinh 2) 3.626860407847)) 0.001))
@@ -69,3 +42,47 @@
   (expect= (math.floor x) 65343)
   (expect= (math.floor y) 43221))
 
+
+(fn overpass [lat lon]
+  (let [n (+ lat 0.01)
+        w (- lon 0.01)
+        s lat
+        e lon]
+    (->
+     [
+      "[out:json];"
+      (f% "way(%f,%f,%f,%f)['highway'];" s w n e)
+      "(._;>;);"
+      "out;"
+      ]
+     (table.concat  "\n"))))
+
+(fn canvas [elements offset-x offset-y]
+  (let [nodes {}
+        lines []]
+    (each [_ e (ipairs elements)]
+      (case e.type
+        :node (tset nodes e.id e)
+        :way
+        (table.insert
+         lines
+         (icollect [_ nd (ipairs e.nodes)]
+           (let [node (. nodes nd)
+                 (tx ty) (latlon->tile node.lat node.lon 17)]
+             ;;(print e.tags.name e.id e.name node.lat node.lon)
+             [ (* 256 (- tx offset-x)) (* 256  (- ty offset-y)) ])))))
+    lines))
+
+(fn polylines [lat long zoom]
+  (let [r
+        (req.new_from_uri
+         "https://overpass-api.de/api/interpreter")
+        query  { :data (overpass lat long zoom) }]
+    (tset r.headers ":method" "POST")
+    (r:set_body (dict_to_query query))
+    (let [(headers stream) (r:go)
+          (tx ty) (latlon->tile lat long zoom)
+          data (json.decode (stream:get_body_as_string))]
+      (canvas data.elements (math.floor tx) (math.floor ty)))))
+
+{ : polylines }

From 995880e5a32e6b520b9f63ee7ca434f0f61035d9 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Thu, 29 May 2025 12:48:21 +0100
Subject: [PATCH 02/10] wip

---
 README              | 25 ++++++++++++++++---
 pkgs/maps/main.fnl  | 61 +++++++++++++++++++++++++++++++--------------
 pkgs/maps/tiles.fnl | 26 +++++++++++--------
 3 files changed, 80 insertions(+), 32 deletions(-)

diff --git a/README b/README
index 70bdb5a..dec6e66 100644
--- a/README
+++ b/README
@@ -127,9 +127,28 @@ the benefit of the caching. If we're going to do that, should it also
 do transformation e.g. from lat/long to x/y co-ordinates? We don't
 need this bit yet though
 
-3) alternatively we could use mapbox vector tiles, but tbh I'm
-struggling to see now that helps. we don't have to transform from
-lat/long but instead we have to parse a protobuf, how is that simpler?
+
+https://git.syndicate-lang.org/tonyg/squeak-phone/raw/commit/474960ddc665ed445a1f5afb0164fe39057720f9/devices/pine64-pinephone/modem-docs/80545ST10798A_LM940_QMI_Command_Reference_Guide_r3.pdf
+
+----
+
+
+we need to extend to multiple tiles'-worth of map
+
+
+* get tile for curent lat/long and request overpass data for enough
+  surrounding tiles to fill the screen
+
+* I think a way is served with all its nodes whether or not they're in
+the bbox, so we can just store the ids of ways we've seen and skip
+them if the come up again
+
+* render all the polylines into the widget (some day also the labels etc)
+
+* to get it centred on the cyclist, take the tile fractional part *
+  256, and translate the canvas up and left by that amount
+
+* add a cache of [x,y,z] -> polylines so that we don't keep hitting overpass
 
 
 
diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
index fc2cf33..3590cf1 100644
--- a/pkgs/maps/main.fnl
+++ b/pkgs/maps/main.fnl
@@ -30,7 +30,9 @@ label.readout {
          (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)]
@@ -44,8 +46,8 @@ label.readout {
 (local window (Gtk.Window {
                            :title "Map"
                            :name "toplevel"
-                           :default_width 720
-                           :default_height 800
+                           :default_width map-width
+                           :default_height map-height
 
                            :on_destroy Gtk.main_quit
                            }))
@@ -59,29 +61,52 @@ label.readout {
             :speed 14
             :lat 49
             :lon 0
+            :zoom 17
             :course 22
             }
  )
 
+(fn merge [table1 table2]
+  (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
+
 (fn osm-widget []
-  (let [height 256]
+  (let [height tile-size
+        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)))
+        min-tile-y (math.floor (- tile-y (/ num-tiles-y 2)))
+        max-tile-y (math.ceil  (+ tile-y (/ num-tiles-y 2)))
+        lines []]
+
+    (for [x min-tile-x max-tile-x]
+      (for [y min-tile-y max-tile-y]
+        (print :x x :y y)
+        (merge lines (tiles.polylines x y app-state.zoom))))
+
     (Gtk.Label {
                 :width height :height height
                 :on_draw
                 (fn [self g]
                   (print app-state.lat app-state.lon )
-                  (let [lines (tiles.polylines app-state.lat app-state.lon 17)]
-                    (g:set_source_rgb 0.2 0.2 0.4)
-                    (g:set_line_width 3)
-                    (each [_ line (ipairs lines)]
-                      (case line
-                        [[sx sy] & more]
-                        (do
-                          (g:move_to sx sy)
-                          (each [_ [x y] (ipairs more)]
-                            (g:line_to x y)))))
-                    (g:stroke)
-                    true))
+                  (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 sx sy)
+                        (each [_ [x y] (ipairs more)]
+                          (g:line_to x y)))))
+                  (g:stroke)
+                  true)
                 })))
 
 (fn readout [name text]
@@ -106,9 +131,7 @@ label.readout {
 (expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45")
 
 
-(fn merge [table1 table2]
-  (collect [k v (pairs table2) &into table1]
-    k v))
+
 
 
 (fn update-app-state [new-vals]
diff --git a/pkgs/maps/tiles.fnl b/pkgs/maps/tiles.fnl
index 79a444c..b9c853e 100644
--- a/pkgs/maps/tiles.fnl
+++ b/pkgs/maps/tiles.fnl
@@ -43,9 +43,11 @@
   (expect= (math.floor y) 43221))
 
 
-(fn overpass [lat lon]
-  (let [n (+ lat 0.01)
-        w (- lon 0.01)
+(fn overpass [lat lon zoom]
+  (let [width (/ 360 (^ 2 zoom))
+        _ (print :w zoom width)
+        n (+ lat width)                 ;XXX adjust for latitude
+        w (- lon width)
         s lat
         e lon]
     (->
@@ -59,13 +61,14 @@
 
 (fn canvas [elements offset-x offset-y]
   (let [nodes {}
-        lines []]
+        lines {}]
     (each [_ e (ipairs elements)]
       (case e.type
         :node (tset nodes e.id e)
         :way
-        (table.insert
+        (tset
          lines
+         e.id
          (icollect [_ nd (ipairs e.nodes)]
            (let [node (. nodes nd)
                  (tx ty) (latlon->tile node.lat node.lon 17)]
@@ -73,16 +76,19 @@
              [ (* 256 (- tx offset-x)) (* 256  (- ty offset-y)) ])))))
     lines))
 
-(fn polylines [lat long zoom]
-  (let [r
+(fn polylines [x y zoom]
+  (let [(lat lon) (tile->latlon x y zoom)
+        o  (overpass lat lon zoom)
+        _ (print :polylines x y  o)
+        r
         (req.new_from_uri
          "https://overpass-api.de/api/interpreter")
-        query  { :data (overpass lat long zoom) }]
+        query  { :data o }]
     (tset r.headers ":method" "POST")
     (r:set_body (dict_to_query query))
     (let [(headers stream) (r:go)
-          (tx ty) (latlon->tile lat long zoom)
+          (tx ty) (latlon->tile lat lon zoom)
           data (json.decode (stream:get_body_as_string))]
       (canvas data.elements (math.floor tx) (math.floor ty)))))
 
-{ : polylines }
+{ : polylines : latlon->tile }

From 86682a2ad6e29a4e53f568fbdc7ad475a49cfb79 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Thu, 29 May 2025 18:13:47 +0100
Subject: [PATCH 03/10] fetch enough tiles to cover the display

---
 pkgs/maps/main.fnl  | 58 +++++++++++++++++++++++++++------------------
 pkgs/maps/tiles.fnl | 18 ++++++++++----
 2 files changed, 49 insertions(+), 27 deletions(-)

diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
index 3590cf1..72f7559 100644
--- a/pkgs/maps/main.fnl
+++ b/pkgs/maps/main.fnl
@@ -75,39 +75,51 @@ label.readout {
 ;; on the screen, and enough tiles either side of it
 ;; to fill the width of the screen plus a bit
 
-(fn osm-widget []
-  (let [height tile-size
-        num-tiles-x (+ 1 (math.ceil (/ map-width tile-size)))
-        num-tiles-y (+ 1 (math.ceil (/ map-height tile-size)))
+(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)))
+        ; _ (print app-state.lat app-state.lon)
         (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)))
         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))
+
         lines []]
 
     (for [x min-tile-x max-tile-x]
       (for [y min-tile-y max-tile-y]
-        (print :x x :y y)
-        (merge lines (tiles.polylines x y app-state.zoom))))
+        (merge lines (tiles.polylines x y zoom))))
 
-    (Gtk.Label {
-                :width height :height height
-                :on_draw
-                (fn [self g]
-                  (print app-state.lat app-state.lon )
-                  (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 sx sy)
-                        (each [_ [x y] (ipairs more)]
-                          (g:line_to x y)))))
-                  (g:stroke)
-                  true)
-                })))
+    ;; 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)))
+
+    (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 osm-widget []
+  (Gtk.Label {
+              :width map-width :height map-height
+              :on_draw  cairo-the-map
+              }))
 
 (fn readout [name text]
   (let [w
diff --git a/pkgs/maps/tiles.fnl b/pkgs/maps/tiles.fnl
index b9c853e..3ff47e9 100644
--- a/pkgs/maps/tiles.fnl
+++ b/pkgs/maps/tiles.fnl
@@ -45,7 +45,6 @@
 
 (fn overpass [lat lon zoom]
   (let [width (/ 360 (^ 2 zoom))
-        _ (print :w zoom width)
         n (+ lat width)                 ;XXX adjust for latitude
         w (- lon width)
         s lat
@@ -73,13 +72,12 @@
            (let [node (. nodes nd)
                  (tx ty) (latlon->tile node.lat node.lon 17)]
              ;;(print e.tags.name e.id e.name node.lat node.lon)
-             [ (* 256 (- tx offset-x)) (* 256  (- ty offset-y)) ])))))
+             [ tx ty  ])))))
     lines))
 
-(fn polylines [x y zoom]
+(fn polylines-from-net [x y zoom]
   (let [(lat lon) (tile->latlon x y zoom)
         o  (overpass lat lon zoom)
-        _ (print :polylines x y  o)
         r
         (req.new_from_uri
          "https://overpass-api.de/api/interpreter")
@@ -91,4 +89,16 @@
           data (json.decode (stream:get_body_as_string))]
       (canvas data.elements (math.floor tx) (math.floor ty)))))
 
+(local cache {})
+
+(fn polylines [x y zoom]
+  (let [k (..  x "/" y "/" zoom)
+        lines (. cache k)]
+    (print k (not (not lines)))
+    (if lines
+        (do (print "cached! " x y zoom) lines)
+        (let [lines (polylines-from-net x y zoom)]
+          (tset cache k lines)
+          lines))))
+
 { : polylines : latlon->tile }

From 6e6111336623ac582af5ce5b324f66a1b401a297 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Thu, 29 May 2025 18:43:48 +0100
Subject: [PATCH 04/10] replace in-memory cache with a persistent json cache

we just store the raw response from overpass
---
 pkgs/maps/tiles.fnl | 51 ++++++++++++++++++++++++++++-----------------
 1 file changed, 32 insertions(+), 19 deletions(-)

diff --git a/pkgs/maps/tiles.fnl b/pkgs/maps/tiles.fnl
index 3ff47e9..f6351c1 100644
--- a/pkgs/maps/tiles.fnl
+++ b/pkgs/maps/tiles.fnl
@@ -58,7 +58,7 @@
       ]
      (table.concat  "\n"))))
 
-(fn canvas [elements offset-x offset-y]
+(fn canvas [elements]
   (let [nodes {}
         lines {}]
     (each [_ e (ipairs elements)]
@@ -75,30 +75,43 @@
              [ tx ty  ])))))
     lines))
 
-(fn polylines-from-net [x y zoom]
-  (let [(lat lon) (tile->latlon x y zoom)
-        o  (overpass lat lon zoom)
+
+(fn file-exists? [name]
+  (match (io.open name :r)
+    f (do (f:close) true)
+    _ false))
+
+(fn unparsed-from-disk [x y zoom fetch-fn]
+  (let [k (..  x "_" y "_" zoom)
+        pathname (.. "/tmp/tiles/" k ".json")]
+    (if (file-exists? pathname)
+        (with-open [i (io.open pathname :r)]
+          (i:read "*a"))
+        (with-open [j (io.open pathname :w)]
+          (let [g (fetch-fn)]
+            (j:write g)
+            g)))))
+
+(fn unparsed-for-xyz [x y zoom]
+    (let [(lat lon) (tile->latlon x y zoom)
+        o (overpass lat lon zoom)
         r
         (req.new_from_uri
          "https://overpass-api.de/api/interpreter")
         query  { :data o }]
     (tset r.headers ":method" "POST")
     (r:set_body (dict_to_query query))
-    (let [(headers stream) (r:go)
-          (tx ty) (latlon->tile lat lon zoom)
-          data (json.decode (stream:get_body_as_string))]
-      (canvas data.elements (math.floor tx) (math.floor ty)))))
+    (let [(headers stream) (r:go)]
+      (stream:get_body_as_string))))
 
-(local cache {})
+(fn polylines-from-net [x y zoom]
+  (let [s (unparsed-from-disk
+           x y zoom
+           (fn []
+             (unparsed-for-xyz x y zoom)))
+        ;_ (print :unoparsed (s:sub 1 40))
+        data (json.decode s)]
+    (canvas data.elements)))
 
-(fn polylines [x y zoom]
-  (let [k (..  x "/" y "/" zoom)
-        lines (. cache k)]
-    (print k (not (not lines)))
-    (if lines
-        (do (print "cached! " x y zoom) lines)
-        (let [lines (polylines-from-net x y zoom)]
-          (tset cache k lines)
-          lines))))
 
-{ : polylines : latlon->tile }
+{ :polylines polylines-from-net : latlon->tile }

From cb0314d1d6bd3bf5c4d5f5068e22667e9714b030 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Thu, 29 May 2025 21:03:02 +0100
Subject: [PATCH 05/10] invalidate the map display each time we repaint it

really we should only need to do this when the app-state changes
---
 pkgs/maps/main.fnl | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
index 72f7559..dadd191 100644
--- a/pkgs/maps/main.fnl
+++ b/pkgs/maps/main.fnl
@@ -76,6 +76,7 @@ label.readout {
 ;; to fill the width of the screen plus a bit
 
 (fn cairo-the-map [self g]
+  (: (self:get_window) :invalidate_rect nil)
   (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)))
@@ -116,7 +117,7 @@ label.readout {
 
 
 (fn osm-widget []
-  (Gtk.Label {
+  (Gtk.DrawingArea {
               :width map-width :height map-height
               :on_draw  cairo-the-map
               }))

From f64bfeb7fd5171755df1f5f052936f7ef1603185 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Thu, 29 May 2025 21:09:24 +0100
Subject: [PATCH 06/10] invalidate map only when app-state changes

---
 pkgs/maps/main.fnl | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
index dadd191..e349eab 100644
--- a/pkgs/maps/main.fnl
+++ b/pkgs/maps/main.fnl
@@ -76,11 +76,9 @@ label.readout {
 ;; to fill the width of the screen plus a bit
 
 (fn cairo-the-map [self g]
-  (: (self:get_window) :invalidate_rect nil)
   (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)))
-        ; _ (print app-state.lat app-state.lon)
         (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)))
@@ -115,12 +113,17 @@ label.readout {
     (g:stroke)
     true))
 
+(fn register-widget [name widget]
+  (tset state-widgets name widget)
+  widget)
 
 (fn osm-widget []
-  (Gtk.DrawingArea {
-              :width map-width :height map-height
-              :on_draw  cairo-the-map
-              }))
+  (register-widget
+   :osm
+   (Gtk.DrawingArea {
+                     :width map-width :height map-height
+                     :on_draw  cairo-the-map
+                     })))
 
 (fn readout [name text]
   (let [w
@@ -153,7 +156,7 @@ label.readout {
     (case name
       :speed (widget:set_label
               (string.format "%.1f km/h" (* app-state.speed 3.6)))
-      :osm (widget:set_center app-state.lat app-state.lon)
+      :osm (: (widget:get_window) :invalidate_rect nil)
       :time (widget:set_label
              (hhmmss (+ utc-offset app-state.time-of-day)))
       )))

From 2a86a2bfde28e5a979897582755d875c4a656bcb Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Thu, 29 May 2025 21:13:19 +0100
Subject: [PATCH 07/10] use register-widget more, fewer arrow widget repaints

---
 pkgs/maps/main.fnl | 51 +++++++++++++++++++++++-----------------------
 1 file changed, 26 insertions(+), 25 deletions(-)

diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
index e349eab..73f19d4 100644
--- a/pkgs/maps/main.fnl
+++ b/pkgs/maps/main.fnl
@@ -126,12 +126,11 @@ label.readout {
                      })))
 
 (fn readout [name text]
-  (let [w
-        (doto (Gtk.Label {:label text : name})
-          (-> (: :get_style_context)
-              (: :add_class :readout)))]
-    (tset state-widgets name w)
-    w))
+  (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
@@ -157,6 +156,7 @@ label.readout {
       :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)))
       )))
@@ -174,25 +174,26 @@ label.readout {
     (: :add (readout :speed "0"))))
 
 (fn arrow []
-  (let [height 40
-        w (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)
-                       })]
-    w))
+  (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"))

From acbe27e6e2ade5d677c65d030db9459c4f957011 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Fri, 30 May 2025 21:24:28 +0100
Subject: [PATCH 08/10] 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]

From 195e028e2203017ab5d21db30800285344f781af Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Fri, 30 May 2025 23:34:17 +0100
Subject: [PATCH 09/10] clobber map-surface when bounds change

---
 pkgs/maps/main.fnl | 31 ++++++++++++++++++++-----------
 1 file changed, 20 insertions(+), 11 deletions(-)

diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
index dc35283..2c6f418 100644
--- a/pkgs/maps/main.fnl
+++ b/pkgs/maps/main.fnl
@@ -71,7 +71,7 @@ label.readout {
   (collect [k v (pairs table2) &into table1]
     k v))
 
-(var map-surface nil)
+
 
 (fn map-bounds [lat lon zoom]
   (let [num-tiles-x (+ 1 (math.ceil (/ map-width tile-size)))
@@ -122,6 +122,7 @@ label.readout {
       (g:stroke)
       map-surface)))
 
+(var map-surface nil)
 
 (fn on-osm-draw [widget g]
   (when (not map-surface)
@@ -177,16 +178,24 @@ label.readout {
 
 
 (fn update-app-state [new-vals]
-  (merge app-state new-vals)
-  (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)))
-      )))
+  (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 []

From 8ee10214c8c77ac176c4856aa4b2ce60f1f0fdd1 Mon Sep 17 00:00:00 2001
From: Daniel Barlow <dan@telent.net>
Date: Sun, 1 Jun 2025 20:50:26 +0100
Subject: [PATCH 10/10] async tile fetcher

we use cqueues, which is the async framework that lua-http is built
on. we integrate it into the glib event loop rather hackily by calling
the cqueues event stepper ever 20ms from a glib timeout function

overpass has very low rate limits so we handle a 429 response by
sleeping for a random length of time and retrying. This is, also,
a bit of a hack
---
 README              | 65 +++++++++++++++++++++++----------------------
 pkgs/maps/main.fnl  | 14 +++++++++-
 pkgs/maps/tiles.fnl | 62 +++++++++++++++++++++++++++---------------
 3 files changed, 86 insertions(+), 55 deletions(-)

diff --git a/README b/README
index dec6e66..44c54b4 100644
--- a/README
+++ b/README
@@ -19,8 +19,6 @@ write the app in fennel. I want it to
 - show where I am on a map
 - record trail of where I've been (note: indoor counts too)
 
-
-
 can we somehow do non-flakey bluetooth (is it dbus?)
 
 
@@ -88,11 +86,6 @@ elapsed time: what should it actually show? moving time, I guess
 
 should we rename bearing as course in nmea?
 
-rotating the map is going to be complicated because the widget we're
-using doesn't support it (bitmapped map tiles)
-
-
-
 perhaps we need a server-side component for route planning
 
 
@@ -106,9 +99,9 @@ we can't rotate the map using OsmGpsMap widget because the labels will
 be sideways or upside down, so we need something with vectors that we
 can rotate
 
-a) we can get data from overpass api as json
+[done] a) we can get data from overpass api as json
 
-b) we would like to cache the results, which means some kind of
+[done badly] b) we would like to cache the results, which means some kind of
 chunking or tiling so that the json for position a is the same as the
 json for position b.
 
@@ -119,37 +112,45 @@ do it by hand -
 - minor roads
 - major roads
 
-or so something smart but complicated like "only return ways that
+or do something smart but complicated like "only return ways that
 cover more than 1/16th the length of the tile"
 
-d) I think we will need some kind of server so that multiple users get
-the benefit of the caching. If we're going to do that, should it also
-do transformation e.g. from lat/long to x/y co-ordinates? We don't
-need this bit yet though
+d) render ways according to their type (road/cycleway/path/etc)
 
+e) label the ways
+
+f) async tile fetching
+
+we don't want everything to stop when it's time to fetch a new
+row of tiles, what are our options? lua-http is built on cqueues
+which is async enough to make my head hurt, but we also need
+to make it coexist with the gtk event loop
+
+assumptions:
+1) gtk stuff has to happen in the main thread (whatever that is...)
+so we can't control it from cqueues because that has its own
+threading stuff
+2) there will be lots of fds from lua-http, do we really want the
+housekeeping of making GLib.io_add_watch for each of them? it looks
+like adding a glib source from lgi is not currently practical
+https://github.com/lgi-devs/lgi/issues/111
+
+3) if we put http calls inside cq:wrap, that make them background
+provided that we call (cq:step 0)
+periodically. we could do that in a glib idle function, perhaps.
+
+- The tile fetcher would need to know where to write the data when
+  eventually it comes back
+- need some say to not fetch the same tile 18 times if there's more than
+  one request for it while a previous request is in progress
+
+
+---- 
 
 https://git.syndicate-lang.org/tonyg/squeak-phone/raw/commit/474960ddc665ed445a1f5afb0164fe39057720f9/devices/pine64-pinephone/modem-docs/80545ST10798A_LM940_QMI_Command_Reference_Guide_r3.pdf
 
 ----
 
 
-we need to extend to multiple tiles'-worth of map
-
-
-* get tile for curent lat/long and request overpass data for enough
-  surrounding tiles to fill the screen
-
-* I think a way is served with all its nodes whether or not they're in
-the bbox, so we can just store the ids of ways we've seen and skip
-them if the come up again
-
-* render all the polylines into the widget (some day also the labels etc)
-
-* to get it centred on the cyclist, take the tile fractional part *
-  256, and translate the canvas up and left by that amount
-
-* add a cache of [x,y,z] -> polylines so that we don't keep hitting overpass
-
-
 
 
diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
index 2c6f418..73db50c 100644
--- a/pkgs/maps/main.fnl
+++ b/pkgs/maps/main.fnl
@@ -1,5 +1,7 @@
 ; (local { : view } (require :fennel))
 (local { : fdopen } (require :posix.stdio))
+(local cqueues (require :cqueues))
+
 (local nmea (require :nmea))
 (local tiles (require :tiles))
 
@@ -87,6 +89,8 @@ label.readout {
      : num-tiles-x : num-tiles-y
      }))
 
+(local cq (cqueues.new))
+
 (fn cairo-the-map [window]
   (let [{ : lat : lon : zoom } app-state
         { : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom)
@@ -94,7 +98,7 @@ label.readout {
 
     (for [x bounds.min.x bounds.max.x]
       (for [y bounds.min.y bounds.max.y]
-        (merge lines (tiles.polylines x y zoom))))
+        (merge lines (tiles.polylines cq x y zoom))))
 
     (let [map-surface
           (window:create_similar_surface
@@ -270,6 +274,14 @@ label.readout {
   (GLib.io_add_watch channel 0 events #(read-gnss handle)))
 
 
+(GLib.timeout_add
+ GLib.PRIORITY_DEFAULT
+ 20 ; ms
+ (fn []
+   (cq:step 0)
+   true)
+ nil nil)
+
 (window:add
  (doto (Gtk.Overlay {})
    (: :add (osm-widget))
diff --git a/pkgs/maps/tiles.fnl b/pkgs/maps/tiles.fnl
index f6351c1..7a4f306 100644
--- a/pkgs/maps/tiles.fnl
+++ b/pkgs/maps/tiles.fnl
@@ -1,6 +1,7 @@
 (local req (require :http.request))
 (local { : dict_to_query } (require :http.util))
 (local json (require :json))
+(local cqueues (require :cqueues))
 
 (import-macros { : define-tests : expect : expect= : expect-near } :assert)
 (local { : view } (require :fennel))
@@ -81,19 +82,8 @@
     f (do (f:close) true)
     _ false))
 
-(fn unparsed-from-disk [x y zoom fetch-fn]
-  (let [k (..  x "_" y "_" zoom)
-        pathname (.. "/tmp/tiles/" k ".json")]
-    (if (file-exists? pathname)
-        (with-open [i (io.open pathname :r)]
-          (i:read "*a"))
-        (with-open [j (io.open pathname :w)]
-          (let [g (fetch-fn)]
-            (j:write g)
-            g)))))
-
 (fn unparsed-for-xyz [x y zoom]
-    (let [(lat lon) (tile->latlon x y zoom)
+  (let [(lat lon) (tile->latlon x y zoom)
         o (overpass lat lon zoom)
         r
         (req.new_from_uri
@@ -102,16 +92,44 @@
     (tset r.headers ":method" "POST")
     (r:set_body (dict_to_query query))
     (let [(headers stream) (r:go)]
-      (stream:get_body_as_string))))
+      (if (= (headers:get  ":status") "429")
+          nil
+          (stream:get_body_as_string)))))
 
-(fn polylines-from-net [x y zoom]
-  (let [s (unparsed-from-disk
-           x y zoom
-           (fn []
-             (unparsed-for-xyz x y zoom)))
-        ;_ (print :unoparsed (s:sub 1 40))
-        data (json.decode s)]
-    (canvas data.elements)))
+;; if we have json in disk, return it
+;; if we have an empty file on disk, that signifies a request in
+;;   flight, so return a "pending" sentinel
+;; if we have no disk file, kick off a request and send "pending" sentinel
+
+;; we'd like to have a way for completed background fetch to signal
+;; so that the map can be redrawn
+
+(fn polylines [cq x y zoom]
+  (let [k (..  x "_" y "_" zoom)
+        pathname (.. "/tmp/tiles/" k ".json")]
+    (if (file-exists? pathname)
+        (let [data (with-open [i (io.open pathname :r)] (i:read "*a"))]
+          (if (= data "")
+              []
+              (canvas (. (json.decode data) :elements))))
+        (let [out (io.open pathname :w)]
+          (cq:wrap (fn []
+                     (print "getting " k)
+                     (var json nil)
+                     (with-open [f out]
+                       (while (not json)
+                         (set json (unparsed-for-xyz x y zoom))
+                         (when (not json)
+                           (print "sleeping " k)
+                           (cqueues.sleep (math.random 2 6))))
+                       (print "got " k)
+                       (f:write json)
+                       true)))
+          [] ; return no lines for now
+          ))))
 
 
-{ :polylines polylines-from-net : latlon->tile }
+
+
+
+{ : polylines : latlon->tile }