widen map obunds so that rotation works

...without showing missing white bits in the corners when moving
diagonally

pkgs/maps/default.nix

@@ -84,4 +84,9 @@ in stdenv.mkDerivation {
       icon = "nix-snowflake"; # "${placeholder "out"}/share/icons/${pname}.svg";
     })
   ];
+
+  passthru = {
+    inherit lua luaPackages;
+  };
+
 }

pkgs/maps/main.fnl

@@ -33,8 +33,8 @@ label.readout {
          (os.difftime (os.time localt) (os.time utct))))
 
 
-(local map-width 720)
-(local map-height 800)
+(local viewport-width 720)
+(local viewport-height 800)
 (local tile-size 256)
 
 (fn styles []
@@ -49,8 +49,8 @@ label.readout {
 (local window (Gtk.Window {
                            :title "Map"
                            :name "toplevel"
-                           :default_width map-width
-                           :default_height map-height
+                           :default_width viewport-width
+                           :default_height viewport-height
 
                            :on_destroy Gtk.main_quit
                            }))
@@ -65,7 +65,8 @@ label.readout {
             :lat 49
             :lon 0
             :zoom 17
-            :course 22
+            :course 0
+            :smooth-course 0
             }
  )
 
@@ -75,36 +76,95 @@ label.readout {
 
 
 
-(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)]
+(fn map-bounds-tile [tile-x tile-y]
+  ;; we fetch enough tiles around the current location that the screen
+  ;; can be freely rotated without needing to fetch more.
+
+  ;; when facing north, we have e.g.
+  ;; 720 width is 2.8 * 256 pixel tiles
+  ;; 800 height is 3.125 tiles
+  ;;
+  ;; however:
+  ;; - when the map is rotated 90 degrees we instead have
+  ;;   3.125 tiles horizontally and 2.8 vertically
+  ;; - at e.g a 45 degree angle ... something else?
+  ;;
+  ;; the furthest points visible from the centre of the screen are the
+  ;; corners.  So, we draw a circle about the centre which goes
+  ;; through those points.  To ensure we have enough tiles to fill the
+  ;; screen at any angle, we fetch every tile that's (partly
+  ;; or entirely) inside that circle
+
+  (let [radius (/ (math.sqrt (+ (^ viewport-width 2) (^ viewport-height 2)))
+                  tile-size 2)
+        min-tile-x (math.floor (- tile-x radius))
+        max-tile-x (math.floor (+ tile-x radius))
+        min-tile-y (math.floor (- tile-y radius))
+        max-tile-y (math.floor (+ tile-y radius))
+        num-tiles-x (+ 1 (- max-tile-x min-tile-x))
+        num-tiles-y (+ 1 (- max-tile-y min-tile-y))]
     {
      :min { :x min-tile-x :y min-tile-y }
      :max { :x max-tile-x :y max-tile-y }
-     : num-tiles-x : num-tiles-y
+     : num-tiles-x
+     : num-tiles-y
+     :pixels {
+              :x (* tile-size num-tiles-x)
+              :y (* tile-size num-tiles-y)
+              }
      }))
 
+;; diagonal radius is 538 pixels, 2.1 tiles
+
+(let [bounds (map-bounds-tile 65539.5 45014.5)]
+  (expect= bounds.min {:x 65537 :y 45012})
+  (expect= bounds.max {:x 65541 :y 45016}))
+
+(let [bounds (map-bounds-tile 65539.0 45014.0)]
+  (expect= bounds.min {:x 65536 :y 45011})
+  (expect= bounds.max {:x 65541 :y 45016})
+  )
+
+(fn map-bounds [lat lon zoom]
+  (let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)]
+    (map-bounds-tile tile-x tile-y)))
+
+
+
 (local cq (cqueues.new))
 
