From 4f30e041514c0bd025225afb02e3fbba03923672 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Sun, 11 Jun 2023 23:04:49 +0530
Subject: [PATCH 01/15] OpenGL mouse picking with ray casting

---
 kons-9.asd                              |  1 +
 src/graphics/glfw/glfw-gui.lisp         |  9 ++++
 src/graphics/opengl/opengl-picking.lisp | 55 +++++++++++++++++++++++++
 src/graphics/opengl/opengl.lisp         | 25 +++++++++++
 src/kernel/matrix.lisp                  | 27 ++++++++++++
 src/kernel/point-cloud.lisp             |  6 +++
 6 files changed, 123 insertions(+)
 create mode 100644 src/graphics/opengl/opengl-picking.lisp

diff --git a/kons-9.asd b/kons-9.asd
index 41a3514..86e0913 100644
--- a/kons-9.asd
+++ b/kons-9.asd
@@ -69,6 +69,7 @@
    ;; app user interface
    (: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")
diff --git a/src/graphics/glfw/glfw-gui.lisp b/src/graphics/glfw/glfw-gui.lisp
index 810a305..6d33178 100644
--- a/src/graphics/glfw/glfw-gui.lisp
+++ b/src/graphics/glfw/glfw-gui.lisp
@@ -7,6 +7,7 @@
 (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)
 
@@ -296,6 +297,13 @@
   (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 *display-axes?*
     (draw-world-axes))
   (when *display-ground-plane?*
@@ -479,6 +487,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)
   ;;  (format t "mouse x: ~a, y: ~a~%" x y)
   (let ((dx (- x *current-mouse-pos-x*))
         (dy (- y *current-mouse-pos-y*)))
diff --git a/src/graphics/opengl/opengl-picking.lisp b/src/graphics/opengl/opengl-picking.lisp
new file mode 100644
index 0000000..a0520f8
--- /dev/null
+++ b/src/graphics/opengl/opengl-picking.lisp
@@ -0,0 +1,55 @@
+(in-package #:kons-9)
+
+(defun opengl-pick (canvas-x canvas-y shape-group)
+  (let ((ray (make-ray canvas-x canvas-y)))
+    (do-children (child shape-group)
+                 (let ((i (intersect-ray ray child)))
+                   (if i
+                       (setf (is-selected? child) t)
+                       (setf (is-selected? child) nil))))))
+
+(defun get-aabb (lo hi)
+  (origin.geometry.aabb:aabb-from-min/max :min lo :max hi))
+
+(defun intersect-ray (ray child)
+  (multiple-value-bind (lo hi) (get-bounds-world child)
+    (when (and lo hi)
+      (origin.geometry:raycast-aabb ray (get-aabb lo hi)))))
+
+(defun make-ray (canvas-x canvas-y)
+  (multiple-value-bind
+        (x0 y0 z0 x1 y1 z1) (gl-mouse-picking-ray canvas-x canvas-y)
+    (origin.geometry.ray:ray-from-points
+     :from (origin.geometry.point3d:point
+            (coerce x0 'single-float)
+            (coerce y0 'single-float)
+            (coerce z0 'single-float))
+     :to
+     (origin.geometry.point3d:point
+      (coerce x1 'single-float)
+      (coerce y1 'single-float)
+      (coerce z1 'single-float)))))
+
+(defun demo-cube (cords-list)
+  (let ((shape (make-octahedron 1))
+        (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 demo-opengl-picking ()
+  (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)
+     )))
diff --git a/src/graphics/opengl/opengl.lisp b/src/graphics/opengl/opengl.lisp
index 124d705..4de7d12 100644
--- a/src/graphics/opengl/opengl.lisp
+++ b/src/graphics/opengl/opengl.lisp
@@ -167,6 +167,31 @@
   (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
diff --git a/src/kernel/matrix.lisp b/src/kernel/matrix.lisp
index e2a6ea6..1e62768 100644
--- a/src/kernel/matrix.lisp
+++ b/src/kernel/matrix.lisp
@@ -247,6 +247,33 @@
     (setf (aref m 3 3) (+ (* e30 f03) (* e31 f13) (* e32 f23) (* e33 f33)))
     m))
 
+(defun vector3*matrix4 (v m)
+  (let ((x (aref v 0))
+        (y (aref v 1))
+        (z (aref v 2))
+        (w 1)
+        (m00 (aref m 0 0))
+        (m01 (aref m 0 1))
+        (m02 (aref m 0 2))
+        ;; (m03 (aref m 0 3))
+        (m10 (aref m 1 0))
+        (m11 (aref m 1 1))
+        (m12 (aref m 1 2))
+        ;; (m13 (aref m 1 3))
+        (m20 (aref m 2 0))
+        (m21 (aref m 2 1))
+        (m22 (aref m 2 2))
+        ;; (m23 (aref m 2 3))
+        (m30 (aref m 3 0))
+        (m31 (aref m 3 1))
+        (m32 (aref m 3 2))
+        ;; (m33 (aref m 3 3))
+        )
+    (p!
+     (+ (* x m00) (* y m10) (* z m20) (* w m30))
+     (+ (* x m01) (* y m11) (* z m21) (* w m31))
+     (+ (* x m02) (* y m12) (* z m22) (* w m32)))))
+
 (defun matrix-multiply-n (&rest matrices)
   (when matrices
     (let ((m1 (first matrices)))
diff --git a/src/kernel/point-cloud.lisp b/src/kernel/point-cloud.lisp
index 87358f1..07816c2 100644
--- a/src/kernel/point-cloud.lisp
+++ b/src/kernel/point-cloud.lisp
@@ -37,6 +37,12 @@
               (get-bounds p-cloud)))
         (get-bounds p-cloud))))
 
+(defmethod get-bounds-world ((p-cloud point-cloud))
+  (multiple-value-bind (lo hi) (get-bounds p-cloud)
+    (let ((m (transform-matrix (transform p-cloud))))
+      (values (vector3*matrix4 lo m)
+              (vector3*matrix4 hi m)))))
+
 (defun make-point-cloud (points)
   (make-instance 'point-cloud :points points))
 

From 2790982373d4287e29d83a6f397c82b13aae7a59 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Sun, 11 Jun 2023 23:29:55 +0530
Subject: [PATCH 02/15] rename to appropriate function name

---
 src/graphics/opengl/opengl-picking.lisp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/graphics/opengl/opengl-picking.lisp b/src/graphics/opengl/opengl-picking.lisp
index a0520f8..1535581 100644
--- a/src/graphics/opengl/opengl-picking.lisp
+++ b/src/graphics/opengl/opengl-picking.lisp
@@ -38,7 +38,7 @@
     (translate-to shape (p! x y z))
     (add-shape (scene *scene-view*) shape)))
 
-(defun demo-opengl-picking ()
+(defun add-demo-shapes-to-scene ()
   (mapcar
    #'demo-cube
    `(

From 779ff692255caf6c4e93d772ed3391add0fc774e Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Sun, 18 Jun 2023 15:22:11 +0530
Subject: [PATCH 03/15] refactor - relocate `get-bounds-world` higher up the
 class hierarchy

`get-bounds-world` is applicable for any `shape`, not just `point-cloud`.
---
 src/kernel/point-cloud.lisp | 6 ------
 src/kernel/shape.lisp       | 6 ++++++
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/kernel/point-cloud.lisp b/src/kernel/point-cloud.lisp
index 07816c2..87358f1 100644
--- a/src/kernel/point-cloud.lisp
+++ b/src/kernel/point-cloud.lisp
@@ -37,12 +37,6 @@
               (get-bounds p-cloud)))
         (get-bounds p-cloud))))
 
-(defmethod get-bounds-world ((p-cloud point-cloud))
-  (multiple-value-bind (lo hi) (get-bounds p-cloud)
-    (let ((m (transform-matrix (transform p-cloud))))
-      (values (vector3*matrix4 lo m)
-              (vector3*matrix4 hi m)))))
-
 (defun make-point-cloud (points)
   (make-instance 'point-cloud :points points))
 
diff --git a/src/kernel/shape.lisp b/src/kernel/shape.lisp
index 9da79a9..e984f60 100644
--- a/src/kernel/shape.lisp
+++ b/src/kernel/shape.lisp
@@ -46,6 +46,12 @@
   (warn "Shape ~a does not have GET-BOUNDS defined. Using default bounds values." self)
   (values (p! -1 -1 -1) (p! 1 1 1)))
 
+(defmethod get-bounds-world ((self shape))
+  (multiple-value-bind (lo hi) (get-bounds self)
+    (let ((m (transform-matrix (transform self))))
+      (values (vector3*matrix4 lo m)
+              (vector3*matrix4 hi m)))))
+
 (defmethod center-at-origin ((self shape))
   (multiple-value-bind (bounds-lo bounds-hi)
       (get-bounds self)

From ed18056392ca2bb5d1bfc878fcc10179ad93c636 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Sat, 24 Jun 2023 12:20:33 +0530
Subject: [PATCH 04/15] rm vector3*matrix since transform-point already exists

vector3*matrix added revently was actually not needed.
---
 src/kernel/matrix.lisp | 27 ---------------------------
 src/kernel/shape.lisp  |  4 ++--
 2 files changed, 2 insertions(+), 29 deletions(-)

diff --git a/src/kernel/matrix.lisp b/src/kernel/matrix.lisp
index 1e62768..e2a6ea6 100644
--- a/src/kernel/matrix.lisp
+++ b/src/kernel/matrix.lisp
@@ -247,33 +247,6 @@
     (setf (aref m 3 3) (+ (* e30 f03) (* e31 f13) (* e32 f23) (* e33 f33)))
     m))
 
-(defun vector3*matrix4 (v m)
-  (let ((x (aref v 0))
-        (y (aref v 1))
-        (z (aref v 2))
-        (w 1)
-        (m00 (aref m 0 0))
-        (m01 (aref m 0 1))
-        (m02 (aref m 0 2))
-        ;; (m03 (aref m 0 3))
-        (m10 (aref m 1 0))
-        (m11 (aref m 1 1))
-        (m12 (aref m 1 2))
-        ;; (m13 (aref m 1 3))
-        (m20 (aref m 2 0))
-        (m21 (aref m 2 1))
-        (m22 (aref m 2 2))
-        ;; (m23 (aref m 2 3))
-        (m30 (aref m 3 0))
-        (m31 (aref m 3 1))
-        (m32 (aref m 3 2))
-        ;; (m33 (aref m 3 3))
-        )
-    (p!
-     (+ (* x m00) (* y m10) (* z m20) (* w m30))
-     (+ (* x m01) (* y m11) (* z m21) (* w m31))
-     (+ (* x m02) (* y m12) (* z m22) (* w m32)))))
-
 (defun matrix-multiply-n (&rest matrices)
   (when matrices
     (let ((m1 (first matrices)))
diff --git a/src/kernel/shape.lisp b/src/kernel/shape.lisp
index e984f60..775288b 100644
--- a/src/kernel/shape.lisp
+++ b/src/kernel/shape.lisp
@@ -49,8 +49,8 @@
 (defmethod get-bounds-world ((self shape))
   (multiple-value-bind (lo hi) (get-bounds self)
     (let ((m (transform-matrix (transform self))))
-      (values (vector3*matrix4 lo m)
-              (vector3*matrix4 hi m)))))
+      (values (transform-point lo m)
+              (transform-point hi m)))))
 
 (defmethod center-at-origin ((self shape))
   (multiple-value-bind (bounds-lo bounds-hi)

From 1049d0dc3844203bbe1754bf5a0586477ff97ae9 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Wed, 21 Jun 2023 11:49:17 +0530
Subject: [PATCH 05/15] Port the Moller-Trumbore ray-triangle intersection algo
 to CL

Original C code authored by Tomas Moller:
https://fileadmin.cs.lth.se/cs/Personal/Tomas_Akenine-Moller/raytri/raytri.c
---
 kons-9.asd                                   |  5 +-
 src/kernel/ray-triangle-intersect.lisp       | 81 ++++++++++++++++++++
 src/kernel/ray.lisp                          | 23 ++++++
 testsuite/entrypoint.lisp                    |  3 +-
 testsuite/kernel/ray-triangle-intersect.lisp | 78 +++++++++++++++++++
 5 files changed, 188 insertions(+), 2 deletions(-)
 create mode 100644 src/kernel/ray-triangle-intersect.lisp
 create mode 100644 src/kernel/ray.lisp
 create mode 100644 testsuite/kernel/ray-triangle-intersect.lisp

diff --git a/kons-9.asd b/kons-9.asd
index 86e0913..36ac52f 100644
--- a/kons-9.asd
+++ b/kons-9.asd
@@ -54,6 +54,8 @@
    (:file "src/kernel/scene-duplicate")
    (:file "src/kernel/protocol")
    (:file "src/kernel/clobber")
+   (:file "src/kernel/ray-triangle-intersect")
+   (:file "src/kernel/ray")
    (:file "src/kernel/main")
    ;; font libraries -- tmp until we use 3b-bmfont
    (:module "lib/JMC-font-libs/font-master"
@@ -116,7 +118,8 @@
 		 (:file "assertions")
  		 (:module "kernel"
  		  :components ((:file "utils")
-			       (:file "point-cloud")))
+			       (:file "point-cloud")
+                               (:file "ray-triangle-intersect")))
  		 (:file "entrypoint")))))
 
 (asdf:defsystem #:kons-9/api-docs
diff --git a/src/kernel/ray-triangle-intersect.lisp b/src/kernel/ray-triangle-intersect.lisp
new file mode 100644
index 0000000..7113400
--- /dev/null
+++ b/src/kernel/ray-triangle-intersect.lisp
@@ -0,0 +1,81 @@
+(in-package #:kons-9)
+
+;;; Common Lisp port of the Moller-Trumbore ray-triangle intersection algorithm.
+;;; The original C code (raytri.c) authored by Tomas Moller was found here:
+;;; https://fileadmin.cs.lth.se/cs/Personal/Tomas_Akenine-Moller/raytri/raytri.c
+
+;;; Function `intersect_triangle` from raytri.c has been ported below as
+;;; `intersect/triangle`.  Other optimized variations of this function still
+;;; remain to be ported to CL. Read more about the optimized variations in
+;;; Moller's insightful article here:
+;;; https://fileadmin.cs.lth.se/cs/Personal/Tomas_Akenine-Moller/raytri/
+
+
+;; Ray-Triangle Intersection Test Routines
+;; Different optimizations of my and Ben Trumbore's
+;; code from journals of graphics tools (JGT)
+;; http://www.acm.org/jgt/
+;; by Tomas Moller, May 2000
+
+;; Copyright 2020 Tomas Akenine-Moller
+
+;; Permission is hereby granted, free of charge, to any person obtaining a copy
+;; of this software and associated documentation files (the "Software"), to deal
+;; in the Software without restriction, including without limitation the rights
+;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;; copies of the Software, and to permit persons to whom the Software is
+;; furnished to do so, subject to the following conditions:
+
+;; The above copyright notice and this permission notice shall be included in
+;; all copies or substantial portions of the Software.
+
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;; SOFTWARE.
+
+(defun intersect/triangle (tri ray)
+  (let ((epsilon 0.000001))
+    (let ((orig (origin.geometry.ray:origin ray))
+          (dir (origin.geometry.ray:direction ray))
+          (vert0 (origin.geometry.triangle::a tri))
+          (vert1 (origin.geometry.triangle::b tri))
+          (vert2 (origin.geometry.triangle::c tri)))
+      (let* (
+             ;; find vectors for two edges sharing vert0
+             (edge1 (p:- vert1 vert0))
+             (edge2 (p:- vert2 vert0))
+             ;; begin calculating determinant - also used to calculate U
+             (pvec (p:cross dir edge2))
+             ;; if determinant is near zero, ray lies in plane of triangle
+             (det (p:dot edge1 pvec)))
+        (when (and (> det (- epsilon)) (< det epsilon))
+          (return-from intersect/triangle nil))
+        (let* ((inv-det (/ 1.0 det))
+               ;; calculate distance from vert0 to ray origin
+               (tvec (p:- orig vert0))
+               ;; calculate U and test bounds
+               (u (* (p:dot tvec pvec) inv-det)))
+          (when (or (< u 0.0) (> u 1.0))
+            (return-from intersect/triangle nil))
+          (let* (;;prepare to test V
+                 (qvec (p:cross tvec edge1))
+                 ;; calculate V parameter and test bounds
+                 (v (* (p:dot dir qvec) inv-det)))
+            (when (or (< v 0.0) (> (+ u v) 1.0))
+              (return-from intersect/triangle nil))
+            (let (;; calculate t, ray intersects triangle
+                  ;; (using `t_` since `t` clashes in Common Lisp)
+                  (t_ (* (p:dot edge2 qvec) inv-det)))
+              ;; The original C code returns 1 if intersection occurs and 0
+              ;; otherwise, while the actual values computed by the function,
+              ;; namely t, u, v are returned indirectly via pointer arguments
+              ;; whoose contents are populated by the function.
+
+              ;; Instead, we return `(values t u v)` if intersection occurs and
+              ;; nil otherwise.
+              (values t_ u v))))))))
+
diff --git a/src/kernel/ray.lisp b/src/kernel/ray.lisp
new file mode 100644
index 0000000..7773ff6
--- /dev/null
+++ b/src/kernel/ray.lisp
@@ -0,0 +1,23 @@
+(in-package #:kons-9)
+
+(defclass ray ()
+  ((from :initarg :from :reader from)
+   (to :initarg :to :reader to)))
+
+(defmethod print-object ((self ray) stream)
+  (print-unreadable-object (self stream :type t)
+    (format stream "~s - ~s" (from self) (to self))))
+
+(defmethod intersect-triangle ((self ray) triangle-points)
+  (let ((p0 (aref triangle-points 0))
+        (p1 (aref triangle-points 1))
+        (p2 (aref triangle-points 2)))
+    (intersect/triangle
+     (origin.geometry.triangle:triangle p0 p1 p2)
+     (origin.geometry.ray:ray :origin (from self) :direction (to self)))))
+
+(defmethod intersect-aabb ((self ray) point-min point-max)
+  (origin.geometry:raycast-aabb
+   (origin.geometry.ray:ray :origin (from self) :direction (to self))
+   (origin.geometry.aabb:aabb-from-min/max
+    :min point-min :max point-max)))
diff --git a/testsuite/entrypoint.lisp b/testsuite/entrypoint.lisp
index 771b98e..cd755a5 100644
--- a/testsuite/entrypoint.lisp
+++ b/testsuite/entrypoint.lisp
@@ -11,4 +11,5 @@
 (define-testcase run-all-tests ()
   "Run all available tests."
   (testsuite-utils)
-  (testsuite-point-cloud))
+  (testsuite-point-cloud)
+  (testsuite-ray-triangle))
diff --git a/testsuite/kernel/ray-triangle-intersect.lisp b/testsuite/kernel/ray-triangle-intersect.lisp
new file mode 100644
index 0000000..8fee298
--- /dev/null
+++ b/testsuite/kernel/ray-triangle-intersect.lisp
@@ -0,0 +1,78 @@
+(in-package #:kons-9/testsuite)
+
+(define-testcase exercise-ray-traingle-intersect ()
+  (flet ((vec (a b c)
+           (origin.vec3:vec (coerce a 'single-float)
+                            (coerce b 'single-float)
+                            (coerce c 'single-float)))
+         (mk-ray (from to)
+             (origin.geometry.ray:ray :origin from :direction to)))
+    (let ((triangle (origin.geometry.triangle:triangle
+                     (vec -3.5 0 -4.5)
+                     (vec -4 1 -4.0)
+                     (vec -4.5 0 -3.5))))
+      (flet ((intersect (from to)
+               (kons-9::intersect/triangle triangle (mk-ray from to))))
+
+      ;;; Try intersections With default camera position
+        ;; top vertex
+        (assert-float-is-essentially-equal ;; inside triangle
+         15.355117
+         (intersect (vec 5.540323 2.5881906 7.912401)
+                    (vec -0.6207694 -0.10930262 -0.7763364)))
+        (assert-eq ;; outside triangle
+         nil
+         (intersect (vec 5.540323 2.5881906 7.912401)
+                    (vec -0.619678 -0.10301772 -0.7780659)))
+        ;; left vertex
+        (assert-float-is-essentially-equal ;; inside triangle
+         15.416862
+         (intersect (vec 5.540323 2.5881906 7.912401)
+                    (vec -0.6404545 -0.16041444 -0.7510561)))
+        (assert-eq ;; outside triangle
+         nil
+         (intersect (vec 5.540323 2.5881906 7.912401)
+                    (vec -0.6561073 -0.16276513 -0.73690623)))
+        ;; right vertex
+        (assert-float-is-essentially-equal ;; inside triangle
+         15.5198345
+         (intersect (vec 5.540323 2.5881906 7.912401)
+                    (vec -0.59513503 -0.1619278 -0.7871427)))
+        (assert-eq ;; outside triangle
+         nil
+         (intersect (vec 5.540323 2.5881906 7.912401)
+                    (vec -0.5779269 -0.1710878 -0.79795325)))
+
+      ;;; Retry intersections after zoomin in (closer to triangle)
+        ;; top vertex
+        (assert-float-is-essentially-equal ;; inside triangle
+         1.7190325
+         (intersect (vec -3.2982311 0.5 -2.5083206)
+                    (vec -0.4080841 0.28324336 -0.86789435)))
+        (assert-eq ;; outside triangle
+         nil
+         (intersect (vec -3.2982311 0.5 -2.5083206)
+                    (vec -0.4061101 0.29344934 -0.8654259)))
+        ;; left vertex
+        (assert-float-is-essentially-equal ;; inside triangle
+         1.6304653
+         (intersect (vec -3.2982311 0.5 -2.5083206)
+                    (vec -0.72773695 -0.29837447 -0.6175529)))
+        (assert-eq ;; outside triangle
+         nil
+         (intersect (vec -3.2982311 0.5 -2.5083206)
+                    (vec -0.73710036 -0.3065231 -0.6022679)))
+        ;; right vertex
+        (assert-float-is-essentially-equal ;; inside triangle
+         2.0412412
+         (intersect (vec -3.2982311 0.5 -2.5083206)
+                    (vec -0.10965764 -0.23859437 -0.9649082)))
+        (assert-eq ;; outside triangle
+         nil
+         (intersect (vec -3.2982311 0.5 -2.5083206)
+                    (vec -0.09089148 -0.24464947 -0.9653421)))
+        ))))
+
+
+(define-testcase testsuite-ray-triangle ()
+  (exercise-ray-traingle-intersect))

From 4adf6a756bacd8cb0cf44d635b8b11ee86a74024 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Wed, 21 Jun 2023 14:13:57 +0530
Subject: [PATCH 06/15] Get triangles of triangulated polyhedron

---
 src/kernel/polyhedron.lisp | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/src/kernel/polyhedron.lisp b/src/kernel/polyhedron.lisp
index 9659da2..2d1f8e5 100644
--- a/src/kernel/polyhedron.lisp
+++ b/src/kernel/polyhedron.lisp
@@ -118,6 +118,22 @@
 (defmethod face-points-array ((polyh polyhedron) (face list))
   (coerce (face-points-list polyh face) 'vector))
 
+(defmethod triangles-list ((polyh polyhedron) &key (matrix nil))
+  (let ((triangles '())
+        (tri-polyh (if (is-triangulated-polyhedron? polyh)
+                       polyh
+                       (triangulate-polyhedron polyh))))
+    (flet ((transform-if (xs) (if matrix (transform-points xs matrix) xs)))
+      (do-array (_ face (faces tri-polyh))
+        (push (transform-if (face-points-array tri-polyh face)) triangles)))
+    triangles))
+
+(defmethod triangles-array ((polyh polyhedron) &key (matrix nil))
+  (coerce (triangles-list polyh :matrix matrix) 'vector))
+
+(defmethod triangles-world-array ((polyh polyhedron))
+  (triangles-array polyh :matrix (transform-matrix (transform polyh))))
+
 (defmethod reverse-face-normals ((polyh polyhedron))
   (dotimes (i (length (face-normals polyh)))
     (setf (aref (face-normals polyh) i) (p:negate (aref (face-normals polyh) i))))

From c4614a1a3afe93b6d5e391c08ef6e60924216fa5 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Sat, 24 Jun 2023 23:46:32 +0530
Subject: [PATCH 07/15] OpenGL picking - intersect ray with a shape's triangles

---
 kons-9.asd                       |  2 +-
 src/graphics/glfw/glfw-gui.lisp  | 29 +++++++----
 src/graphics/object-picking.lisp | 87 ++++++++++++++++++++++++++++++++
 src/graphics/opengl/opengl.lisp  | 48 +++++++++---------
 4 files changed, 131 insertions(+), 35 deletions(-)
 create mode 100644 src/graphics/object-picking.lisp

diff --git a/kons-9.asd b/kons-9.asd
index 36ac52f..dbd0d60 100644
--- a/kons-9.asd
+++ b/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")
diff --git a/src/graphics/glfw/glfw-gui.lisp b/src/graphics/glfw/glfw-gui.lisp
index 6d33178..09453a9 100644
--- a/src/graphics/glfw/glfw-gui.lisp
+++ b/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)))))
 
diff --git a/src/graphics/object-picking.lisp b/src/graphics/object-picking.lisp
new file mode 100644
index 0000000..80f4a56
--- /dev/null
+++ b/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)
+;;      )))
diff --git a/src/graphics/opengl/opengl.lisp b/src/graphics/opengl/opengl.lisp
index 4de7d12..20a43f0 100644
--- a/src/graphics/opengl/opengl.lisp
+++ b/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))

From 6618dad6921f79873a3a02d27e009aaf2dfe3a83 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Mon, 26 Jun 2023 08:33:58 +0530
Subject: [PATCH 08/15] remove unrequired file

(this got left out in the previous commit)
---
 src/graphics/opengl/opengl-picking.lisp | 55 -------------------------
 1 file changed, 55 deletions(-)
 delete mode 100644 src/graphics/opengl/opengl-picking.lisp

diff --git a/src/graphics/opengl/opengl-picking.lisp b/src/graphics/opengl/opengl-picking.lisp
deleted file mode 100644
index 1535581..0000000
--- a/src/graphics/opengl/opengl-picking.lisp
+++ /dev/null
@@ -1,55 +0,0 @@
-(in-package #:kons-9)
-
-(defun opengl-pick (canvas-x canvas-y shape-group)
-  (let ((ray (make-ray canvas-x canvas-y)))
-    (do-children (child shape-group)
-                 (let ((i (intersect-ray ray child)))
-                   (if i
-                       (setf (is-selected? child) t)
-                       (setf (is-selected? child) nil))))))
-
-(defun get-aabb (lo hi)
-  (origin.geometry.aabb:aabb-from-min/max :min lo :max hi))
-
-(defun intersect-ray (ray child)
-  (multiple-value-bind (lo hi) (get-bounds-world child)
-    (when (and lo hi)
-      (origin.geometry:raycast-aabb ray (get-aabb lo hi)))))
-
-(defun make-ray (canvas-x canvas-y)
-  (multiple-value-bind
-        (x0 y0 z0 x1 y1 z1) (gl-mouse-picking-ray canvas-x canvas-y)
-    (origin.geometry.ray:ray-from-points
-     :from (origin.geometry.point3d:point
-            (coerce x0 'single-float)
-            (coerce y0 'single-float)
-            (coerce z0 'single-float))
-     :to
-     (origin.geometry.point3d:point
-      (coerce x1 'single-float)
-      (coerce y1 'single-float)
-      (coerce z1 'single-float)))))
-
-(defun demo-cube (cords-list)
-  (let ((shape (make-octahedron 1))
-        (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 ()
-  (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)
-     )))

From bb242eef0b4d6e6f417c4e5531594916a5bafe5b Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Tue, 27 Jun 2023 16:05:07 +0530
Subject: [PATCH 09/15] picking - don't show picking ray

The picking raw which was being drawn until this commit did not actually
represent the picking ray because it started from the scene origin instead of
from the camera position. It doesn't serve any purpose anymore.
---
 src/graphics/glfw/glfw-gui.lisp  | 36 +++++++++++++++-----------------
 src/graphics/object-picking.lisp |  9 ++++----
 src/graphics/opengl/opengl.lisp  |  8 -------
 3 files changed, 22 insertions(+), 31 deletions(-)

diff --git a/src/graphics/glfw/glfw-gui.lisp b/src/graphics/glfw/glfw-gui.lisp
index 09453a9..7037f70 100644
--- a/src/graphics/glfw/glfw-gui.lisp
+++ b/src/graphics/glfw/glfw-gui.lisp
@@ -289,6 +289,17 @@
     table))
 
 
+(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))))
+
 (defmethod draw-scene-view ((view scene-view))
   (3d-setup-buffer)
   (3d-setup-projection)
@@ -296,13 +307,17 @@
   (when (scene view)
     (draw (scene view)))
   (3d-cleanup-render)
-  (when-pick-requested
-    (do-picking-and-draw-ray view))
   (when *display-axes?*
     (draw-world-axes))
   (when *display-ground-plane?*
     (draw-ground-plane))
 
+  ;; object picking
+
+  (when-pick-requested
+    (with-ray-at-current-mouse-pos (ray)
+      (apply #'handle-pick-request ray view '())))
+
   ;; display ui layer
 
   (2d-setup-projection (first *window-size*) (second *window-size*))
@@ -723,21 +738,4 @@
      (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)))))
 
diff --git a/src/graphics/object-picking.lisp b/src/graphics/object-picking.lisp
index 80f4a56..b946557 100644
--- a/src/graphics/object-picking.lisp
+++ b/src/graphics/object-picking.lisp
@@ -1,10 +1,8 @@
 (in-package #:kons-9)
 
 (defparameter *object-pick-requested* nil)
-(defparameter *object-picking-ray-visible* t)
 
-(defmacro picking-ray-visible-p ()
-  '*object-picking-ray-visible*)
+;;;; utils =====================================================================
 
 (defmacro make-pick-request ()
   `(setf *object-pick-requested* t))
@@ -14,6 +12,8 @@
      (setf *object-pick-requested* nil)
      ,@body))
 
+;;;; intersect =================================================================
+
 (defun intersect-shape-triangles (ray shape)
   (let ((min nil))
     (do-array (_ triangle-pts (triangles-world-array shape))
@@ -46,11 +46,12 @@
     (let ((xs-hit (mapcar #'cdr xs-hit-distances)))
       (values xs-hit xs-miss))))
 
+;;;; pick ======================================================================
+
 (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)))
diff --git a/src/graphics/opengl/opengl.lisp b/src/graphics/opengl/opengl.lisp
index 20a43f0..8e5030b 100644
--- a/src/graphics/opengl/opengl.lisp
+++ b/src/graphics/opengl/opengl.lisp
@@ -524,11 +524,3 @@
   (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))

From 43ad87392ec820d68b6a92bfe16a8a585d7a3e3f Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Tue, 27 Jun 2023 17:52:07 +0530
Subject: [PATCH 10/15] refactor picking

---
 kons-9.asd                                   |  2 +-
 src/graphics/glfw/glfw-gui.lisp              | 36 ++++++++++-----
 src/{graphics => kernel}/object-picking.lisp | 48 ++------------------
 src/kernel/polyhedron.lisp                   |  2 +
 test/demo-object-picking.lisp                | 28 ++++++++++++
 5 files changed, 58 insertions(+), 58 deletions(-)
 rename src/{graphics => kernel}/object-picking.lisp (57%)
 create mode 100644 test/demo-object-picking.lisp

diff --git a/kons-9.asd b/kons-9.asd
index dbd0d60..eac6929 100644
--- a/kons-9.asd
+++ b/kons-9.asd
@@ -56,6 +56,7 @@
    (:file "src/kernel/clobber")
    (:file "src/kernel/ray-triangle-intersect")
    (:file "src/kernel/ray")
+   (:file "src/kernel/object-picking")
    (:file "src/kernel/main")
    ;; font libraries -- tmp until we use 3b-bmfont
    (:module "lib/JMC-font-libs/font-master"
@@ -69,7 +70,6 @@
                  (: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/glfw/glfw-gui")
diff --git a/src/graphics/glfw/glfw-gui.lisp b/src/graphics/glfw/glfw-gui.lisp
index 7037f70..5cb1098 100644
--- a/src/graphics/glfw/glfw-gui.lisp
+++ b/src/graphics/glfw/glfw-gui.lisp
@@ -7,6 +7,7 @@
 (defparameter *ui-interactive-mode* nil)
 (defparameter *current-highlighted-ui-item* nil)
 (defparameter *current-choice-menu-and-pos* nil) ;nil or (menu x y)
+(defparameter *object-pick-requested* nil)
 
 (defparameter *scene-view* nil)
 
@@ -42,6 +43,28 @@
   view)
 |#
 
+;;;; utils =====================================================================
+
+(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))
+
+(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))))
+
+
 ;;;; scene-view ================================================================
 
 (defclass-kons-9 scene-view ()
@@ -289,17 +312,6 @@
     table))
 
 
-(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))))
-
 (defmethod draw-scene-view ((view scene-view))
   (3d-setup-buffer)
   (3d-setup-projection)
@@ -316,7 +328,7 @@
 
   (when-pick-requested
     (with-ray-at-current-mouse-pos (ray)
-      (apply #'handle-pick-request ray view '())))
+      (pick ray view)))
 
   ;; display ui layer
 
diff --git a/src/graphics/object-picking.lisp b/src/kernel/object-picking.lisp
similarity index 57%
rename from src/graphics/object-picking.lisp
rename to src/kernel/object-picking.lisp
index b946557..6b07680 100644
--- a/src/graphics/object-picking.lisp
+++ b/src/kernel/object-picking.lisp
@@ -1,17 +1,5 @@
 (in-package #:kons-9)
 
-(defparameter *object-pick-requested* nil)
-
-;;;; utils =====================================================================
-
-(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))
-
 ;;;; intersect =================================================================
 
 (defun intersect-shape-triangles (ray shape)
@@ -32,7 +20,7 @@
     (and (intersect-shape-aabb ray shape)
          (intersect-shape-triangles ray shape)))
 
-(defun get-hit-results (ray scene)
+(defun intersect-scene (ray scene)
   (let ((xs-hit-distances '())
         (xs-miss '())
         (xs-all (find-shapes scene #'identity)))
@@ -48,41 +36,11 @@
 
 ;;;; pick ======================================================================
 
-(defun handle-pick-request (ray view)
+(defun pick (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))
+    (multiple-value-bind (xs-hit xs-miss) (intersect-scene 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)
-;;      )))
diff --git a/src/kernel/polyhedron.lisp b/src/kernel/polyhedron.lisp
index 2d1f8e5..c30b700 100644
--- a/src/kernel/polyhedron.lisp
+++ b/src/kernel/polyhedron.lisp
@@ -119,6 +119,8 @@
   (coerce (face-points-list polyh face) 'vector))
 
 (defmethod triangles-list ((polyh polyhedron) &key (matrix nil))
+  ;; TODO: this function will only work for convex polyhedrons but it should
+  ;; work for all cases.
   (let ((triangles '())
         (tri-polyh (if (is-triangulated-polyhedron? polyh)
                        polyh
diff --git a/test/demo-object-picking.lisp b/test/demo-object-picking.lisp
new file mode 100644
index 0000000..da4dd2d
--- /dev/null
+++ b/test/demo-object-picking.lisp
@@ -0,0 +1,28 @@
+(in-package #:kons-9)
+
+#|
+
+These demos assume that you have succeeded in loading the system and opening
+the graphics window. If you have not, please check the README file.
+
+Make sure you have opened the graphics window by doing:
+
+(in-package :kons-9)
+(run)
+
+|#
+
+;;;; add-demo-shapes-to-scene ==================================================
+
+(progn
+  (flet ((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))))
+    (dotimes (x 4)
+      (dotimes (y 4)
+        (dotimes (z 4)
+          (demo-cube (list x y z)))))))

From c73c3313ea8b2fc3ba0a95aa1d3734c08f28bf05 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Tue, 27 Jun 2023 20:39:38 +0530
Subject: [PATCH 11/15] refactor ray intersection

---
 src/graphics/opengl/opengl.lisp |  5 ++-
 src/kernel/object-picking.lisp  | 38 +---------------------
 src/kernel/ray.lisp             | 56 +++++++++++++++++++++++++++------
 3 files changed, 49 insertions(+), 50 deletions(-)

diff --git a/src/graphics/opengl/opengl.lisp b/src/graphics/opengl/opengl.lisp
index 8e5030b..a386e2b 100644
--- a/src/graphics/opengl/opengl.lisp
+++ b/src/graphics/opengl/opengl.lisp
@@ -521,6 +521,5 @@
     (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)))
+  (values (gl-get-camera-position)
+          (gl-unproject-to-far-plane screen-x screen-y)))
diff --git a/src/kernel/object-picking.lisp b/src/kernel/object-picking.lisp
index 6b07680..38903a4 100644
--- a/src/kernel/object-picking.lisp
+++ b/src/kernel/object-picking.lisp
@@ -1,45 +1,9 @@
 (in-package #:kons-9)
 
-;;;; intersect =================================================================
-
-(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 intersect-scene (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))))
-
-;;;; pick ======================================================================
-
 (defun pick (ray view)
   (flet ((select (shape) (setf (is-selected? shape) t))
          (unselect (shape) (setf (is-selected? shape) nil)))
-    (multiple-value-bind (xs-hit xs-miss) (intersect-scene ray (scene view))
+    (multiple-value-bind (xs-hit xs-miss) (intersect ray (scene view))
       (unless (null xs-hit)
         (select (car xs-hit))
         (mapc #'unselect (cdr xs-hit)))
diff --git a/src/kernel/ray.lisp b/src/kernel/ray.lisp
index 7773ff6..5a83866 100644
--- a/src/kernel/ray.lisp
+++ b/src/kernel/ray.lisp
@@ -8,16 +8,52 @@
   (print-unreadable-object (self stream :type t)
     (format stream "~s - ~s" (from self) (to self))))
 
-(defmethod intersect-triangle ((self ray) triangle-points)
-  (let ((p0 (aref triangle-points 0))
-        (p1 (aref triangle-points 1))
-        (p2 (aref triangle-points 2)))
-    (intersect/triangle
-     (origin.geometry.triangle:triangle p0 p1 p2)
-     (origin.geometry.ray:ray :origin (from self) :direction (to self)))))
-
-(defmethod intersect-aabb ((self ray) point-min point-max)
+(defun intersect-aabb (ray point-min point-max)
   (origin.geometry:raycast-aabb
-   (origin.geometry.ray:ray :origin (from self) :direction (to self))
+   (origin.geometry.ray:ray :origin (from ray) :direction (to ray))
    (origin.geometry.aabb:aabb-from-min/max
     :min point-min :max point-max)))
+
+(defun intersect-triangle (ray p0 p1 p2)
+  (intersect/triangle
+   (origin.geometry.triangle:triangle p0 p1 p2)
+   (origin.geometry.ray:ray :origin (from ray) :direction (to ray))))
+
+(defun intersect-triangles (ray triangles)
+  (let ((min-distance nil))
+    (do-array (_ points triangles)
+      (let ((distance (intersect-triangle ray
+                                          (aref points 0)
+                                          (aref points 1)
+                                          (aref points 2))))
+        (when distance
+          (when (or (null min-distance) (< distance min-distance))
+            (setf min-distance distance)))))
+    min-distance))
+
+(defmethod intersect ((self ray) (shape shape))
+  (error "INTERSECT not implemented"))
+
+(defmethod intersect ((self ray) (polyh polyhedron))
+  (multiple-value-bind (lo hi) (get-bounds-world polyh)
+    (when (and lo hi)
+      (when (intersect-aabb self lo hi)
+        ;; before doing a more expensive operation of intersecting many
+        ;; triangles we first do a quick intersect with the shapes aabb (axis
+        ;; aligned bounding box). If the aabb does not intersect there is no use
+        ;; of intersecting with triangles.
+        (intersect-triangles self (triangles-world-array polyh))))))
+
+(defmethod intersect ((self ray) (scene scene))
+  (let ((xs-hit-distances '())
+        (xs-miss '())
+        (xs-all (find-shapes scene #'identity)))
+    (mapc (lambda (shape)
+            (let ((distance (intersect self 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))))

From 8f663a07c1fc636585ed5f95f28f039945f0a6fe Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Fri, 30 Jun 2023 19:41:13 +0530
Subject: [PATCH 12/15] picking bugfix - use return value of `stable-sort`

---
 src/kernel/ray.lisp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/kernel/ray.lisp b/src/kernel/ray.lisp
index 5a83866..7537e66 100644
--- a/src/kernel/ray.lisp
+++ b/src/kernel/ray.lisp
@@ -54,6 +54,6 @@
                   (push (cons distance shape) xs-hit-distances)
                   (push shape xs-miss))))
           xs-all)
-    (stable-sort xs-hit-distances #'< :key #'car)
+    (setf xs-hit-distances (stable-sort xs-hit-distances #'< :key #'car))
     (let ((xs-hit (mapcar #'cdr xs-hit-distances)))
       (values xs-hit xs-miss))))

From 9c7c65db8ad22ba90a63c1efa486aaba0d2a99be Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Fri, 30 Jun 2023 19:57:19 +0530
Subject: [PATCH 13/15] picking refactor

---
 src/graphics/glfw/glfw-gui.lisp | 37 ++++++++------------
 src/kernel/object-picking.lisp  | 62 ++++++++++++++++++++++++++++-----
 2 files changed, 68 insertions(+), 31 deletions(-)

diff --git a/src/graphics/glfw/glfw-gui.lisp b/src/graphics/glfw/glfw-gui.lisp
index 5cb1098..dcfc2ca 100644
--- a/src/graphics/glfw/glfw-gui.lisp
+++ b/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 *object-pick-requested* nil)
 
 (defparameter *scene-view* nil)
 
@@ -45,25 +44,17 @@
 
 ;;;; utils =====================================================================
 
-(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))
-
-(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 win-to-screen-xy (win-x win-y)
+  ;; In `screen space` (also for OpenGL) origin is in the botton-left. In window
+  ;; space, origin is in the top-left. So, screen-x is same as win-x but we need
+  ;; to translate win-y to get screen-y.
+  (values
+   win-x
+   (- (second *window-size*) win-y)))
 
+(defun shift-key-p (modifier-keys)
+  (not (not (find :shift modifier-keys))))
 
 ;;;; scene-view ================================================================
 
@@ -326,9 +317,8 @@
 
   ;; object picking
 
-  (when-pick-requested
-    (with-ray-at-current-mouse-pos (ray)
-      (pick ray view)))
+  (when-pick-requested (ray multi-select)
+    (pick ray multi-select (scene view)))
 
   ;; display ui layer
 
@@ -505,10 +495,11 @@
     (setf *current-mouse-pos-y* (second pos))
     (setf *current-mouse-modifier* (and mod-keys (car mod-keys)))
     (cond ((eq action :press)
-           (mouse-click (first pos) (second pos) button mod-keys)))))
+           (mouse-click (first pos) (second pos) button mod-keys)))
+    (multiple-value-bind (x y) (win-to-screen-xy (first pos) (second pos))
+      (make-pick-request x y (shift-key-p mod-keys)))))
 
 (glfw:def-cursor-pos-callback cursor-position-callback (window x y)
-  (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*)))
diff --git a/src/kernel/object-picking.lisp b/src/kernel/object-picking.lisp
index 38903a4..b5e8695 100644
--- a/src/kernel/object-picking.lisp
+++ b/src/kernel/object-picking.lisp
@@ -1,10 +1,56 @@
 (in-package #:kons-9)
 
-(defun pick (ray view)
-  (flet ((select (shape) (setf (is-selected? shape) t))
-         (unselect (shape) (setf (is-selected? shape) nil)))
-    (multiple-value-bind (xs-hit xs-miss) (intersect ray (scene view))
-      (unless (null xs-hit)
-        (select (car xs-hit))
-        (mapc #'unselect (cdr xs-hit)))
-      (mapc #'unselect xs-miss))))
+(defparameter *picking-enabled* t)
+(defparameter *picking-request* nil)
+(defparameter *picking-selector* nil)
+
+(defmacro make-pick-request (x y multi-select)
+  `(when *picking-enabled*
+     (setf *picking-request* (list ,x ,y ,multi-select))))
+
+(defmacro when-pick-requested ((ray multi-select) &body body)
+  `(when *picking-request*
+     (let ((,multi-select (elt *picking-request* 2))
+           (,ray (make-ray (elt *picking-request* 0)
+                           (elt *picking-request* 1))))
+       (setf *picking-request* nil)
+       ,@body)))
+
+;; Given a scene, the below macro gets the currently selected items. It then
+;; sets the scene selection to those items returned by the body form.
+(defmacro update-scene-selection ((current-selection scene) &body body)
+  (let ((g-scene (gensym))
+        (g-new-selection (gensym)))
+    `(let* ((,g-scene ,scene)
+            (,current-selection (copy-list (selected-shapes ,g-scene))))
+       (let ((,g-new-selection (progn ,@body)))
+         (when (listp ,g-new-selection)
+           (clear-selection ,g-scene)
+           (dolist (item ,g-new-selection)
+             (add-to-selection ,g-scene item)))))))
+
+(defun make-ray (screen-x screen-y)
+  (multiple-value-bind (from to) (gl-get-picking-ray-coords screen-x screen-y)
+    (make-instance 'ray :from from :to to)))
+
+(defun pick (ray multi-select scene)
+  (multiple-value-bind (xs-hit xs-miss) (intersect ray scene)
+    (when *picking-selector*
+      (update-scene-selection (current-selection scene)
+        (funcall *picking-selector* :xs-hit xs-hit
+                                    :xs-miss xs-miss
+                                    :xs-current current-selection
+                                    )))))
+
+;; object selection functions ==================================================
+
+(defmacro use-picking-selector (f)
+  `(setf *picking-selector* ,f))
+
+(defun picking-selector-closest-item (&key xs-hit xs-miss xs-current)
+  (declare (ignore xs-miss xs-current))
+  (when (car xs-hit)
+    (list (car xs-hit))))
+
+
+(use-picking-selector #'picking-selector-closest-item)

From 2c5a88c23b01bd61558d6c33092a2b65b94056f1 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Fri, 30 Jun 2023 20:00:33 +0530
Subject: [PATCH 14/15] picking - pick only on left click, ignore drag

Object pick only on mouse left click, ignore click due to drag.
---
 src/graphics/glfw/glfw-gui.lisp | 20 +++++++++++++++++---
 1 file changed, 17 insertions(+), 3 deletions(-)

diff --git a/src/graphics/glfw/glfw-gui.lisp b/src/graphics/glfw/glfw-gui.lisp
index dcfc2ca..8464253 100644
--- a/src/graphics/glfw/glfw-gui.lisp
+++ b/src/graphics/glfw/glfw-gui.lisp
@@ -44,6 +44,18 @@
 
 ;;;; utils =====================================================================
 
+(let ((mouse-moved "undefined"))
+
+  (defun simple-click-disturbed ()
+    (setf mouse-moved t))
+
+  (defun simple-click-left-p (button action)
+    (when (eq button :left)
+      (when (eq action :press)
+        (setf mouse-moved nil))
+      (when (eq action :release)
+        (eq mouse-moved nil))))
+  )
 
 (defun win-to-screen-xy (win-x win-y)
   ;; In `screen space` (also for OpenGL) origin is in the botton-left. In window
@@ -496,8 +508,9 @@
     (setf *current-mouse-modifier* (and mod-keys (car mod-keys)))
     (cond ((eq action :press)
            (mouse-click (first pos) (second pos) button mod-keys)))
-    (multiple-value-bind (x y) (win-to-screen-xy (first pos) (second pos))
-      (make-pick-request x y (shift-key-p mod-keys)))))
+    (when (simple-click-left-p button action)
+      (multiple-value-bind (x y) (win-to-screen-xy (first pos) (second pos))
+        (make-pick-request x y (shift-key-p mod-keys))))))
 
 (glfw:def-cursor-pos-callback cursor-position-callback (window x y)
   ;;  (format t "mouse x: ~a, y: ~a~%" x y)
@@ -509,7 +522,8 @@
       (cond ((eq action :press)
              (mouse-dragged x y dx dy))
             (t
-             (mouse-moved x y dx dy))))))
+             (mouse-moved x y dx dy)))))
+  (simple-click-disturbed))
 
 (defun register-choice-menu (menu x y)
   (setf *current-choice-menu-and-pos* (list menu x y)))

From 6163bcd54b7983e34ed6845c0f0b703d9880f600 Mon Sep 17 00:00:00 2001
From: Kayomarz Gazder <kayomarz.gazder@ahrefs.com>
Date: Fri, 30 Jun 2023 20:06:11 +0530
Subject: [PATCH 15/15] picking - selector functions for left click and `shift`
 modifier key

At this stage we can pick a single object at a time. We can also add to the
existing selection using the shift key and make mulitple selections.
---
 src/kernel/object-picking.lisp |  46 ++++++++----
 src/kernel/utils.lisp          |   5 ++
 test/demo-object-picking.lisp  | 133 +++++++++++++++++++++++++++++----
 3 files changed, 156 insertions(+), 28 deletions(-)

diff --git a/src/kernel/object-picking.lisp b/src/kernel/object-picking.lisp
index b5e8695..3f04473 100644
--- a/src/kernel/object-picking.lisp
+++ b/src/kernel/object-picking.lisp
@@ -35,22 +35,40 @@
 
 (defun pick (ray multi-select scene)
   (multiple-value-bind (xs-hit xs-miss) (intersect ray scene)
-    (when *picking-selector*
-      (update-scene-selection (current-selection scene)
-        (funcall *picking-selector* :xs-hit xs-hit
-                                    :xs-miss xs-miss
-                                    :xs-current current-selection
-                                    )))))
+    (update-scene-selection (current-selection scene)
+      (funcall (choose-picking-selector multi-select)
+               :xs-hit xs-hit
+               :xs-miss xs-miss
+               :xs-current current-selection
+               ))))
 
-;; object selection functions ==================================================
+(defun choose-picking-selector (multi-select)
+  (when (functionp *picking-selector*)
+    (return-from choose-picking-selector *picking-selector*))
 
-(defmacro use-picking-selector (f)
-  `(setf *picking-selector* ,f))
+  (if multi-select
+      #'picking-selector-click-multi
+      #'picking-selector-click-1))
 
-(defun picking-selector-closest-item (&key xs-hit xs-miss xs-current)
-  (declare (ignore xs-miss xs-current))
-  (when (car xs-hit)
-    (list (car xs-hit))))
+;; picking selector functions ==================================================
 
+(let ((prev-xs-hit nil)
+      (i -1))
+  (defun picking-selector-click-1 (&key xs-hit xs-miss xs-current)
+    (declare (ignore xs-miss xs-current))
+    (flet ((next-i ()
+             (setf i (mod (+ 1 i) (length xs-hit)))
+             i))
+      (when (not (equal prev-xs-hit xs-hit))
+        (setf prev-xs-hit xs-hit)
+        (setf i -1))
 
-(use-picking-selector #'picking-selector-closest-item)
+      (when (not (null xs-hit))
+        (list (elt xs-hit (next-i)))))))
+
+(defun picking-selector-click-multi (&key xs-hit xs-miss xs-current)
+  (declare (ignore xs-miss))
+  (let ((xs-hit-unselected (list-subtract xs-hit xs-current)))
+    (if (null xs-hit-unselected)
+        xs-current
+        (cons (car xs-hit-unselected) xs-current))))
diff --git a/src/kernel/utils.lisp b/src/kernel/utils.lisp
index 9b6d387..4b7d070 100644
--- a/src/kernel/utils.lisp
+++ b/src/kernel/utils.lisp
@@ -148,6 +148,11 @@
 (defun vec-last (vec)
   (aref vec (1- (length vec))))
 
+(defun list-subtract (list-1 list-2)
+  (remove-if
+   (lambda (el) (member el list-2))
+   list-1))
+
 ;;;; math ======================================================================
 
 (defconstant 2pi (* 2 pi))
diff --git a/test/demo-object-picking.lisp b/test/demo-object-picking.lisp
index da4dd2d..79a38d6 100644
--- a/test/demo-object-picking.lisp
+++ b/test/demo-object-picking.lisp
@@ -12,17 +12,122 @@ Make sure you have opened the graphics window by doing:
 
 |#
 
-;;;; add-demo-shapes-to-scene ==================================================
-
-(progn
-  (flet ((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))))
-    (dotimes (x 4)
-      (dotimes (y 4)
-        (dotimes (z 4)
-          (demo-cube (list x y z)))))))
+;;; Object selection ===========================================================
+
+;;; To select objects, a ray is cast out from the camera to the far point under
+;;; the mouse cursor. The ray penetrates through all objects in its path.
+
+;;; xs-hit is a list of objects hit by the ray.
+
+;;; xs-miss is a list of objects not hit.
+
+;;; Below are a couple of custom "picking selection" functions to demonstrate
+;;; how xs-hit and xs-miss along with the current selection can be used to
+;;; decide which objects remain selected in a scene after a ray is cast out.
+
+
+;;; Example 1 - Laser gun ======================================================
+
+;;; First, create random shapes to shoot at by evaluating the following:
+
+(with-clear-scene
+  (flet ((random-shape (size)
+           (funcall
+            (elt '(make-cube make-octahedron make-icosahedron) (random 3))
+            size)))
+    (let ((step 1) (shape-size 0.4) (bound 1))
+      (do ((x (- bound) (+ x step)))
+          ((> x bound))
+        (do ((y (- bound) (+ y step)))
+            ((> y bound))
+          (do ((z (- bound) (+ z step)))
+              ((> z bound))
+            (add-shape (scene *scene-view*)
+                       (translate-to (random-shape shape-size) (p! x y z)))))))))
+
+;;; Next, assign a function to global variable *picking-selector*. Normally,
+;;; *picking-selector* remains nil and in which case the default inbuilt
+;;; selector function is used.
+
+;;; This function should have `(&key xs-hit xs-miss xs-current)` as its expected
+;;; arguments (lambda list).  This function gets called by kons-9 whenever its
+;;; time to decide which objects make up the new selection of the scene after a
+;;; object picking ray is cast out.
+
+;;; The list returned by the function becomes the new scene selection.
+
+;;; btw, for this demo shooting an object only selects it.
+
+;;; To act like a laser gun, shooting should select all xs-hit but we also
+;;; maintain previously hit objects. So we need to return a concatenation of
+;;; xs-hit and xs-current.
+
+;;; xs-current which is also passed as an argument to this function is a list of
+;;; all items currently selected in the scene.
+
+(setf *picking-selector*
+      (lambda (&key xs-hit xs-miss xs-current)
+        (declare (ignore xs-miss))
+        ;; laser shoot - append to the current selection all objects which were
+        ;; hit by the laser.
+        (concatenate 'list xs-current xs-hit)))
+
+;;; Now, try clicking on objects in the scene to shoot them!
+
+;;; At anytime to clear selections, evaluate:
+
+(clear-selection *scene*)
+
+;;; You can also try rotating the scene until many objects line up and then
+;;; shoot all aligned objects in one shot.
+
+
+;;; Example 2 - All except closest =============================================
+
+;;; This selector function will select all items in the scene except for the
+;;; closest hit.
+
+(setf *picking-selector*
+      (lambda (&key xs-hit xs-miss xs-current)
+        (declare (ignore xs-current))
+        ;; select everything except the closest hit
+        (when (> (length xs-hit) 0)
+          (concatenate 'list (cdr xs-hit) xs-miss))))
+
+
+;;; Once done, you can bring back the default selector using:
+
+(setf *picking-selector* nil)
+
+;;; Default selectors ==========================================================
+
+;;; By default, there are actually two selector functions, not one:
+
+;;; 1. `picking-selector-click-1` - This selector function comes into effect
+;;; when a left click is done without using any modifier keys such as shift or
+;;; control. Only one object gets selected at a time.
+
+;;; Apart from selecting only one object at a time, this function selects a
+;;; different object on each subsequent click in the case when multiple objects
+;;; are in the line of the picking ray. This behaviour also makes it easy to
+;;; choose objects which are extremely close to each other.
+
+;;; To bring in the default picking behaviour set *picking-selector* to nil:
+
+(setf *picking-selector* nil)
+
+;;; Populate the scene with closely placed cubes and try single left clicks
+;;; multiple times to select the cubes. As long as the cubes are oriented such
+;;; that they all in the line of the ray, they will each get their turn in being
+;;; selected.
+
+(with-clear-scene 
+  (add-shapes (scene *scene-view*)
+              (list
+               (translate-to (make-cube 1) (p! 0 0 0))
+               (translate-to (make-cube 1) (p! -0.05 0.05 -0.05))
+               (translate-to (make-cube 1) (p! -0.1 0.1 -0.1)))))
+
+;;; 2. `picking-selector-click-multi` - This selector function comes into effect
+;;; when a left click occurs while the shift key was pressed down. The behaviour
+;;; is to `add` to the current selection, the closest unselected object.