Merge pull request #100 from kaveh808/Kaveh-devel

Kaveh devel

kons-9.asd

@@ -31,12 +31,13 @@
      (:file "src/kernel/scene-item")
      (:file "src/kernel/shape")
      (:file "src/kernel/point-cloud")
-     (:file "src/kernel/polygon")
+     (:file "src/kernel/curve")
      (:file "src/kernel/polyhedron")
      (:file "src/kernel/group")
      (:file "src/kernel/procedural")
      (:file "src/kernel/motion")
      (:file "src/kernel/animator")
+     (:file "src/kernel/animation")
      (:file "src/kernel/scene")
      (:file "src/kernel/scene-draw")
      (:file "src/kernel/scene-hierarchy")
@@ -51,7 +52,7 @@
      (:file "src/plugins/sweep-mesh-group")
      (:file "src/plugins/channel")
      (:file "src/plugins/dynamics-animator")
-     (:file "src/plugins/procedural-polygon")
+     (:file "src/plugins/procedural-curve")
      (:file "src/plugins/manager-group")
      (:file "src/plugins/particle")
      (:file "src/plugins/l-system")

src/graphics/glfw/minimal-ui.lisp

@@ -52,10 +52,10 @@
   (when (scene view)
     (draw (scene view)))
   (3d-cleanup-render)
-  (when *display-ground-plane?*
-    (draw-ground-plane))
   (when *display-axes?*
     (draw-world-axes))
+  (when *display-ground-plane?*
+    (draw-ground-plane))
 
   ;; display ui layer
   (2d-setup-projection)
@@ -220,6 +220,12 @@
            ;; as default and use that for event handling
            (setf *default-scene-view* scene-view)
 
