dan/biscuit
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

render road names (badly)

Browse Source
This commit is contained in:
Daniel Barlow 2025-06-02 21:53:26 +01:00
parent 052cd4b578
commit 2906360c2e
1 changed files with 35 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
pkgs/maps/main.fnl
View File

@ -91,6 +91,29 @@ label.readout {
(local cq (cqueues.new)) (local cq (cqueues.new))
(fn cairo-roads-path [g lines bounds]
(each [_ line (pairs lines)]
(case line.points
[[sx sy] & more]
(do
(g:save)
(g:move_to (* tile-size (- sx bounds.min.x))
(* tile-size (- sy bounds.min.y)))
(each [_ [x y] (ipairs more)]
(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 label-coords [line bounds]
(case line.points
[[sx sy] & more]
(values
(* tile-size (- sx bounds.min.x))
(* tile-size (- sy bounds.min.y)))))
(fn cairo-the-map [window] (fn cairo-the-map [window]
(let [{ : lat : lon : zoom } app-state (let [{ : lat : lon : zoom } app-state
{ : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom) { : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom)
@ -112,37 +135,20 @@ label.readout {
(g:rectangle 0 0 (* tile-size num-tiles-x) (* tile-size num-tiles-y)) (g:rectangle 0 0 (* tile-size num-tiles-x) (* tile-size num-tiles-y))
(g:fill) (g:fill)
(each [_ line (pairs lines)] (g:set_source_rgb 0 0 0)
(case line.points (g:set_line_width road-width)
[[sx sy] & more] (cairo-roads-path g lines bounds)
(do (g:set_source_rgb 1 1 1)
(g:save) (g:set_line_width (- road-width 2))
(g:set_source_rgb 0 0 0) (cairo-roads-path g lines bounds)
(g:set_line_width road-width)
(g:move_to (* tile-size (- sx bounds.min.x))
(* tile-size (- sy bounds.min.y)))
(each [_ [x y] (ipairs more)]
(let [x1 (* tile-size (- x bounds.min.x))
y1 (* tile-size (- y bounds.min.y))]
(g:line_to x1 y1)))
(g:stroke)
(g:restore))))
(g:set_source_rgb 0.2 0.2 0.2)
(each [_ line (pairs lines)] (each [_ line (pairs lines)]
(case line.points (case line.name
[[sx sy] & more] n (let [(x y) (label-coords line bounds)]
(do (when (and x y)
(g:save) (g:move_to x y)
(g:set_source_rgb 1 1 1) (g:show_text n)))))
(g:set_line_width (- road-width 2))
(g:move_to (* tile-size (- sx bounds.min.x))
(* tile-size (- sy bounds.min.y)))
(each [_ [x y] (ipairs more)]
(let [x1 (* tile-size (- x bounds.min.x))
y1 (* tile-size (- y bounds.min.y))]
(g:line_to x1 y1)))
(g:stroke)
(g:restore))))
map-surface))) map-surface)))