Merge pull request #146 from kaveh808/Kaveh-devel-2

Kaveh devel 2

kons-9.asd

@@ -23,15 +23,16 @@
   :serial t
   :components
   ((:file "src/package")
-   ;; kernel
+   ;; utils & math
    (:file "src/kernel/utils")
    (:file "src/kernel/color")
    (:file "src/kernel/point-origin")
-   ;;(:file "src/kernel/point-simd")
    (:file "src/kernel/matrix")
    (:file "src/kernel/noise")
+   ;; graphics
    (:file "src/graphics/opengl/opengl")
    (:file "src/graphics/opengl/ui-widgets")
+   ;; kernel
    (:file "src/kernel/item")
    (:file "src/kernel/transform")
    (:file "src/kernel/scene-item")
@@ -64,8 +65,9 @@
     :components ((:file "package")
                  (:file "glyph-zpb-ttf")
                  (:file "font-zpb-ttf")))
-   ;; user interface
+   ;; app user interface
    (:file "src/graphics/glfw/command-table")
+   (:file "src/graphics/glfw/application-widgets")
    (:file "src/graphics/glfw/glfw-gui")
    (:file "src/graphics/opengl/text-common")
    (:file "src/graphics/opengl/text-opengl-common")

src/graphics/glfw/application-widgets.lisp

@@ -0,0 +1,48 @@
+(in-package #:kons-9)
+
+;;;; ui-motion-outliner-item ==========================================================
+
+(defclass-kons-9 ui-motion-outliner-item (ui-outliner-item)
+  ())
+
+(defmethod absolute-timing ((view ui-motion-outliner-item))
+  (let ((motion (data view))
+        (parent-motion (and (outliner-parent view) (data (outliner-parent view)))))
+    (if (not parent-motion)
+        (vector (start-time motion) (duration motion))
+        (compute-motion-absolute-timing motion (absolute-timing (outliner-parent view))))))
+
+(defmethod draw-view :after ((view ui-motion-outliner-item) &optional (x-offset 0) (y-offset 0))
+  ;; draw bar showing motion timing data
+  (with-accessors ((x ui-x) (y ui-y) (w ui-w) (h ui-h))
+      view
+    (gl:color 0.5 0.5 1.0 0.8)
+    (let* (;(motion (data view))
+           (base-width (- w 20))
+           (timing (absolute-timing view))
+           (x0 (+ x (* base-width (aref timing 0)))) ;(start-time motion))))
+           (w0 (* base-width (aref timing 1)))) ;(duration motion))))
+      (draw-rect-fill (+ x0 x-offset 10) (+ y y-offset +5) w0 (- h 10)))))
+
+;;;; ui-motion-outliner-viewer ========================================================
+
+(defclass-kons-9 ui-motion-outliner-viewer (ui-outliner-viewer)
+  ())
+
+(defmethod outliner-item-class ((view ui-motion-outliner-viewer))
+  'ui-motion-outliner-item)
+
+(defun make-ui-motion-outliner-viewer (title obj &optional (accessor-fn nil))
+  (create-contents (make-instance 'ui-motion-outliner-viewer
+                                  :ui-x 20 :ui-y 20 :title title :data-object obj :data-accessor-fn accessor-fn)))
+
+(defmethod draw-view :after ((view ui-motion-outliner-viewer) &optional (x-offset 0) (y-offset 0))
+  ;; draw current frame indicator
+  (gl:color 0.3 0.3 0.6 1.0)
+  (let ((rel-time (relative-current-time (scene *default-scene-view*)))
+        (x-lo (+ (ui-x view) x-offset 10))
+        (x-hi (+ (ui-x view) (ui-w view) x-offset -10))
+        (y-lo (+ (ui-y view) y-offset *ui-button-item-height*))
+        (y-hi (+ (ui-y view) (ui-h view) y-offset)))
+    (draw-line (lerp rel-time x-lo x-hi) y-lo
+               (lerp rel-time x-lo x-hi) y-hi)))

src/graphics/glfw/glfw-gui.lisp

@@ -119,11 +119,10 @@
 ;; TODO -- open and save need work
 ;;    (ct-entry :O "Open Scene" (hide-menu view) (ui-clear-children (ui-contents view)) (show-open-scene-dialog))
 ;;    (ct-entry :S "Save Scene" (hide-menu view) (show-save-scene-dialog))
-    (ct-entry :S "Export USD Scene" (hide-menu view) (show-export-usd-scene-dialog))
-;; TODO -- export obj file
+    (ct-entry :E "Export OBJ Scene" (show-export-obj-scene-dialog))
+    (ct-entry :U "Export USD Scene" (show-export-usd-scene-dialog))
     (ct-entry :I "Initialize Scene" (init-scene (scene view))) ;same as '[' key binding
     (ct-entry :Q "Quit Scene" (glfw:set-window-should-close))
-;    (ct-entry :space "Update scene (hold down for animation)" (update-scene (scene view)))
     table))
 
 (defun show-open-scene-dialog ()
@@ -140,6 +139,12 @@
                                (lambda (str)
                                  (save-scene (scene *default-scene-view*) str)))))
 
