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

draw roads fatter and with edging

Browse Source
This commit is contained in:
Daniel Barlow 2025-06-02 21:15:18 +01:00
parent 7c18f4442b
commit f8a4788ed6
1 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
pkgs/maps/main.fnl
View File

@ -94,6 +94,7 @@ label.readout {
(fn cairo-the-map [window]
(let [{ : lat : lon : zoom } app-state
{ : num-tiles-x : num-tiles-y &as bounds } (map-bounds lat lon zoom)
road-width 14
lines []]
(for [x bounds.min.x bounds.max.x]
@ -111,19 +112,38 @@ label.readout {
(g:rectangle 0 0 (* tile-size num-tiles-x) (* tile-size num-tiles-y))
(g:fill)
(g:set_source_rgb 0.2 0.2 0.6)
(g:set_line_width 2)
(each [_ line (pairs lines)]
(case line
[[sx sy] & more]
(do
(g:save)
(g:set_source_rgb 0 0 0)
(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:line_to x1 y1)))
(g:stroke)
(g:restore))))
(each [_ line (pairs lines)]
(case line
[[sx sy] & more]
(do
(g:save)
(g:set_source_rgb 1 1 1)
(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)))
(var map-surface nil)