Added 3d text display

src/graphics/glfw/glfw-gui.lisp

@@ -314,6 +314,32 @@
                                 (scale-by shape (p! 1 1 (+ 1 (* dx .01))))))
     table))
 
+;;;; 3d text support -----------------------------------------------------------
+;;; calls to DRAW-3D-TEXT compute the current WORLD-TO-TEXT-COORDINATES and store
+;;; the result along with the string in *3D-TEXT-LIST*, which is traversed (after
+;;; 3d drawing is done) by DRAW-3D-TEXT-LIST
+
+;;; y is 0 at top for text display, so flip y value
+(defun world-to-text-coordinates (point)
+  (let ((screen-point (world-to-screen-coordinates point)))
+    (p! (p:x screen-point)
+        (- (second *window-size*) (p:y screen-point))
+        0)))
+
+;;; format is a list: (#(string screen-point) ...)
+(defparameter *3d-text-list* '())
+
+(defun draw-3d-text (str &optional (point +origin+))
+  (push (vector str (world-to-text-coordinates point)) *3d-text-list*))
+
+(defun draw-3d-text-list ()
+  (dolist (text *3d-text-list*)
+    (let ((str (aref text 0))
+          (p (aref text 1)))
+      (render-text (- (p:x p) (* 0.5 (ui-text-width str)))
+                   (+ (p:y p) (* 0.25 *ui-font-height*))
+                   str))))
+;;;; ---------------------------------------------------------------------------
 
 (defmethod draw-scene-view ((view scene-view))
   (3d-setup-buffer)
@@ -323,10 +349,18 @@
   (when *display-ground-plane?*
     (draw-ground-plane))
   (3d-update-light-settings)
+
+  (setf *3d-text-list* '())
+
   (when (scene view)
     (draw (scene view)))
+
   (3d-cleanup-render)
 
+  (text-engine-begin-frame)
+  (draw-3d-text-list)
+  (text-engine-end-frame))
+
   ;; object picking
 
   (when-pick-requested (ray multi-select)

src/graphics/opengl/opengl.lisp

@@ -378,6 +378,10 @@
              (gl:vertex (p:x p) (p:y p) (p:z p)))))
     (gl:end)))
 
+(defun 3d-draw-smooth-lines (points &key (highlight? nil))
+  (with-gl-enable :line-smooth
+    (3d-draw-lines points :highlight? highlight?)))
+
 (defun 3d-draw-lines (points &key (highlight? nil))
   (with-gl-disable :lighting
     (gl-set-fg-color)
@@ -393,6 +397,22 @@
       (gl:vertex (p:x p) (p:y p) (p:z p)))
     (gl:end)))
 