+(defun show-export-obj-scene-dialog ()
+  (show-ui-content
+   (make-text-input-dialog-box "Export OBJ File"
+                               (lambda (str)
+                                 (export-obj (scene *default-scene-view*) str)))))
+
 (defun show-export-usd-scene-dialog ()
   (show-ui-content
    (make-text-input-dialog-box "Export USD File"
@@ -150,7 +155,7 @@
   (let ((table (make-instance 'command-table :title "Edit")))
 ;;    (ct-entry :S "Select (TBD)")
     ;; (ct-entry :backspace "Delete" (remove-current-selection (scene view)))
-    ;; TODO -- handle selected motions...
+    ;; TODO -- handle selected motions -- activate/deactivate...
     (ct-entry :S "Show" (dolist (shape (selected-shapes (scene view))) (setf (is-visible? shape) t)))
     (ct-entry :H "Hide" (dolist (shape (selected-shapes (scene view))) (setf (is-visible? shape) nil)))
     ;; (ct-entry :D "Duplicate (TBD)")
@@ -194,7 +199,7 @@
     (ct-entry :I "Inspector" (show-ui-content (make-ui-inspector (or (selection (scene view))
                                                                      (scene view)))))
     (ct-entry :S "Shapes" (show-ui-content (make-ui-outliner-viewer "Shapes" (shape-root (scene view)))))
-    (ct-entry :M "Motions" (show-ui-content (make-ui-outliner-viewer "Motions" (motion-root (scene view)))))
+    (ct-entry :M "Motions" (show-ui-content (make-ui-motion-outliner-viewer "Motions" (motion-root (scene view)))))
     table))
 
 (defun display-command-table (view)
@@ -361,7 +366,7 @@
          (if (= 0 (length (children (ui-contents self))))
              (setf (ui-contents-scroll self) 0)
              (reposition-ui-content-after-delete)))
-        (*ui-keyboard-focus*            ;handle text box input
+        (*ui-keyboard-focus*            ;handle text box input,  TODO -- add arrow keys
          (cond ((and (eq :v key) (member :super mod-keys))
                 (do-paste-input *ui-keyboard-focus* (glfw:get-clipboard-string)))
                ((and (eq :c key) (member :super mod-keys))

src/graphics/opengl/ui-widgets.lisp

@@ -19,7 +19,7 @@
 (defparameter *ui-font-width* 7.3)
 
 
-;;;; uitils ====================================================================
+;;;; utils ====================================================================
 
 (defun ui-text-width (text)
   (* (length text) *ui-font-width*))
@@ -647,7 +647,8 @@
 
 (defclass-kons-9 ui-outliner-item (ui-data-item)
   ((show-children? t)                   ;show hierarchy by default
-   (outliner-children '())))
+   (outliner-children '())
+   (outliner-parent nil)))
 
 (defmethod initialize-instance :after ((view ui-outliner-item)  &rest initargs)
   (declare (ignore initargs))
@@ -669,7 +670,12 @@
                                     ;; update context menu if applicable
                                     ;; (update-active-dynamic-command-table)
                                     ;; (draw-scene-view-ui *default-scene-view*))))))
-
+
+(defmethod add-outliner-child ((view ui-outliner-item) (child ui-outliner-item))
+  (push child (outliner-children view))
+  (setf (outliner-parent child) view)
+  view)
+
 (defmethod toggle-show-children ((view ui-outliner-item))
   (setf (show-children? view) (not (show-children? view))))
 
@@ -691,7 +697,7 @@
   (let ((i (position view (children (ui-parent view)))))
     (loop for child across (children (data view))
           do (let* ((text (format nil "~a" (printable-data child)))
-                    (item (make-instance 'ui-outliner-item
+                    (item (make-instance (outliner-item-class (ui-parent view))
                                          :ui-w (+ (ui-text-width text)
                                                   (* 4 *ui-default-spacing*)
                                                   (+ 20 (text-padding view)))
@@ -706,7 +712,8 @@
                                          :help-string (format nil "Mouse: select ~a, [ALT] show/hide children"
                                                               (name child)))))
                (ui-add-child-at (ui-parent view) item (incf i))
-               (push item (outliner-children view)))))
+               (add-outliner-child view item))))
+;;               (push item (outliner-children view)))))
   (when recurse?
     (dolist (item (outliner-children view))
       (when (and (has-children-method? (data item)) (show-children? item))
@@ -732,6 +739,9 @@
    :spacing 0
    :padding 0))
 
+(defmethod outliner-item-class ((view ui-outliner-viewer))
+  'ui-outliner-item)
+
 (defmethod item-show-child? ((view ui-outliner-viewer) item)
   (let ((data (assoc item (items-show-children view))))
     (if data
@@ -763,7 +773,7 @@
       (loop for entry across (coerce data 'vector)
             do (let* (;(tmp entry) ; TODO -- necessary otherwise all on-click-fn's use final entry???
                       (text (format nil "~a" (printable-data entry)))
-                      (item (make-instance 'ui-outliner-item
+                      (item (make-instance (outliner-item-class view)
                                            :ui-h *ui-button-item-height*
                                            :bg-color (if (is-selected? entry)
                                                          (c! 0.8 0.2 0.2 0.5)
@@ -858,6 +868,13 @@
 
 ;;;; drawing -------------------------
 
+(defun draw-line (x1 y1 x2 y2 &optional (line-width *ui-border-width*))
+  (gl:line-width line-width)
+  (gl:begin :lines)
+  (gl:vertex x1 y1)
+  (gl:vertex x2 y2)
+  (gl:end))
+
 (defun draw-rect-fill (x y w h &optional (inset 0.0))
   (gl:polygon-mode :front-and-back :fill)
   (gl:begin :polygon)

src/kernel/scene.lisp

@@ -26,6 +26,11 @@
 (defmethod current-time ((scene scene))
   (/ (coerce (current-frame scene) 'single-float) (fps scene)))
 
+(defmethod relative-current-time ((scene scene))
+  (if (= (end-frame scene) (start-frame scene))
+      0.0
+      (coerce (/ (current-frame scene) (- (end-frame scene) (start-frame scene))) 'float)))
+
 (defmethod add-selection ((scene scene) (item scene-item))
   (setf (is-selected? item) t)
   (pushnew item (selection scene))