calculate road label placement on fetch not on render

This commit is contained in:
Daniel Barlow 2025-06-09 22:08:04 +01:00
parent 13d56d59ba
commit eaa4ad895f
2 changed files with 46 additions and 58 deletions

View File

@ -183,32 +183,6 @@ label.readout {
(each [_ line (pairs lines)] (each [_ line (pairs lines)]
(cairo-road-path g line.points bounds (road-width-for line -2))))) (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) (var map-surface nil)
(fn fetch-tiles [bounds tbl zoom] (fn fetch-tiles [bounds tbl zoom]
@ -240,28 +214,22 @@ label.readout {
(g:set_font_size (+ road-width 1)) (g:set_font_size (+ road-width 1))
(each [_ line (pairs lines)] (each [_ line (pairs lines)]
(case line.name (case line.name
n (let [(x y angle) (label-coords line bounds) n (let [[tx ty angle] line.label-place
ext (g:text_extents n) ext (g:text_extents n)
w ext.width w ext.width
h ext.height] h ext.height]
(when (and x y (not (. seen-road-names n))) (when (and tx ty (not (. seen-road-names n)))
(tset seen-road-names n true) (let [x (* tile-size (- tx bounds.min.x))
(g:save) y (* tile-size (- ty bounds.min.y))]
(g:set_line_width h) (tset seen-road-names n true)
(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:save)
(g:move_to x y) (g:move_to x y)
(g:rotate angle) (g:rotate angle)
(g:rel_move_to 0 3) (g:rel_move_to (- (// w 2)) 3)
(g:text_path n) (g:text_path n)
(g:fill) (g:fill)
(g:restore))))) (g:restore))))))
surface))) surface)))

View File

@ -59,6 +59,24 @@
] ]
(table.concat "\n")))) (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] (fn canvas [elements zoom]
(let [nodes {} (let [nodes {}
lines {}] lines {}]
@ -66,19 +84,21 @@
(case e.type (case e.type
:node (tset nodes e.id e) :node (tset nodes e.id e)
:way :way
(tset (let [points
lines (icollect [_ nd (ipairs e.nodes)]
e.id (let [node (. nodes nd)
{ (tx ty) (latlon->tile node.lat node.lon zoom)]
:name (?. e :tags :name) ;;(print e.tags.name e.id e.name node.lat node.lon)
:tags e.tags [ tx ty ]))]
:points (tset
(icollect [_ nd (ipairs e.nodes)] lines
(let [node (. nodes nd) e.id
(tx ty) (latlon->tile node.lat node.lon zoom)] {
;;(print e.tags.name e.id e.name node.lat node.lon) :name (?. e :tags :name)
[ tx ty ])) :tags e.tags
}))) :label-place (label-coords points)
: points
}))))
lines)) lines))