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)]
(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)
(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)))

View File

@ -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))