improve text placement

This commit is contained in:
Daniel Barlow 2025-06-02 23:43:14 +01:00
parent 2906360c2e
commit 66d1a585fb

View File

@ -106,12 +106,26 @@ label.readout {
(g:stroke)
(g:restore)))))
(fn label-coords [line bounds]
(case line.points
[[sx sy] & more]
(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))]
(values
(* tile-size (- sx bounds.min.x))
(* tile-size (- sy bounds.min.y)))))
(* tile-size (- x bounds.min.x))
(* tile-size (- y bounds.min.y))
angle)))
(fn cairo-the-map [window]
@ -143,12 +157,18 @@ label.readout {
(cairo-roads-path g lines bounds)
(g:set_source_rgb 0.2 0.2 0.2)
(g:set_font_size (- road-width 3))
(each [_ line (pairs lines)]
(case line.name
n (let [(x y) (label-coords line bounds)]
n (let [(x y angle) (label-coords line bounds)]
(when (and x y)
(g:save)
(g:move_to x y)
(g:show_text n)))))
(g:rotate angle)
(g:rel_move_to 0 3)
(g:text_path n)
(g:fill)
(g:restore)))))
map-surface)))