-(fn cairo-roads-path [g lines bounds]
-  (each [_ line (pairs lines)]
-    (case line.points
-      [[sx sy] & more]
-      (do
-        (g:save)
-        (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)
-        (g:restore)))))
+(fn road-width-for [line offset]
+  (+ (or offset 0)
+     (case (?. line :tags :highway)
+       :motorway 18
+       :trunk 17
+       :primary 16
+       :secondary 14
+       :cycleway 4
+       :footway 4
+       other (do (print "highway " other) 12))))
+
+(fn cairo-road-path [g [[sx sy] & points] bounds width]
+  (g:save)
+  (g:set_line_width width)
+  (g:move_to (* tile-size (- sx bounds.min.x))
+             (* tile-size (- sy bounds.min.y)))
+  (each [_ [x y] (ipairs points)]
+    (let [x1 (* tile-size (- x bounds.min.x))
+          y1 (* tile-size (- y bounds.min.y))]
+      (g:line_to x1 y1)))
+  (g:stroke)
+  (g:restore))
+
+
+(fn cairo-roads [g lines bounds]
+  (let [road-width 14]
+    (g:set_source_rgb 0 0 0)
+    (each [_ line (pairs lines)]
+      (cairo-road-path g line.points bounds (road-width-for line)))
+    (g:set_source_rgb 1 1 1)
+    (each [_ line (pairs lines)]
+      (cairo-road-path g line.points bounds (road-width-for line -2)))))
 
 (fn label-coords [{ : points } bounds]
   (var biggest 0)
@@ -122,40 +182,37 @@ label.readout {
   (let [[x y] (. points biggest-n)
         [nx ny] (. points (+ 1 biggest-n))
         angle (math.atan (- ny y) (- nx x))]
-    (values
-     (* tile-size (- x bounds.min.x))
-     (* tile-size (- y bounds.min.y))
-     angle)))
+    (if (> nx x)
+        (values
+         (* tile-size (- x bounds.min.x))
+         (* tile-size (- y bounds.min.y))
+         angle)
+        (values ; if way runs r->l, prefer label to read l->r
+         (* tile-size (- nx bounds.min.x))
+         (* tile-size (- ny bounds.min.y))
+         (+ math.pi angle)))))
 
+(var map-surface nil)
 
-(fn cairo-the-map [window]
-  (let [{ : lat : lon : zoom } app-state
-        { : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom)
+(fn draw-onto-map-surface [surface bounds zoom]
+  (let [{ : num-tiles-x : num-tiles-y } bounds
         road-width 14
         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))))
+        (merge lines (tiles.polylines cq x y zoom
+                                      #(set map-surface nil)
+                                      ))))
 
-    (let [map-surface
-          (window:create_similar_surface
-           cairo.Content.COLOR
-           (* tile-size (+ 4 num-tiles-x))
-           (* tile-size (+ 4 num-tiles-y)))
-          seen-road-names {}
-          g (cairo.Context.create map-surface)]
+    (let [seen-road-names {}
+          g (cairo.Context.create surface)]
 
       (g:set_source_rgb 0.7 0.8 0.8)
-      (g:rectangle 0 0 (* tile-size num-tiles-x) (* tile-size num-tiles-y))
+      (g:rectangle 0 0 bounds.pixels.x bounds.pixels.y)
       (g:fill)
 
-      (g:set_source_rgb 0 0 0)
-      (g:set_line_width road-width)
-      (cairo-roads-path g lines bounds)
-      (g:set_source_rgb 1 1 1)
-      (g:set_line_width (- road-width 2))
-      (cairo-roads-path g lines bounds)
+      (cairo-roads g lines bounds)
 
       (g:set_source_rgb 0.2 0.2 0.2)
       (g:set_font_size (+ road-width 1))
@@ -169,7 +226,7 @@ label.readout {
                 (tset seen-road-names n true)
                 (g:save)
                 (g:set_line_width h)
-                (g:set_source_rgb 1 1 1)
+                (g:set_source_rgba 1 0.95 1 0.7)
                 (g:move_to (- x 1) (- y 1))
                 (g:rotate angle)
                 (g:rel_line_to (+ w 1) 0)
@@ -184,24 +241,32 @@ label.readout {
                 (g:fill)
                 (g:restore)))))
 
-      map-surface)))
+      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))]
+        bounds (map-bounds-tile tile-x tile-y)
+        offset-x (- (* tile-size (- tile-x bounds.min.x)) (/ viewport-width 2))
+        offset-y (- (* tile-size (- tile-y bounds.min.y)) (/ viewport-height 2))]
+
+    (when (not map-surface)
+      (let [window (widget:get_window)]
+        (set map-surface
+             (doto
+                 (window:create_similar_surface
+                  cairo.Content.COLOR
+                  bounds.pixels.x
+                  bounds.pixels.y)
+               (draw-onto-map-surface bounds app-state.zoom)))))
+
+    (g:translate (+ (/ viewport-width 2))  (+ (/ viewport-height 2)))
+    (g:rotate (* (/ (- 360 app-state.smooth-course) 180) math.pi))
+    (g:translate (- (/ viewport-width 2))  (- (/ viewport-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:paint)))
 
 
 
