Fix multipolygons

nvg.lisp

@@ -36,13 +36,64 @@
 
 (defvar *objects* nil "List of OSM referenced objects to render")
 
+
+
+(defun fix-multipoly (rel)
+  (labels ((id (obj) (ocm.osm::obj-id obj))
+           (try-attach (way ways)
+             (loop
+                with way-nodes = (ocm.osm::way-refs way)
+                with way-first = (car way-nodes)
+                with way-last = (car (last way-nodes))
+                for prev in ways
+                for prev-nodes = (ocm.osm::way-refs prev)
+                for prev-first = (car prev-nodes)
+                for prev-last = (car (last prev-nodes))
+                when (and way-first way-last prev-first prev-last)
+                do (when-let (nodes (cond
+                                      ((= (id way-first) (id prev-last))
+                                       (append prev-nodes (cdr way-nodes)))
+                                      ((= (id way-last) (id prev-first))
+                                       (append way-nodes (cdr prev-nodes)))
+                                      ((= (id way-first) (id prev-first))
+                                       (append (reverse way-nodes) (cdr prev-nodes)))
+                                      ((= (id way-last) (id prev-last))
+                                       (append prev-nodes (cdr (reverse way-nodes))))
+                                      ))
+                     (setf (ocm.osm::way-refs prev) nodes)
+                     (return prev)))))
+    (loop with inner-ways and outer-ways
+       for mem in (ocm.osm::rel-memids rel)
+       for mem-role in (ocm.osm::rel-roles rel)
+       for mem-type in (ocm.osm::rel-types rel)
+       for parts = (if (equal "inner" mem-role) inner-ways outer-ways)
+       when (ocm.osm::way-p mem)
+       unless (try-attach mem parts)
+       do (let ((new-way (ocm.osm::make-way :id (id mem)
+                                            :refs (copy-list (ocm.osm::way-refs mem)))))
+            (if (equal "inner" mem-role) (push new-way inner-ways) (push new-way outer-ways)))
+       finally (return (ocm.osm::make-rel
+                        :id (id rel) :tags (ocm.osm::obj-tags rel)
+                        :memids  (append outer-ways inner-ways)
+                        :roles (append (loop for w in outer-ways collect "outer")
+                                       (loop for w in inner-ways collect "inner"))
+                        :types (append (loop for w in outer-ways collect :way)
+                                       (loop for w in inner-ways collect :way)))))))
+
+(defun osm-fix (obj)
+  (cond
+    ((multipoly-p obj) (fix-multipoly obj))
+    (:otherwise obj)))
+
 (defun load-test-objects ()
   (setf *objects* nil)
   (ocm.osm::with-related (obj "spb.osm.pbf" '(
                                               (nil "natural" "water")
                                               (nil "natural" "wood")
-                                              (nil "natural" "scrub")))
-    (push obj *objects*)))
+                                              (nil "natural" "scrub")
+                                              (nil "highway" "primary")
+                                              (nil "highway" "secondary")))
+    (push (osm-fix obj) *objects*)))
 
 (defparameter +granularity+ (expt 10 8))
 (defun node-x (node)
@@ -57,10 +108,14 @@
     (loop for node in (cdr nodes)
        do (%nvg:line-to *context* (node-x node) (node-y node)))))
 
-(defparameter +highway-color+ '(250 0 0 255))
+(defparameter +highway-color+ '(150 100 0 255))
+(defparameter +highway-primary-color+ '(150 30 0 255))
 (defparameter +strokes+
   `(
-    (((:way "highway")) :color ,+highway-color+ :width 10)))
+    (((:way "lanes" "5")) :color ,+highway-primary-color+ :width 0.005)
+    (((:way "lanes" "3")) :color ,+highway-primary-color+ :width 0.004)
+    (((:way "highway" "primary")) :color ,+highway-primary-color+ :width 0.003)
+    (((:way "highway")) :color ,+highway-color+ :width 0.001)))
 
 (defun apply-stroke (tags)
   (when-let (options (find-match +strokes+ tags :way))
@@ -102,26 +157,34 @@
 (defun render-poly (nodes tags &optional hole)
   (render-path nodes)
   (%nvg:close-path *context*)
-  (when hole
-    (%nvg:path-winding *context* (cffi:foreign-bitfield-value '%nvg:solidity :hole)))
-  (apply-fill tags)
+  (if hole
+      (%nvg:path-winding *context* (cffi:foreign-bitfield-value '%nvg:solidity :hole))
+      (apply-fill tags))
   (%nvg:fill *context*))
 
 (defparameter +closed-lines+
   '((:way "highway")))
 
-(defun is-area (nodes tags)
+(defun closed-p (nodes)
   (let ((first (first nodes))
         (last (car (last nodes))))
     (and first last
          (= (if (ocm.osm::obj-p first) (ocm.osm::obj-id first) first)
-            (if (ocm.osm::obj-p last) (ocm.osm::obj-id last) last))
-         (not (ocm.osm::query-match2 +closed-lines+ :way tags)))))
+            (if (ocm.osm::obj-p last) (ocm.osm::obj-id last) last)))))
+
+(defun area-p (nodes tags)
+  (and (closed-p nodes)
+       (not (ocm.osm::query-match2 +closed-lines+ :way tags))))
+
+(defun multipoly-p (rel)
+  (and (ocm.osm::rel-p rel)
+       (equal (aget (tags rel) "type")
+              "multipolygon")))
 
 (defun render-way (nodes tags)
-  (if (is-area nodes tags)
+  (if (area-p nodes tags)
       (render-poly nodes tags)
-      (render-path nodes)))
+      (render-line nodes tags)))
 
 (defun render-multipoly (rel)
   (loop for mem in (ocm.osm::rel-memids rel)
@@ -129,7 +192,7 @@
      for mem-type in (ocm.osm::rel-types rel)
      when (ocm.osm::way-p mem) ;; skip non-ways
      do (render-poly (ocm.osm::way-refs mem)
-                     (merge-tags (tags mem) (tags rel))
+                     (tags rel)
                      (equal "inner" mem-role))))
 
 (defun render-objects (objects)
@@ -138,8 +201,7 @@
           (ocm.osm::way
            (render-way (ocm.osm::way-refs obj) (tags obj)))
           (ocm.osm::rel
-           (when (equal (aget (tags obj) "type")
-                        "multipolygon")
+           (when (multipoly-p obj)
              (render-multipoly obj))))))
 
 (defun render ()
@@ -150,6 +212,7 @@
 
   (%nvg:end-frame *context*))
 
+(defvar *pressed-keys* nil)
 (defun process-keys ()
   (when (member %glfw:+key-left+ *pressed-keys*) (incf *pos-x* +translate-step+))
   (when (member %glfw:+key-right+ *pressed-keys*) (decf *pos-x* +translate-step+))
@@ -160,7 +223,6 @@
 
 (defparameter +translate-step+ 80f0)
 (defparameter +scale-step+ 0.3)
-(defvar *pressed-keys* nil)
 (glfw:define-key-callback on-keys (window key scancode action mod-keys)
   (declare (ignorable window key scancode action mod-keys))
   (format t "KEY: ~{~A ~}~%" (list key scancode action mod-keys))
@@ -240,9 +302,9 @@
       (gl:viewport 0 0 *frame-width* *frame-height*)
 
       ;; reset
-      (setf *scale* 300f0
-            *pos-x* -90270.0
-            *pos-y* 180380.0)
+      (setf *scale* 540f0
+            *pos-x* -162910.0
+            *pos-y* 324540.0)
 
       ;; Creating NanoVG context
       (let ((*context* (nvg:make-context)))