+;;; requires smooth shading to be enabled for alpha interpolation
+(defun 3d-draw-tapered-lines (points alpha-1 alpha-2 thickness)
+  (with-gl-disable :lighting
+    (with-gl-enable :line-smooth        ;line antialiasing required for color interpolation
+      (gl:line-width thickness)
+      (let* ((c (fg-color *drawing-settings*))
+             (i 0))
+        (gl:begin :lines)
+        (dolist (p points)
+          (if (evenp i)
+              (gl:color (c-red c) (c-green c) (c-blue c) alpha-1)
+              (gl:color (c-red c) (c-green c) (c-blue c) alpha-2))
+          (gl:vertex (p:x p) (p:y p) (p:z p))
+          (incf i))
+        (gl:end)))))
+
 (defun 3d-setup-lighting ()
   (if *do-lighting?*
       (gl:enable :lighting)
@@ -554,3 +574,12 @@
 (defun gl-get-picking-ray-coords (screen-x screen-y)
   (values (gl-get-camera-position)
           (gl-unproject-to-far-plane screen-x screen-y)))
+
+;;; world to screen projection  ================================================
+
+(defun world-to-screen-coordinates (point)
+  (multiple-value-bind (sx sy sz)
+      (glu:project (p:x point) (p:y point) (p:z point))
+    (p! sx sy sz)))
+
+

src/kernel/scene-draw.lisp

@@ -28,6 +28,8 @@
     (when (is-visible? shape)
       (when (show-axis shape)
         (draw-axis shape))
+      (when (show-name? shape)
+        (draw-name shape))
       (if (is-selected? shape)
           (draw-selected shape)
           (when (show-bounds? shape)
@@ -72,6 +74,9 @@
 (defmethod draw-axis ((shape shape))
   (3d-draw-axis (show-axis shape)))
 
+(defmethod draw-name ((shape shape))
+  (draw-3d-text (string (name shape))))
+
 (defmethod draw-bounds ((shape shape) &optional (color (c! 0 1 1)))
   (multiple-value-bind (lo hi)
       (get-bounds shape)

src/kernel/shape.lisp

@@ -6,6 +6,7 @@
   ((transform :accessor transform :initarg :transform :initform (make-instance 'euler-transform))
    (is-visible? :accessor is-visible? :initarg :is-visible? :initform t)
    (show-axis :accessor show-axis :initarg :show-axis :initform nil) ;nil or length
+   (show-name? :accessor show-name? :initarg :show-name? :initform nil)
    (show-bounds? :accessor show-bounds? :initarg :show-bounds? :initform nil)))
 
 ;;; utility methods for transforming shapes

src/plugins/flex-animator.lisp

@@ -24,9 +24,11 @@
                                                                     (current-time *scene*)))
                                                    force-fields))
                              +origin+))
-	 (internal-force (reduce #'p+
-				 (map 'vector #'(lambda (s) (spring-force s vertex))
-                                      (springs vertex))))
+	 (internal-force (if (> (length (springs vertex)) 0)
+                             (reduce #'p+
+                                     (map 'vector (lambda (s) (spring-vertex-force s vertex))
+                                          (springs vertex)))
+                             +origin+))
 	 (force (p+ external-force internal-force))       ;compute force
          (acc (p/ force (mass vertex)))	                  ;compute acceleration
          (vel (p+ (velocity vertex) acc))                 ;compute velocity
@@ -51,20 +53,29 @@
    (vertex2 nil)
    (stiffness 1.0)
    (rest-length 1.0)
-   (current-length 1.0)))
+   (current-length 1.0)
+   (current-force (p! 0 0 0))))
 
 (defmethod init-spring ((spring flex-spring))
   (setf (rest-length spring) (p-dist (point (vertex1 spring)) (point (vertex2 spring)))))
 
+(defmethod update-spring ((spring flex-spring))
+  (compute-spring-length spring)
+  (compute-spring-force spring))
+
 (defmethod compute-spring-length ((spring flex-spring))
   (setf (current-length spring)
         (p-dist (point (vertex1 spring)) (point (vertex2 spring)))))
 
-(defmethod spring-force ((spring flex-spring) (vertex flex-vertex))
-  (let ((dir (p:normalize (if (eq vertex (vertex1 spring))
-                              (p- (point (vertex2 spring)) (point (vertex1 spring)))
-                              (p- (point (vertex1 spring)) (point (vertex2 spring)))))))
-    (p* dir (* (- (current-length spring) (rest-length spring)) (stiffness spring)))))
+(defmethod compute-spring-force ((spring flex-spring))
+  (setf (current-force spring)
+        (let ((dir (p:normalize (p- (point (vertex2 spring)) (point (vertex1 spring))))))
+          (p* dir (* (- (current-length spring) (rest-length spring)) (stiffness spring))))))
+
+(defmethod spring-vertex-force ((spring flex-spring) (vertex flex-vertex))
+  (if (eq vertex (vertex1 spring))
+      (current-force spring)
+      (p:negate (current-force spring))))
 
 ;;;; flex-animator =============================================================
 
@@ -159,7 +170,7 @@
         (setf (point v) (aref points i)))
       ;; compute dynamics
       (do-array (i s springs)
-        (compute-spring-length s))
+        (update-spring s))
       (do-array (i v vertices)
         (when (not (pinned? v))
           (compute-dynamics v force-fields)))

test/demo-kernel.lisp

@@ -777,7 +777,7 @@ Hold down space key to play animation. Press '[' key to go back to frame 0.
 #|
 (Demo 20 kernel) shape display options =========================================
 
-Display shape bounds, face-normals, and axes.
+Display shape bounds, face-normals, names, and axes.
 |#
 (with-clear-scene
     (let ((circle (translate-to (make-circle-curve 3.0  7) (p! 0 0 -4.0)))
@@ -786,6 +786,9 @@ Display shape bounds, face-normals, and axes.
       (setf (show-axis circle) 1.0)
       (setf (show-normals icos) 1.0)
       (setf (show-bounds? sphere) t)
+      (setf (show-name? circle) t)
+      (setf (show-name? icos) t)
+      (setf (show-name? sphere) t)
       (add-shapes *scene* (list circle sphere icos))))
 
 #|