Merge remote-tracking branch 'origin/noetbook' into tninkpad

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?)
 
 
@@ -81,6 +79,9 @@ elapsed time: what should it actually show? moving time, I guess
 
 should we rename bearing as course in nmea?
 
+perhaps we need a server-side component for route planning
+
+
 7) think about how to use nfc tags or something for profiles so that
 it can recognise when it's attached to bicycle or motorbike
 
@@ -91,9 +92,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.
 
@@ -104,38 +105,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
+d) render ways according to their type (road/cycleway/path/etc)
-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
 
+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
 
 ----
 
-... sod, forgot to push latest changes from noetbook
-
-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

@@ -1,15 +1,18 @@
 ; (local { : view } (require :fennel))
 (local { : fdopen } (require :posix.stdio))
+(local cqueues (require :cqueues))
+
 (local nmea (require :nmea))
+(local tiles (require :tiles))
 
 (import-macros { : define-tests : expect : expect= } :assert)
 
 (local {
         : Gtk
-        : OsmGpsMap
         : Gdk
         : Gio
         : GLib
+        : cairo
         }
        (require :lgi))
 
@@ -30,7 +33,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,36 +49,120 @@ label.readout {
 (local window (Gtk.Window {
                            :title "Map"
                            :name "toplevel"
-                           :default_width 720
+                           :default_width map-width
-                           :default_height 800
+                           :default_height map-height
 
                            :on_destroy Gtk.main_quit
                            }))
 
 (local state-widgets { })
 
-(fn osm-widget []
+(local
-  (let [w
+ app-state {
-        (doto (OsmGpsMap.Map {})
+            :time-of-day 0
-          (tset :map-source  OsmGpsMap.MapSource_t.OPENSTREETMAP)
+            :elapsed-time 0
-          (: :set_center_and_zoom 52.595 -0.1 17)
+            :speed 14
-          (: :layer_add (OsmGpsMap.MapOsd {
+            :lat 49
-                                           :show_copyright true
+            :lon 0
-                                        ; :show_coordinates true
+            :zoom 17
-                                           :show_scale true
+            :course 22
-                                           }))
+            }
-          )]
+ )
-    (tset state-widgets :osm w)
-    w))
 
+(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
+     }))
+
+(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)
+        lines []]
+
+    (for [x bounds.min.x bounds.max.x]
+      (for [y bounds.min.y bounds.max.y]
+        (merge lines (tiles.polylines cq 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 []
+  (register-widget
+   :osm
+   (Gtk.DrawingArea {
+                     :width map-width :height map-height
+                     :on_draw on-osm-draw
+                     })))
 
 (fn readout [name text]
-  (let [w
+  (register-widget
+   name
    (doto (Gtk.Label {:label text : name})
      (-> (: :get_style_context)
-              (: :add_class :readout)))]
+         (: :add_class :readout)))))
-    (tset state-widgets name w)
-    w))
 
 (local knot-in-m-s
        (/ 1852 ; metres in nautical mile
@@ -89,33 +178,28 @@ 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))
-
 
 (fn update-app-state [new-vals]
+  (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:set_center app-state.lat app-state.lon)
+        :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 []
@@ -130,8 +214,10 @@ label.readout {
     (: :add (readout :speed "0"))))
 
 (fn arrow []
-  (let [height 40
+  (let [height 40]
-        w (Gtk.Label {
+    (register-widget
+     :arrow
+     (Gtk.Label {
                  :halign Gtk.Align.CENTER
                  :valign Gtk.Align.CENTER
                  :width height :height height
@@ -147,8 +233,7 @@ label.readout {
                    (g:line_to (- height 10) height)
                    (g:fill)
                    true)
-                       })]
+                 }))))
-    w))
 
 
 (local socket-path (or (. arg 1) "/var/run/gnss-share.sock"))
@@ -189,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))

pkgs/maps/tiles.fnl

@@ -1,38 +1,12 @@
 (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))
 
-
+(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)))))
 
@@ -69,3 +43,93 @@
   (expect= (math.floor x) 65343)
   (expect= (math.floor y) 43221))
 
+
+(fn overpass [lat lon zoom]
+  (let [width (/ 360 (^ 2 zoom))
+        n (+ lat width)                 ;XXX adjust for latitude
+        w (- lon width)
+        s lat
+        e lon]
+    (->
+     [
+      "[out:json];"
+      (f% "way(%f,%f,%f,%f)['highway'];" s w n e)
+      "(._;>;);"
+      "out;"
+      ]
+     (table.concat  "\n"))))
+
+(fn canvas [elements]
+  (let [nodes {}
+        lines {}]
+    (each [_ e (ipairs elements)]
+      (case e.type
+        :node (tset nodes e.id e)
+        :way
+        (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)
+             [ tx ty  ])))))
+    lines))
+
+
+(fn file-exists? [name]
+  (match (io.open name :r)
+    f (do (f:close) true)
+    _ false))
+
+(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)]
+      (if (= (headers:get  ":status") "429")
+          nil
+          (stream:get_body_as_string)))))
+
+;; 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 : latlon->tile }