biscuit

commit eaa4ad895fedc285f6adbd73dc00bdb62d0660aa
parent 13d56d59badb6220c4b83f5a085a6410354ddf15
Author: Daniel Barlow <dan@telent.net>
Date:   Mon,  9 Jun 2025 22:08:04 +0100

calculate road label placement on fetch not on render

Diffstat:
M
pkgs/maps/main.fnl
 | 
60
++++++++++++++----------------------------------------------
M
pkgs/maps/tiles.fnl
 | 
46
+++++++++++++++++++++++++++++++++-------------

2 files changed, 47 insertions(+), 59 deletions(-)
diff --git a/pkgs/maps/main.fnl b/pkgs/maps/main.fnl
@@ -183,32 +183,6 @@ label.readout {
     (each [_ line (pairs lines)]
       (cairo-road-path g line.points bounds (road-width-for line -2)))))
 
-(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)
 
 (fn fetch-tiles [bounds tbl zoom]
@@ -240,28 +214,22 @@ label.readout {
       (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)
-
-                (g:save)
-                (g:move_to x y)
-                (g:rotate angle)
-                (g:rel_move_to 0 3)
-                (g:text_path n)
-                (g:fill)
-                (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 (- (// w 2)) 3)
+                  (g:text_path n)
+                  (g:fill)
+                  (g:restore))))))
 
       surface)))
 
diff --git a/pkgs/maps/tiles.fnl b/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))