Compare commits

...

4 Commits

2 changed files with 49 additions and 19 deletions

View File

@ -91,9 +91,33 @@ 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)
road-width 14
lines []]
(for [x bounds.min.x bounds.max.x]
@ -111,19 +135,21 @@ 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)
(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
[[sx sy] & more]
(do
(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)
(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)))
(var map-surface nil)

View File

@ -59,7 +59,7 @@
]
(table.concat "\n"))))
(fn canvas [elements]
(fn canvas [elements zoom]
(let [nodes {}
lines {}]
(each [_ e (ipairs elements)]
@ -69,11 +69,15 @@
(tset
lines
e.id
(icollect [_ nd (ipairs e.nodes)]
(let [node (. nodes nd)
(tx ty) (latlon->tile node.lat node.lon 17)]
;;(print e.tags.name e.id e.name node.lat node.lon)
[ tx ty ])))))
{
:name (?. e :tags :name)
: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 ]))
})))
lines))
@ -111,7 +115,7 @@
(let [data (with-open [i (io.open pathname :r)] (i:read "*a"))]
(if (= data "")
[]
(canvas (. (json.decode data) :elements))))
(canvas (. (json.decode data) :elements) zoom)))
(let [out (io.open pathname :w)]
(cq:wrap (fn []
(print "getting " k)