render road names (badly)

pkgs/maps/main.fnl

@@ -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_source_rgb 0 0 0)
-      (g:set_line_width 2)
+      (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
+        (case line.name
-          [[sx sy] & more]
+          n (let [(x y) (label-coords line bounds)]
-          (do
+              (when (and x y)
-            (g:move_to (* tile-size (- sx bounds.min.x))
+                (g:move_to x y)
-                       (* tile-size (- sy bounds.min.y)))
+                (g:show_text n)))))
-            (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)
       map-surface)))
 
 (var map-surface nil)

pkgs/maps/tiles.fnl

@@ -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)
+          :name (?. e :tags :name)
-                 (tx ty) (latlon->tile node.lat node.lon 17)]
+          :points
-             ;;(print e.tags.name e.id e.name node.lat node.lon)
+          (icollect [_ nd (ipairs e.nodes)]
-             [ tx ty  ])))))
+            (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)