+           ;; assume monitor scale is same in x and y, just use first value
+           ;; also assume we are running on the "primary" monitor
+           (setf (monitor-scale *drawing-settings*)
+                 (first (glfw:get-monitor-content-scale (glfw:get-primary-monitor))))
+           (set-lines-thin)
+
            (setf %gl:*gl-get-proc-address* #'glfw:get-proc-address)
            (glfw:set-key-callback 'key-callback)
            (glfw:set-mouse-button-callback 'mouse-callback)

src/graphics/opengl/opengl.lisp

@@ -3,8 +3,9 @@
 ;;;; drawing-settings ==========================================================
 
 (defclass drawing-settings ()
-  ((point-size :accessor point-size :initarg :point-size :initform 9.0)
-   (line-thickness :accessor line-thickness :initarg :line-thickness :initform 3.0)
+  ((monitor-scale :accessor monitor-scale :initarg :monitor-scale :initform 1.0)
+   (point-size :accessor point-size :initarg :point-size :initform 3.0)
+   (line-thickness :accessor line-thickness :initarg :line-thickness :initform 1.0)
    (fg-color :accessor fg-color :initarg :fg-color :initform (c! 0 0 0))
    (bg-color :accessor bg-color :initarg :bg-color :initform (c! 1 1 1))
    (sel-color :accessor sel-color :initarg :sel-color :initform (c! 1 0 0))
@@ -19,16 +20,16 @@
    (secondary-line-thickness :accessor secondary-line-thickness :initarg :secondary-line-thickness :initform 1.0)))
 
 (defun set-lines-thin ()
-  (setf (point-size *drawing-settings*) 3.0)
-  (setf (line-thickness *drawing-settings*) 1.0)
-  (setf (axes-thickness *drawing-settings*) 1.0)
-  (setf (secondary-line-thickness *drawing-settings*) 0.5))
+  (setf (point-size *drawing-settings*) (* 3.0 (monitor-scale *drawing-settings*)))
+  (setf (line-thickness *drawing-settings*) (* 1.0 (monitor-scale *drawing-settings*)))
+  (setf (axes-thickness *drawing-settings*) (* 3.0 (monitor-scale *drawing-settings*)))
+  (setf (secondary-line-thickness *drawing-settings*) (* 0.5 (monitor-scale *drawing-settings*))))
 
 (defun set-lines-thick ()
-  (setf (point-size *drawing-settings*) 7.0)
-  (setf (line-thickness *drawing-settings*) 3.0)
-  (setf (axes-thickness *drawing-settings*) 3.0)
-  (setf (secondary-line-thickness *drawing-settings*) 1.0))
+  (setf (point-size *drawing-settings*) (* 6.0 (monitor-scale *drawing-settings*)))
+  (setf (line-thickness *drawing-settings*) (* 2.0 (monitor-scale *drawing-settings*)))
+  (setf (axes-thickness *drawing-settings*) (* 5.0 (monitor-scale *drawing-settings*)))
+  (setf (secondary-line-thickness *drawing-settings*) (* 1.0 (monitor-scale *drawing-settings*))))
 
 (defun set-theme-bright ()
   (setf (fg-color *drawing-settings*) (c! 0 0 0))
@@ -105,14 +106,14 @@
     (gl:line-width (axes-thickness *drawing-settings*))
     (gl:begin :lines)
     (gl:color 1.0 0.0 0.0)
-    (gl:vertex 0.0  0.0  0.0)
-    (gl:vertex size 0.0  0.0)
+    (gl:vertex 0.0  0.001  0.0)
+    (gl:vertex size 0.001 0.0)
     (gl:color 0.0 1.0 0.0)
-    (gl:vertex 0.0 0.0  0.0 )
+    (gl:vertex 0.0 0.0 0.0 )
     (gl:vertex 0.0 size 0.0 )
     (gl:color 0.0 0.0 1.0)
-    (gl:vertex 0.0  0.0  0.0)
-    (gl:vertex 0.0  0.0 size)
+    (gl:vertex 0.0  0.001  0.0)
+    (gl:vertex 0.0  0.001 size)
     (gl:end)))
 
 (defun draw-ground-plane ()

src/kernel/animation.lisp

@@ -0,0 +1,30 @@
+(in-package #:kons-9)
+
+;;;; animation =================================================================
+
+(defclass-kons-9 animation (scene-item)
+  ((shape nil)
+   (shape-animator nil)))
+
+(defmethod setup-motion ((anim animation))
+  (when (motion anim)
+    (setup-motion (motion anim))))
+
+(defmethod update-motion ((anim animation) parent-absolute-timing)
+  (when (motion anim)
+    (update-motion (motion anim) parent-absolute-timing)))
+
+(defmethod add-animation-to-scene ((anim animation) group motion-group
+                                   &key (mode :add-as-instance)) ; :add-as-duplicate
+  (cond ((eq :add-as-instance mode)
+         (let* ((instance-shape-group (make-group (list (shape anim))))
+                (anim-dup (duplicate (shape-animator anim)))
+                (instance-motion-group (make-motion-group (list anim-dup))))
+           (setf (shape anim-dup) instance-shape-group)
+           (setf (scene instance-motion-group) (scene anim-dup))
+           (add-child group instance-shape-group)
+           (add-child motion-group instance-motion-group)))
+        ((eq :add-as-duplicate mode)
+         (error "Not implemented"))
+        (t
+         (error "Unknown mode ~a" mode))))

src/kernel/curve.lisp

@@ -0,0 +1,73 @@
+(in-package #:kons-9)
+
+;;; curve class ====================================================
+
+;;; this shape is defined by an array of points (vertices)
+(defclass curve (point-cloud)
+  ((is-closed-curve? :accessor is-closed-curve? :initarg :is-closed-curve? :initform t)))
+
+(defun make-curve (points &optional (is-closed-curve? t))
+  (make-instance 'curve :points points :is-closed-curve? is-closed-curve?))
+
+(defun curve-point-tangent (i points &optional (is-closed? nil))
+  (let ((len (length points))
+	i1
+	i2)
+    (if (= len 2)
+	(progn (setf i1 0)
+	       (setf i2 1))
+	(cond ((= i 0) (if is-closed?
+			   (progn (setf i1 (1- len))
+				  (setf i2 1))
+			   (progn (setf i1 0)
+				  (setf i2 1))))
+	      ((= i (1- len)) (if is-closed?
+				  (progn (setf i1 (- len 2))
+					 (setf i2 0))
+				  (progn (setf i1 (- len 3))
+					 (setf i2 i))))
+	      (t (progn (setf i1 (1- i))
+			(setf i2 (1+ i))))))
+    (p-normalize (p- (aref points i2) (aref points i1)))))
+
+(defun curve-tangents-aux (points &optional (is-closed? nil))
+  (let ((tangents (make-array (length points))))
+    (doarray (i p points)
+      (declare (ignore p))
+      (setf (aref tangents i) (curve-point-tangent i points is-closed?)))
+    tangents))
+
+(defmethod curve-tangents ((curve curve))
+  (curve-tangents-aux (points curve) (is-closed-curve? curve)))
+
+;;; curve shape functions ----------------------------------------------------
+
+(defun make-line-curve (p1 p2 num-segments)
+  (make-curve (make-line-points p1 p2 num-segments)
+                nil))
+
+(defun make-rectangle-curve (width height &optional (num-segments 1))
+  (make-curve (make-rectangle-points width height num-segments)))
+
+(defun make-square-curve (side &optional (num-segments 1))
+  (make-curve (make-rectangle-points side side num-segments)))
+
+(defun make-circle-curve (diameter num-segments)
+  (make-curve (make-circle-points diameter num-segments)))
+
+(defun make-arc-curve (diameter start-angle end-angle num-segments)
+  (make-curve (make-arc-points diameter start-angle end-angle num-segments)
+                nil))
+
+(defun make-spiral-curve (start-diameter end-diameter length loops num-segments)
+  (make-curve (make-spiral-points start-diameter end-diameter length loops num-segments)
+                nil))
+
+(defun make-sine-curve-curve (period frequency x-scale y-scale num-segments)
+  (make-curve (make-sine-curve-points period frequency x-scale y-scale num-segments)
+                nil))
+
+#|
+(defun make-3-point-arc (p0 p1 p2 num-segments)
+  ...)
+|#

src/kernel/group.lisp

@@ -24,11 +24,6 @@
 (defun make-group (shapes &key (name nil))
   (make-instance 'group :name name :children shapes))
 
-(defun scatter-shapes-in-group (shape-fn points)
-  (make-instance 'group :children (mapcar (lambda (p)
-                                            (translate-to (funcall shape-fn) p))
-                                          (coerce points 'list))))
-
 (defmethod get-bounds ((self group))
   (let ((bounds-lo nil)
         (bounds-hi nil))
@@ -53,3 +48,26 @@
   (dolist (child (children group))
     (set-point-colors-by-point-and-normal child color-fn)))
 
+;;;; find a better place for these functions -- modeling.lisp?
+;;;; shapes is a list, points is a vector -- confusing?
+
+(defun scatter-shapes-in-group (shape-fn points)
+  (make-instance 'group :children (mapcar (lambda (p)
+                                            (translate-to (funcall shape-fn) p))
+                                          (coerce points 'list))))
+
+(defun scatter-shapes (shapes points)
+  (if (= (length shapes) (length points))
+      (loop for shape in shapes
+            for point across points
+            do (translate-to shape point))
+      (error "Mismatch in sizes of shapes (~a) and points (~a)" (length shapes) (length points))))
+
+(defun scatter-shape-instances (shapes points)
+  (if (= (length shapes) (length points))
+      (let ((instances (mapcar (lambda (shape) (make-group (list shape)))
+                               shapes)))
+        (scatter-shapes instances points)
+        instances)
+      (error "Mismatch in sizes of shapes (~a) and points (~a)" (length shapes) (length points))))
+

src/kernel/motion.lisp

@@ -71,6 +71,9 @@
   (setf (children self) '())
   self)
 
+(defun make-motion-group (motions &key (name nil))
+  (make-instance 'motion-group :name name :children motions))
+
 (defmethod setup-motion ((motion motion-group))
   (when (is-active? motion)
     (mapc #'setup-motion (children motion))))
@@ -82,3 +85,21 @@
         (mapc (lambda (m) (update-motion m timing))
               (children motion))))))
 
+(defmethod parallel-order ((motion motion-group) &optional (start-time 0.0) (duration 1.0))
+  (dolist (child (children motion))
+    (set-timing child start-time duration)))
+
+(defmethod sequential-order ((motion motion-group) &optional (start-time 0.0) (duration 1.0))
+  (when (children motion)
+    (let ((child-duration (/ duration (length (children motion))))
+          (child-start start-time))
+      (dolist (child (children motion))
+        (set-timing child child-start child-duration)
+        (incf child-start child-duration)))))
+
+(defmethod random-order ((motion motion-group) &optional (min-duration 0.0) (max-duration 1.0))
+  (dolist (child (children motion))
+    (let* ((child-duration (rand2 min-duration max-duration))
+           (child-start (rand2 0 (- 1.0 child-duration))))
+      (set-timing child child-start child-duration))))
+

src/kernel/noise.lisp

@@ -8,7 +8,7 @@
 (defconstant noise-p3 337.0)
 (defconstant noise-phi 0.6180339)
 
-(defvar *noise-pts* (make-array noise-numpts :element-type 'float))
+(defvar *noise-pts* (make-array noise-numpts :element-type 'float :initial-element 0.0))
 
 (defun init-noise ()
   (dotimes (i noise-numpts)