rotate the offscreen map

this takes us from 60% cpu to about 20% (on my laptop, your hardware
may vary) when we're travelling in a straight line, as we render the
offscreen map only when the bounds change or the target orientation
changes, not every time we move

pkgs/maps/default.nix

@@ -67,6 +67,7 @@ in stdenv.mkDerivation {
   ];
   GIO_EXTRA_MODULES = [ "${glib-networking.out}/lib/gio/modules" ];
   RXI_JSON="${rxi-json}/";
+  CAIRO_TRACE_SO = "${cairo.out}/lib/cairo/libcairo-trace.so";
 
   makeFlags = [ "PREFIX=${placeholder "out"}" "NAME=${pname}" ];
 

pkgs/maps/main.fnl

@@ -1,5 +1,6 @@
 ; (local { : view } (require :fennel))
 (local { : fdopen } (require :posix.stdio))
+(local ptime (require :posix.time))
 (local cqueues (require :cqueues))
 
 (local nmea (require :nmea))
@@ -7,6 +8,21 @@
 
 (import-macros { : define-tests : expect : expect= } :assert)
 
+(local profile
+       (and (os.getenv "IN_NIX_SHELL")
+            (require :libluaperf)))
+
+(macro with-timing [label & body]
+  `(let [before# (ptime.clock_gettime ptime.CLOCK_PROCESS_CPUTIME_ID)
+         ret# (table.pack (do ,body))]
+     (let [after# (ptime.clock_gettime ptime.CLOCK_PROCESS_CPUTIME_ID)]
+       (print ,label (.. (- after#.tv_sec before#.tv_sec) "s "
+                         (// (- after#.tv_nsec before#.tv_nsec) 1000) "us "))
+       (table.unpack ret#))))
+
+; (with-timing :loop (for [i  1 100] (print i)))
+
+
 (local {
         : Gtk
         : Gdk
@@ -46,13 +62,17 @@ label.readout {
      )
     (style_provider:load_from_data CSS)))
 
+(fn main-quit []
+  (when profile (profile:stop))
+  (Gtk.main_quit))
+
 (local window (Gtk.Window {
                            :title "Map"
                            :name "toplevel"
                            :default_width viewport-width
                            :default_height viewport-height
 
-                           :on_destroy Gtk.main_quit
+                           :on_destroy main-quit
                            }))
 
 (local state-widgets { })
@@ -66,7 +86,8 @@ label.readout {
             :lon 0
             :zoom 17
             :course 0 ; direction of travel
-            :orientation 0 ; map rotation angle from north
+            :orientation-target 0  ; map rotation angle from north
+            :orientation-actual 0  ; map rotation angle from north
             :tiles {}
             }
  )
@@ -113,17 +134,23 @@ label.readout {
               :x (* tile-size num-tiles-x)
               :y (* tile-size num-tiles-y)
               }
+     :centre {
+              :x (/ (+ min-tile-x max-tile-x 1) 2)
+              :y (/ (+ min-tile-y max-tile-y 1) 2)
+              }
      }))
 
 ;; 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}))
+  (expect= bounds.max {:x 65541 :y 45016})
+  (expect= bounds.centre {:x 65539.5 :y 45014.5}))
 
 (let [bounds (map-bounds-tile 65539.0 45014.0)]
   (expect= bounds.min {:x 65536 :y 45011})
   (expect= bounds.max {:x 65541 :y 45016})
+  (expect= bounds.centre {:x 65539 :y 45014})
   )
 
 (fn map-bounds [lat lon zoom]
@@ -138,64 +165,38 @@ label.readout {
 
 (local cq (cqueues.new))
 
-(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 road-width-for [line]
+  (case (?. line :tags :highway)
+    :motorway 18
+    :trunk 17
+    :primary 16
+    :secondary 14
+    :cycleway 4
+    :footway 4
+    other 12))
 
+(fn cairo-road-path [g [[sx sy] & points] bounds]
+  (let [min bounds.min
+        { : line_to } g]
+    (g:move_to (* tile-size (- sx min.x))
+               (* tile-size (- sy min.y)))
+    (each [_ [x y] (ipairs points)]
+      (let [x1 (* tile-size (- x min.x))
+            y1 (* tile-size (- y min.y))]
+        (line_to g x1 y1)))))
 
 (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)))))
+  (g:set_source_rgb 0 0 0)
+  (each [_ line (pairs lines)]
+    (g:set_line_width (road-width-for line))
+    (cairo-road-path g line.points bounds )
+    (g:stroke))
+  (g:set_source_rgb 1 1 1)
+  (each [_ line (pairs lines)]
+    (g:set_line_width (- (road-width-for line) 2))
+    (cairo-road-path g line.points bounds)
+    (g:stroke)))
 
-(fn label-coords [{ : points } bounds]
-  (var biggest 0)
-  (var biggest-n 0)
-
-  (for [i 2 (# points)]
-    (let [[x1 y1] (. points (- i 1))
-          [x2 y2]  (. points i)
-          dist
-          (+ (* (- x2 x1)  (- x2 x1))
-             (* (- y2 y1)  (- y2 y1)))]
-      (when (>= dist biggest)
-        (set biggest dist)
-        (set biggest-n (- i 1)))))
-  (let [[x y] (. points biggest-n)
-        [nx ny] (. points (+ 1 biggest-n))
-        angle (math.atan (- ny y) (- nx x))]
-    (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)
 
@@ -222,34 +223,32 @@ label.readout {
       (g:rectangle 0 0 bounds.pixels.x bounds.pixels.y)
       (g:fill)
 
+      (g:translate (+ (// bounds.pixels.x 2))  (+ (// bounds.pixels.y 2)))
+      (g:rotate (* (/ (- app-state.orientation-target) 180) math.pi))
+      (g:translate (- (// bounds.pixels.x 2))  (- (// bounds.pixels.y 2)))
+
       (cairo-roads g lines bounds)
 
       (g:set_source_rgb 0.2 0.2 0.2)
       (g:set_font_size (+ road-width 1))
       (each [_ line (pairs lines)]
         (case line.name
-          n (let [(x y angle) (label-coords line bounds)
-                  ext  (g:text_extents n)
+          n (let [[tx ty angle] line.label-place
+                  ext (g:text_extents n)
                   w ext.width
                   h ext.height]
-              (when (and x y (not (. seen-road-names n)))
-                (tset seen-road-names n true)
-                (g:save)
-                (g:set_line_width h)
-                (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)
-                (g:stroke)
-                (g:restore)
+              (when (and tx ty (not (. seen-road-names n)))
+                (let [x (* tile-size (- tx bounds.min.x))
+                      y (* tile-size (- ty bounds.min.y))]
+                  (tset seen-road-names n true)
 
-                (g:save)
-                (g:move_to x y)
-                (g:rotate angle)
-                (g:rel_move_to 0 3)
-                (g:text_path n)
-                (g:fill)
-                (g:restore)))))
+                  (g:save)
+                  (g:move_to x y)
+                  (g:rotate angle)
+                  (g:rel_move_to (- (// w 2)) 3)
+                  (g:text_path n)
+                  (g:fill)
+                  (g:restore))))))
 
       surface)))
 
@@ -257,8 +256,16 @@ label.readout {
 (fn on-osm-draw [widget g]
   (let [(tile-x tile-y) (tiles.latlon->tile app-state.lat app-state.lon app-state.zoom)
         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))]
+        offset-x (/ (- viewport-width bounds.pixels.x) 2)
+        offset-y (/ (- viewport-height bounds.pixels.y) 2)
+        x-to-centre (- tile-x bounds.centre.x)
+        y-to-centre (- tile-y bounds.centre.y)
+        angle (- (/ (* math.pi app-state.orientation-target) 180))
+        x-to-centre-rot (- (* x-to-centre (math.cos angle))
+                           (* y-to-centre (math.sin angle)))
+        y-to-centre-rot (+ (* x-to-centre (math.sin angle))
+                           (* y-to-centre (math.cos angle)))
+        ]
 
     (when (not map-surface)
       (let [window (widget:get_window)]
@@ -270,11 +277,16 @@ label.readout {
                   bounds.pixels.y)
                (draw-onto-map-surface bounds app-state.zoom)))))
 
-    (g:translate (+ (/ viewport-width 2))  (+ (/ viewport-height 2)))
-    (g:rotate (* (/ (- 360 app-state.orientation) 180) math.pi))
-    (g:translate (- (/ viewport-width 2))  (- (/ viewport-height 2)))
 
-    (g:set_source_surface map-surface (- offset-x) (- offset-y))
+    (when (not (= app-state.orientation-actual app-state.orientation-target))
+      (print (- app-state.orientation-actual app-state.orientation-target))
+      (g:translate (+ (/ viewport-width 2))  (+ (/ viewport-height 2)))
+      (g:rotate (* (/ (- 360 (- app-state.orientation-actual app-state.orientation-target)) 180) math.pi))
+      (g:translate (- (/ viewport-width 2))  (- (/ viewport-height 2))))
+
+    (g:set_source_surface map-surface
+                          (- offset-x (* tile-size x-to-centre-rot))
+                          (- offset-y (* tile-size y-to-centre-rot)))
     (g:set_operator cairo.Operator.SOURCE)
     (g:paint)))
 
@@ -312,9 +324,15 @@ label.readout {
 
 (expect= (hhmmss (+ 45 (* 60 12) (* 60 60 3))) "3:12:45")
 
+(fn turn-smoothly [from to]
+  (if (< (math.abs (- from to)) 10) to
+      (+ from (* 0.05 (- to from)))))
+
+
 
 (fn update-app-state [new-vals]
-  (let [old-bounds
+  (let [old-state (merge {} app-state)
+        old-bounds
         (map-bounds app-state.lat app-state.lon app-state.zoom)]
     (merge app-state new-vals)
     (let [bounds
@@ -322,15 +340,29 @@ label.readout {
       (when (not (bounds= old-bounds bounds))
         (fetch-tiles bounds app-state.tiles app-state.zoom)
         (set map-surface nil)))
-    (set app-state.orientation
-         (+ app-state.orientation
-            (* 0.05 (- app-state.course app-state.orientation))))
+
+    (when (> (math.abs (- app-state.orientation-target app-state.course)) 20)
+      (set app-state.orientation-target app-state.course)
+;      (-> state-widgets.rose (: :get_window) (: :invalidate_rect nil))
+      (set map-surface nil))
+
+    (when (not (= app-state.orientation-target app-state.orientation-actual))
+      (set app-state.orientation-actual
+           (turn-smoothly app-state.orientation-actual app-state.orientation-target)))
     (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)
+        :osm
+        (when (not (and ; false
+                        (= old-state.lat app-state.lat)
+                        (= old-state.lon app-state.lon)
+                        (= old-state.orientation-actual
+                         app-state.orientation-actual)
+                   ))
+          (: (widget:get_window) :invalidate_rect nil))
         :arrow (: (widget:get_window) :invalidate_rect nil)
+        :rose (: (widget:get_window) :invalidate_rect nil)
         :time (widget:set_label
                (hhmmss (+ utc-offset app-state.time-of-day)))
         ))))
@@ -359,7 +391,7 @@ label.readout {
                  (fn [self g]
                    (g:set_source_rgb 0.4 0.0 0.1)
                    (g:translate (// height 2) (// height 2))
-                   (g:rotate (* (/ (- app-state.course app-state.orientation)
+                   (g:rotate (* (/ (- app-state.course app-state.orientation-actual)
                                    180) math.pi))
                    (g:translate (// height -2) (// height -2))
                    (g:set_line_width 4)
@@ -370,6 +402,48 @@ label.readout {
                    true)
                  }))))
 
+(fn deg->rad [degrees]
+  (* math.pi (/ degrees 180)))
+
+(fn rose []
+  (let [height 60]
+    (register-widget
+     :rose
+     (Gtk.Label {
+                 :halign Gtk.Align.START
+                 :valign Gtk.Align.START
+                 :width height :height height
+                 :on_draw
+                 (fn [self g]
+                   (g:save)
+                   (g:set_line_width 1)
+                   (g:set_source_rgb 0.4 0.0 0.1)
+                   (g:arc (// height 2) (// height 2)  15
+                          0 (* 2 math.pi))
+                   (g:stroke)
+
+                   (g:translate (// height 2) (// height 2))
+                   (g:rotate (- (deg->rad app-state.orientation-actual)))
+                   (g:translate (// height -2) (// height -2))
+
+                   (g:set_line_width 2)
+                   (g:move_to (// height 2) height)
+                   (g:line_to (// height 2) 0)
+
+                   (g:move_to 10 20)
+                   (g:line_to (// height 2) 0)
+                   (g:line_to (- height 10) 20)
+                   (g:stroke)
+
+                   (g:set_source_rgb 1 1 0)
+                   (g:move_to  (// height -2) (// height -2))
+                   (g:text_path "N")
+                   (g:fill)
+
+                   (g:restore)
+                   true)
+                 }))))
+
 
 (local socket-path (or (. arg 1) "/var/run/gnss-share.sock"))
 
@@ -421,13 +495,24 @@ label.readout {
    true)
  nil nil)
 
+(fn collect-profile []
+  (GLib.timeout_add
+   GLib.PRIORITY_DEFAULT
+   (* 60 1000) main-quit
+   nil nil)
+  (print "profiling for 60 seconds")
+  (profile.start 0))
+
+
 (window:add
  (doto (Gtk.Overlay {})
    (: :add (osm-widget))
    (: :add_overlay (readouts))
    (: :add_overlay (arrow))
+   (: :add_overlay (rose))
    ))
 
 (window:show_all)
 (styles)
+(when (os.getenv "MAP_PROFILE") (collect-profile))
 (Gtk:main)

pkgs/maps/shell.nix

@@ -16,13 +16,34 @@ let
       };
     };
   fennel-ls = pkgs.fennel-ls.override { inherit (package) lua luaPackages; };
+  luaProfiler =
+    let
+      inherit (pkgs) stdenv cmake;
+      inherit (package) lua;
+    in stdenv.mkDerivation {
+      name = "LuaProfiler";
+      src = fetchFromGitHub {
+        owner = "Patrick08T";
+        repo = "LuaProfiler";
+        rev = "abb989337f6f46b820c9d2eb1e1d339e8f6f3760";
+        hash = "sha256-43kwZCZZmWD5ens1qCzD7LTg/jKMfcb9Vw/DBiN2sSo=";
+      };
+      buildInputs = [ lua ];
+      installPhase = ''
+        mkdir -p "$out/lib/lua/${lua.luaversion}"
+        echo cp /build/source/bin/release/libluaperf.so "$out/lib/lua/${lua.luaversion}"
+        cp /build/source/bin/release/libluaperf.so "$out/lib/lua/${lua.luaversion}"
+      '';
+      nativeBuildInputs = [ cmake ];
+    };
 in
 package.overrideAttrs(o: {
-  nativeBuildInputs = [ fennel-ls ] ++ o.nativeBuildInputs;
+  nativeBuildInputs = [ fennel-ls luaProfiler flamegraph  ] ++ 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_CPATH=$(lua -e "print(package.cpath)")\;${luaProfiler}/lib/lua/${package.lua.luaversion}/\?.so
     export LUA_PATH=$(lua -e "print(package.path)")\;$RXI_JSON/share/lua/5.3/?.lua
+
   '';
 })

pkgs/maps/tiles.fnl

@@ -59,6 +59,24 @@
       ]
      (table.concat  "\n"))))
 
+(fn label-coords [points]
+  (var biggest 0)
+  (var biggest-n 0)
+  (for [i 2 (# points)]
+    (let [[x1 y1] (. points (- i 1))
+          [x2 y2]  (. points i)
+          dist
+          (+ (* (- x2 x1)  (- x2 x1))
+             (* (- y2 y1)  (- y2 y1)))]
+      (when (>= dist biggest)
+        (set biggest dist)
+        (set biggest-n (- i 1)))))
+  (let [[x y] (. points biggest-n)
+        [nx ny] (. points (+ 1 biggest-n))
+        angle (math.atan (- ny y) (- nx x))]
+    [(/ (+ nx x) 2) (/ (+ ny y) 2) angle]))
+
+
 (fn canvas [elements zoom]
   (let [nodes {}
         lines {}]
@@ -66,19 +84,21 @@
       (case e.type
         :node (tset nodes e.id e)
         :way
-        (tset
-         lines
-         e.id
-         {
-          :name (?. e :tags :name)
-          :tags e.tags
-          :points
-          (icollect [_ nd (ipairs e.nodes)]
-            (let [node (. nodes nd)
-                  (tx ty) (latlon->tile node.lat node.lon zoom)]
-              ;;(print e.tags.name e.id e.name node.lat node.lon)
-              [ tx ty  ]))
-          })))
+        (let [points
+              (icollect [_ nd (ipairs e.nodes)]
+                (let [node (. nodes nd)
+                      (tx ty) (latlon->tile node.lat node.lon zoom)]
+                  ;;(print e.tags.name e.id e.name node.lat node.lon)
+                  [ tx ty  ]))]
+          (tset
+           lines
+           e.id
+           {
+            :name (?. e :tags :name)
+            :tags e.tags
+            :label-place (label-coords points)
+            : points
+            }))))
     lines))
 
 
@@ -111,7 +131,7 @@
 
 (fn tile-name [x y zoom]
   (.. x "_" y "_" zoom))
-  
+
 (fn fetch [cq x y zoom cb]
   (let [k (tile-name x y zoom)
         pathname (.. "/tmp/tiles/" k ".json")]