Retained mode for nuklear-backed elements

borodust · Jan 6, 2017 · 4f5c393 · 4f5c393
1 parent c2dfec9
commit 4f5c393
Show file tree

Hide file tree

Showing 7 changed files with 139 additions and 30 deletions.
diff --git a/cl-bodge.asd b/cl-bodge.asd
@@ -224,6 +224,7 @@
   :serial t
   :components ((:file "packages")
                (:file "poiu")
+               (:file "elements")
                (:file "text-renderer")
                (:file "rendering-backend")
                (:module shaders

diff --git a/engine/properties.lisp b/engine/properties.lisp
@@ -2,9 +2,11 @@
 
 
 (defun %get-property (key properties &optional (default-value nil))
-  (cond ((cdr (assoc key properties :test #'equal)))
-	((functionp default-value) (funcall default-value))
-	(t default-value)))
+  (if-let ((property (assoc key properties :test #'equal)))
+    (cdr property)
+    (if (functionp default-value)
+        (funcall default-value)
+	default-value)))
 
 
 (defun %load-properties (path)

diff --git a/host/system.lisp b/host/system.lisp
@@ -145,13 +145,16 @@
 
 
 (define-system-function viewport-size host-system ()
-  (destructuring-bind (w h) (glfw:get-window-size (window-of *system*))
-    (values w h)))
+  (glfw:get-window-size (window-of *system*)))
+
+
+(define-system-function (setf viewport-size) host-system (value)
+  (destructuring-bind (w h) value
+    (glfw:set-window-size w h (window-of *system*))))
 
 
 (define-system-function cursor-position host-system ()
-  (destructuring-bind (x y) (glfw:get-cursor-position (window-of *system*))
-    (values x y)))
+  (glfw:get-cursor-position (window-of *system*)))
 
 
 (define-system-function mouse-button-state host-system (button)

diff --git a/poiu/elements.lisp b/poiu/elements.lisp
@@ -0,0 +1,114 @@
+(in-package :cl-bodge.poiu)
+
+
+(defgeneric compose (element))
+
+
+(defun compose-poiu (element context)
+  (with-poiu (context)
+    (compose element)))
+
+
+(defclass layout (parent) ())
+
+
+(defmethod compose ((this layout))
+  (dochildren (element this)
+    (compose element)))
+
+
+(defmacro window ((&rest win-opts) &body elements)
+  (labels ((expand-element (descriptor)
+             (destructuring-bind (name &rest params) (ensure-list descriptor)
+               `(,(symbolicate 'make- name) ,@params)))
+           (expand-element-hierarchy (root)
+             (with-gensyms (parent)
+               `(let ((,parent ,(expand-element (car root))))
+                  ,@(loop for child in (cdr root)
+                       collect `(adopt ,parent ,(expand-element-hierarchy child)))
+                  ,parent))))
+    (expand-element-hierarchy `((window ,@win-opts) ,@elements))))
+
+
+
+;;;
+;;;
+;;;
+(defclass window (layout disposable)
+  ((x :initarg :x :initform 0.0)
+   (y :initarg :y :initform 0.0)
+   (rect :initform (calloc '(:struct (%nk:rect))))
+   (width :initarg :width)
+   (height :initarg :height)
+   (title :initarg :title :initform "")
+   (option-mask :initarg :option-mask :initform '())))
+
+
+(define-destructor window (rect)
+  (free rect))
+
+
+(defun make-window (x y w h &optional (title "") &rest options)
+  (make-instance 'window
+                 :x x :y y :width w :height h
+                 :title title :option-mask (apply #'nk:panel-mask options)))
+
+
+(defmethod compose ((this window))
+  (with-slots (x y width height title option-mask rect) this
+    (progn
+      (%nk:begin *handle* title (%nk:rect rect x y width height) option-mask)
+      (call-next-method)
+      (%nk:end *handle*))))
+
+
+;;;
+;;;
+;;;
+(defclass menu-bar (layout) ())
+
+
+(defun make-menu-bar ()
+  (make-instance 'menu-bar))
+
+
+(defmethod compose ((this menu-bar))
+  (%nk:menubar-begin *handle*)
+  (call-next-method)
+  (%nk:menubar-end *handle*))
+
+
+;;;
+;;;
+;;;
+(defclass static-row (layout)
+  ((height :initarg :height :initform (error ":height missing"))
+   (item-width :initarg :item-width)))
+
+
+(defun make-static-row-layout (height item-width)
+  (make-instance 'static-row
+                 :height height
+                 :item-width item-width))
+
+
+(defmethod compose ((this static-row))
+  (with-slots (height item-width columns) this
+    (%nk:layout-row-static *handle* height (floor item-width) (length (children-of this)))
+    (call-next-method)))
+
+
+(defclass widget () ())
+
+
+(defclass label-button (widget)
+  ((label :initarg :label :initform (error ":label missing"))))
+
+
+(defun make-label-button (text)
+  (make-instance 'label-button :label text))
+
+
+(defmethod compose ((this label-button))
+  (with-slots (label) this
+    (%nk:button-label *handle* label)))
diff --git a/poiu/packages.lisp b/poiu/packages.lisp
@@ -6,11 +6,16 @@
   (:use :cl :cl-bodge.engine :cl-bodge.utils :cl-bodge.graphics :plus-c
         :cl-bodge.canvas :autowrap :cl-bodge.text :cl-bodge.assets)
   (:export make-poiu-context
-           with-poiu
-           with-poiu-input
-           in-window
-           render-poiu
-           clear-poiu
+           clear-poiu-context
+
+           make-poiu
+           compose-poiu
+           window
+           make-window
+           make-menu-bar
+           make-static-row-layout
+           make-label-button
 
+           with-poiu-input
            register-cursor-position
            register-mouse-input))
diff --git a/poiu/poiu.lisp b/poiu/poiu.lisp
@@ -74,22 +74,6 @@
      ,@body))
 
 
-(defmacro layout-row ((height columns) &body body)
-  `(prog2
-       (%nk:layout-row-begin *handle* %nk:+static+ ,height ,columns)
-       (progn ,@body)
-     (%nk:layout-row-end *handle*)))
-
-
-(defmacro in-window ((x y w h &optional (title "") &rest options) &body body)
-  `(unwind-protect
-        (progn
-          (c-with ((rect (:struct (%nk:rect))))
-            (%nk:begin *handle* ,title (%nk:rect rect ,x ,y ,w ,h) (nk:panel-mask ,@options))
-            ,@body))
-     (%nk:end *handle*)))
-
-
 (defmacro with-poiu-input ((poiu) &body body)
   `(with-poiu (,poiu)
      (prog2
@@ -98,7 +82,7 @@
        (%nk:input-end *handle*))))
 
 
-(definline clear-poiu (&optional (poiu *context*))
+(definline clear-poiu-context (&optional (poiu *context*))
   (%nk:clear (handle-value-of poiu)))
 
 

diff --git a/poiu/rendering-backend.lisp b/poiu/rendering-backend.lisp
@@ -189,7 +189,7 @@
   (declare (ignore cmd)))
 
 
-(defun render-poiu (&optional (poiu *context*))
+(defmethod render ((poiu nuklear-context))
   (let (commands)
     (with-canvas ((canvas-of poiu) (floor (width-of poiu)) (floor (height-of poiu)))
       (bodge-nuklear:docommands (cmd (handle-value-of poiu))