|
|
@@ -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)))
|
