OpenGL picking - intersect ray with a shape's triangles

kons-9.asd

@@ -69,9 +69,9 @@
                  (:file "glyph-zpb-ttf")
                  (:file "font-zpb-ttf")))
    ;; app user interface
+   (:file "src/graphics/object-picking")
    (:file "src/graphics/glfw/command-table")
    (:file "src/graphics/glfw/application-widgets")
-   (:file "src/graphics/opengl/opengl-picking")
    (:file "src/graphics/glfw/glfw-gui")
    (:file "src/graphics/opengl/text-common")
    (:file "src/graphics/opengl/text-opengl-common")

src/graphics/glfw/glfw-gui.lisp

@@ -7,7 +7,6 @@
 (defparameter *ui-interactive-mode* nil)
 (defparameter *current-highlighted-ui-item* nil)
 (defparameter *current-choice-menu-and-pos* nil) ;nil or (menu x y)
-(defparameter *do-mouse-pick* nil)
 
 (defparameter *scene-view* nil)
 
@@ -297,13 +296,8 @@
   (when (scene view)
     (draw (scene view)))
   (3d-cleanup-render)
-  (when *do-mouse-pick*
-    (setf *do-mouse-pick* nil)
-    (opengl-pick
-     *current-mouse-pos-x*
-     (- (second *window-size*) *current-mouse-pos-y*)
-     (shape-root (scene view))
-     ))
+  (when-pick-requested
+    (do-picking-and-draw-ray view))
   (when *display-axes?*
     (draw-world-axes))
   (when *display-ground-plane?*
@@ -487,7 +481,7 @@
            (mouse-click (first pos) (second pos) button mod-keys)))))
 
 (glfw:def-cursor-pos-callback cursor-position-callback (window x y)
-  (setf *do-mouse-pick* t)
+  (make-pick-request)
   ;;  (format t "mouse x: ~a, y: ~a~%" x y)
   (let ((dx (- x *current-mouse-pos-x*))
         (dy (- y *current-mouse-pos-y*)))
@@ -729,4 +723,21 @@
      (setf (ui-contents-scroll *scene-view*) 0)
      ))
 
+;;;; object picking ============================================================
+
+(defmacro with-ray-at-current-mouse-pos ((ray) &body body)
+  (let ((g-from (gensym))
+        (g-to (gensym)))
+    `(multiple-value-bind (,g-from ,g-to)
+         (gl-get-picking-ray-coords *current-mouse-pos-x*
+                         ;; OpenGL origin is bottom-left, win origin is top-left
+                         (- (second *window-size*) *current-mouse-pos-y*))
+       (let ((,ray (make-instance 'ray :from ,g-from :to ,g-to)))
+         ,@body))))
+
+(defun do-picking-and-draw-ray (view)
+  (with-ray-at-current-mouse-pos (ray)
+    (apply #'handle-pick-request ray view '())
+    (when (picking-ray-visible-p)
+      (3d-draw-ray (to ray)))))
 

src/graphics/object-picking.lisp

@@ -0,0 +1,87 @@
+(in-package #:kons-9)
+
+(defparameter *object-pick-requested* nil)
+(defparameter *object-picking-ray-visible* t)
+
+(defmacro picking-ray-visible-p ()
+  '*object-picking-ray-visible*)
+
+(defmacro make-pick-request ()
+  `(setf *object-pick-requested* t))
+
+(defmacro when-pick-requested (&body body)
+  `(when *object-pick-requested*
+     (setf *object-pick-requested* nil)
+     ,@body))
+
+(defun intersect-shape-triangles (ray shape)
+  (let ((min nil))
+    (do-array (_ triangle-pts (triangles-world-array shape))
+      (let ((distance (intersect-triangle ray triangle-pts)))
+        (when distance
+          (when (or (null min) (< distance min))
+            (setf min distance)))))
+    min))
+
+(defun intersect-shape-aabb (ray shape)
+  (multiple-value-bind (lo hi) (get-bounds-world shape)
+    (when (and lo hi)
+      (intersect-aabb ray lo hi))))
+
+(defun intersect-shape (ray shape)
+    (and (intersect-shape-aabb ray shape)
+         (intersect-shape-triangles ray shape)))
+
+(defun get-hit-results (ray scene)
+  (let ((xs-hit-distances '())
+        (xs-miss '())
+        (xs-all (find-shapes scene #'identity)))
+    (mapc (lambda (shape)
+            (let ((distance (intersect-shape ray shape)))
+              (if distance
+                  (push (cons distance shape) xs-hit-distances)
+                  (push shape xs-miss))))
+          xs-all)
+    (stable-sort xs-hit-distances #'< :key #'car)
+    (let ((xs-hit (mapcar #'cdr xs-hit-distances)))
+      (values xs-hit xs-miss))))
+
+(defun handle-pick-request (ray view)
+  (flet ((select (shape) (setf (is-selected? shape) t))
+         (unselect (shape) (setf (is-selected? shape) nil)))
+    (multiple-value-bind (xs-hit xs-miss) (get-hit-results ray (scene view))
+
+      (unless (null xs-hit)
+        (select (car xs-hit))
+        (mapc #'unselect (cdr xs-hit)))
+      (mapc #'unselect xs-miss))))
+
+(defun demo-cube (cords-list)
+  (let ((shape (make-octahedron 0.3))
+        (x (car cords-list))
+        (y (cadr cords-list))
+        (z (caddr cords-list)))
+    (translate-to shape (p! x y z))
+    (add-shape (scene *scene-view*) shape)))
+
+(defun add-demo-shapes-to-scene ()
+  (dotimes (x 4)
+    (dotimes (y 4)
+      (dotimes (z 4)
+        (demo-cube (list x y z))))))
+
+;; (defun add-demo-shapes-to-scene ()
+;;   (mapcar
+;;    #'demo-cube
+;;    `(
+;;      (0 0 0)
+;;      (3 4 5)
+;;      (5 5 -5)
+;;      (-5 4 -4)
+;;      (2 2 5)
+;;      (-2 -5 5)
+;;      (3 2 5)
+;;      (-4 -5 5)
+;;      (4 -3 5)
+;;      (2 -5 -5)
+;;      )))

