render road names (badly)
This commit is contained in:
parent
052cd4b578
commit
2906360c2e
@ -91,6 +91,29 @@ label.readout {
|
||||
|
||||
(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]
|
||||
(let [{ : lat : lon : zoom } app-state
|
||||
{ : 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:fill)
|
||||
|
||||
(each [_ line (pairs lines)]
|
||||
(case line.points
|
||||
[[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:restore))))
|
||||
(g:set_source_rgb 0 0 0)
|
||||
(g:set_line_width road-width)
|
||||
(cairo-roads-path g lines bounds)
|
||||
(g:set_source_rgb 1 1 1)
|
||||
(g:set_line_width (- road-width 2))
|
||||
(cairo-roads-path g lines bounds)
|
||||
|
||||
(g:set_source_rgb 0.2 0.2 0.2)
|
||||
(each [_ line (pairs lines)]
|
||||
(case line.points
|
||||
[[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))))
|
||||
(case line.name
|
||||
n (let [(x y) (label-coords line bounds)]
|
||||
(when (and x y)
|
||||
(g:move_to x y)
|
||||
(g:show_text n)))))
|
||||
|
||||
map-surface)))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user