@@ -213,7 +278,7 @@ label.readout {
   (register-widget
    :osm
    (Gtk.DrawingArea {
-                     :width map-width :height map-height
+                     :width viewport-width :height viewport-height
                      :on_draw on-osm-draw
                      })))
 
@@ -238,9 +303,6 @@ label.readout {
 (expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45")
 
 
-
-
-
 (fn update-app-state [new-vals]
   (let [old-bounds
         (map-bounds app-state.lat app-state.lon app-state.zoom)]
@@ -251,6 +313,9 @@ label.readout {
              (not (= old-bounds.min.x bounds.min.x))
              (not (= old-bounds.min.y bounds.min.y)))
         (set map-surface nil)))
+    (set app-state.smooth-course
+         (+ app-state.smooth-course
+            (* 0.05 (- app-state.course app-state.smooth-course))))
     (each [name widget (pairs state-widgets)]
       (case name
         :speed (widget:set_label
@@ -285,7 +350,8 @@ label.readout {
                  (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:rotate (* (/ (- app-state.course app-state.smooth-course)
+                                   180) math.pi))
                    (g:translate (// height -2) (// height -2))
                    (g:set_line_width 4)
                    (g:move_to 10 height)
@@ -336,9 +402,13 @@ label.readout {
 
 (GLib.timeout_add
  GLib.PRIORITY_DEFAULT
- 20 ; ms
+ 100 ; ms
  (fn []
+   ;; run cqueues scheduler
    (cq:step 0)
+   ;; for smoother rotation when course changes, repaint more often than
+   ;; once per gnss message
+   (update-app-state {})
    true)
  nil nil)
 

pkgs/maps/shell.nix

@@ -1,8 +1,27 @@
 with import <nixpkgs> {};
-let package = pkgs.callPackage ./. {};
+let
+  package = pkgs.callPackage ./. {};
+  fennel-ls1 =
+    let inherit (pkgs) stdenv pandoc;
+    in stdenv.mkDerivation {
+      name = "fennel-ls";
+      buildInputs = [ package.lua ];
+      nativeBuildInputs = [ pandoc ];
+      makeFlags = [ "PREFIX=\\$out" ];
+      src = fetchFromSourcehut {
+        owner ="~xerool";
+        repo ="fennel-ls";
+        rev = "552b03b983c18d7db5053350711bef9088cc9110";
+        hash = "sha256-npR10hzPYgDPbKWB5ueq8cXAWYvUEbVVJ1R/EEdCnVY=";
+      };
+    };
+  fennel-ls = pkgs.fennel-ls.override { inherit (package) lua luaPackages; };
 in
 package.overrideAttrs(o: {
+  nativeBuildInputs = [ fennel-ls ] ++ o.nativeBuildInputs;
   shellHook = ''
+    mkdir -p bin
+    ( cd bin && ln -sf `type -p fennel-ls` `type -p fennel` . )
     export LUA_CPATH=$(lua -e "print(package.cpath)")
     export LUA_PATH=$(lua -e "print(package.path)")\;$RXI_JSON/share/lua/5.3/?.lua
   '';

pkgs/maps/tiles.fnl

@@ -46,10 +46,10 @@
 
 (fn overpass [lat lon zoom]
   (let [width (/ 360 (^ 2 zoom))
-        n (+ lat width)                 ;XXX adjust for latitude
-        w (- lon width)
-        s lat
-        e lon]
+        n lat
+        w lon
+        s (- lat width)
+        e (+ lon width)]
     (->
      [
       "[out:json];"
@@ -71,6 +71,7 @@
          e.id
          {
           :name (?. e :tags :name)
+          :tags e.tags
           :points
           (icollect [_ nd (ipairs e.nodes)]
             (let [node (. nodes nd)
@@ -108,7 +109,7 @@
 ;; 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]
+(fn polylines [cq x y zoom cb]
   (let [k (..  x "_" y "_" zoom)
         pathname (.. "/tmp/tiles/" k ".json")]
     (if (file-exists? pathname)
@@ -128,6 +129,7 @@
                            (cqueues.sleep (math.random 2 6))))
                        (print "got " k)
                        (f:write json)
+                       (cb)
                        true)))
           [] ; return no lines for now
           ))))