src/graphics/opengl/opengl.lisp

@@ -167,31 +167,6 @@
   (gl:material :front-and-back :specular spec)
   (gl:material :front-and-back :shininess shine))
 
-(defun gl-get-camera-position ()
-  (let* ((inverse-matrix (origin.dmat4:invert (gl:get-double :modelview-matrix)))
-         (position (origin.dmat4:get-translation inverse-matrix)))
-    (values
-     (elt position 0)
-     (elt position 1)
-     (elt position 2))))
-
-(defun gl-unproject-to-far-plane (canvas-x canvas-y)
-  (glu:un-project canvas-x canvas-y 1.d0))
-
-(defun debug-gl-draw-ray (x y z)
-  (gl:line-width 4.0)
-  (gl:begin :lines)
-  (gl:color 1.0 1.0 0.0 1.0)
-  (gl:vertex 0.0 0.0 0.0)
-  (gl:vertex x y z)
-  (gl:end))
-
-(defun gl-mouse-picking-ray (canvas-x canvas-y)
-  (multiple-value-bind (x y z) (gl-unproject-to-far-plane canvas-x canvas-y)
-    (multiple-value-bind (cx cy cz) (gl-get-camera-position)
-      (debug-gl-draw-ray x y z)
-      (values cx cy cz x y z))))
-
 (defun 3d-update-light-settings ()
   (if *do-backface-cull?*
       (progn
@@ -533,4 +508,27 @@
   (gl:enable :blend)
 )
 
+;;; ray  =======================================================================
 
+(defun gl-get-camera-position ()
+  (let* ((inverse-matrix (origin.dmat4:invert (gl:get-double :modelview-matrix)))
+         (position (origin.dmat4:get-translation inverse-matrix)))
+    (p-vec position)))
+
+(defun gl-unproject-to-far-plane (screen-x screen-y)
+  (multiple-value-bind (x y z)
+      (glu:un-project screen-x screen-y 1.d0)
+    (p! x y z)))
+
+(defun gl-get-picking-ray-coords (screen-x screen-y)
+  (let ((from (gl-get-camera-position))
+        (to (gl-unproject-to-far-plane screen-x screen-y)))
+    (values from to)))
+
+(defun 3d-draw-ray (to &optional (from '(0 0 0)))
+  (gl:line-width 2.0)
+  (gl:begin :lines)
+  (gl:color 1.0 0.8 0 0.4)
+  (apply #'gl:vertex (coerce from 'list))
+  (apply #'gl:vertex (coerce to 'list))
+  (gl:end))