clobber map-surface when bounds change

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.

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
 
 
 

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 = [

pkgs/maps/main.fnl

@@ -10,6 +10,7 @@
         : Gdk
         : Gio
         : GLib
+        : cairo
         }
        (require :lgi))
 
@@ -30,7 +31,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 +47,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,38 +62,103 @@ 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))
+
+
+
+(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 []
-  (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))
-                })))
+  (register-widget
+   :osm
+   (Gtk.DrawingArea {
+                     :width map-width :height map-height
+                     :on_draw on-osm-draw
+                     })))
 
 (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
@@ -106,21 +174,28 @@ 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]
-  (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:set_center app-state.lat app-state.lon)
-      :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 []
@@ -135,25 +210,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"))

pkgs/maps/tiles.fnl

@@ -43,9 +43,10 @@
   (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))
+        n (+ lat width)                 ;XXX adjust for latitude
+        w (- lon width)
         s lat
         e lon]
     (->
@@ -57,32 +58,60 @@
       ]
      (table.concat  "\n"))))
 
-(fn canvas [elements offset-x offset-y]
+(fn canvas [elements]
   (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)]
              ;;(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 [lat long zoom]
-  (let [r
+
+(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 (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)
-          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))))
 
-{ : polylines }
+(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)))
+
+
+{ :polylines polylines-from-net : latlon->tile }