Commit 2dfd3c9f authored by David O'Toole's avatar David O'Toole

rename define-node-macro to define-visual-macro

parent 4b0fb8a0
......@@ -543,7 +543,7 @@
(defmethod layout ((self frame-close-button))
(resize self 20 20))
(define-node-macro titlebar
(define-visual-macro titlebar
(:super phrase
:slots ((frozen :initform t)
(orientation :initform :horizontal)
......@@ -557,7 +557,7 @@
(defmethod set-title ((self titlebar) title)
(set-value (input-node self :title) title))
(define-node-macro frame
(define-visual-macro frame
(:super phrase
:slots ((frozen :initform t)
(orientation :initform :vertical)
......
......@@ -3,7 +3,7 @@
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
<head>
<!-- 2017-04-12 Wed 11:01 -->
<!-- 2017-04-12 Wed 12:16 -->
<meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
<meta name="viewport" content="width=device-width, initial-scale=1" />
<title>Xelf: The Graphical User Interface Toolkit</title>
......@@ -355,7 +355,7 @@ for the JavaScript code in this tag.
<li><a href="#orgeda495b">Data entry prompt</a></li>
<li><a href="#org897bacb">System terminal</a></li>
<li><a href="#org6c5a725">Rendering Smalltalk style controls</a></li>
<li><a href="#org537276d">Layout</a></li>
<li><a href="#orgbdfe093">Layout</a></li>
<li><a href="#orgc8c5c02">Duplicating a node&#xa0;&#xa0;&#xa0;<span class="tag"><span class="ccl">ccl</span>&#xa0;<span class="sbcl">sbcl</span></span></a></li>
<li><a href="#org1dfda0a">Visual Lisp lists</a>
<ul>
......@@ -363,7 +363,7 @@ for the JavaScript code in this tag.
<li><a href="#org692626f">Manipulability</a></li>
<li><a href="#orgd511959">Orientation</a></li>
<li><a href="#org6b6c188">Inputs</a></li>
<li><a href="#orgbdfe093">Layout</a></li>
<li><a href="#org1e84110">Layout</a></li>
<li><a href="#org896c5ce">Phrase / S-expression correspondence</a></li>
</ul>
</li>
......@@ -3337,9 +3337,9 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
</div>
</div>
<div id="outline-container-org537276d" class="outline-2">
<h2 id="org537276d">Layout</h2>
<div class="outline-text-2" id="text-org537276d">
<div id="outline-container-orgbdfe093" class="outline-2">
<h2 id="orgbdfe093">Layout</h2>
<div class="outline-text-2" id="text-orgbdfe093">
<div class="org-src-container">
<pre class="src src-lisp"> (<span style="color: #f47321;">defmethod</span> <span style="color: #9370db;">draw-ghost</span> ((self node))
(<span style="color: #f47321;">with-slots</span> (x y width height) self
......@@ -3651,9 +3651,9 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
</div>
</div>
<div id="outline-container-orgbdfe093" class="outline-3">
<h3 id="orgbdfe093">Layout</h3>
<div class="outline-text-3" id="text-orgbdfe093">
<div id="outline-container-org1e84110" class="outline-3">
<h3 id="org1e84110">Layout</h3>
<div class="outline-text-3" id="text-org1e84110">
<div class="org-src-container">
<pre class="src src-lisp"> (<span style="color: #f47321;">defmethod</span> <span style="color: #9370db;">header-height</span> ((self phrase)) 0)
......@@ -4950,7 +4950,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(<span style="color: #db7093;">:key</span> #'identity <span style="color: #db7093;">:test</span> 'equal <span style="color: #db7093;">:validator</span> #'identity)
(format nil <span style="color: #8b7d7b;">"~S/~S objects"</span> local global))
(<span style="color: #f47321;">define-node-macro</span> modeline
(<span style="color: #f47321;">define-visual-macro</span> modeline
(<span style="color: #db7093;">:super</span> phrase
<span style="color: #db7093;">:slots</span>
((orientation <span style="color: #db7093;">:initform</span> <span style="color: #db7093;">:horizontal</span>)
......@@ -4964,21 +4964,22 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(<span style="color: #f47321;">defmethod</span> <span style="color: #9370db;">update</span> ((self modeline))
(mapc #'pin (slot-value self 'inputs))
(set-value (input-node self <span style="color: #db7093;">:buffer-id</span>) (or (slot-value (current-buffer) 'buffer-name) <span style="color: #8b7d7b;">"*untitled-buffer*"</span>))
(set-value (input-node self <span style="color: #db7093;">:objects</span>) (modeline-database-string (hash-table-count (slot-value (current-buffer) 'objects))
(<span style="color: #f47321;">with-visual-slots</span> (buffer-id objects position mode status) self
(set-value buffer-id (or (slot-value (current-buffer) 'buffer-name) <span style="color: #8b7d7b;">"*untitled-buffer*"</span>))
(set-value objects (modeline-database-string (hash-table-count (slot-value (current-buffer) 'objects))
(hash-table-count *database*)))
(set-value (input-node self <span style="color: #db7093;">:position</span>)
(modeline-position-string
(slot-value (current-buffer) 'window-x)
(slot-value (current-buffer) 'window-y)))
(set-value (input-node self <span style="color: #db7093;">:mode</span>)
(<span style="color: #f47321;">if</span> (current-buffer)
(<span style="color: #f47321;">if</span> (slot-value (current-buffer) 'paused)
<span style="color: #8b7d7b;">"(paused)"</span>
<span style="color: #8b7d7b;">"(playing)"</span>)
<span style="color: #8b7d7b;">"(empty)"</span>))
(set-value (input-node self <span style="color: #db7093;">:status</span>)
(or *modeline-status-string* <span style="color: #8b7d7b;">" "</span>)))
(set-value position
(modeline-position-string
(slot-value (current-buffer) 'window-x)
(slot-value (current-buffer) 'window-y)))
(set-value mode
(<span style="color: #f47321;">if</span> (current-buffer)
(<span style="color: #f47321;">if</span> (slot-value (current-buffer) 'paused)
<span style="color: #8b7d7b;">"(paused)"</span>
<span style="color: #8b7d7b;">"(playing)"</span>)
<span style="color: #8b7d7b;">"(empty)"</span>))
(set-value status
(or *modeline-status-string* <span style="color: #8b7d7b;">" "</span>))))
(<span style="color: #f47321;">defmethod</span> <span style="color: #9370db;">draw</span> ((self modeline))
(<span style="color: #f47321;">with-slots</span> (x y width height) self
......@@ -5061,7 +5062,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
`(<span style="color: #f47321;">progn</span>
(<span style="color: #f47321;">defun</span> ,name (<span style="color: #83a525;">&amp;key</span> ,@arglist) ,@body)
(export ',name)
(<span style="color: #f47321;">define-node-macro</span> ,name
(<span style="color: #f47321;">define-visual-macro</span> ,name
(<span style="color: #db7093;">:super</span> phrase
<span style="color: #db7093;">:slots</span> ((orientation <span style="color: #db7093;">:initform</span> <span style="color: #db7093;">:vertical</span>))
<span style="color: #db7093;">:inputs</span> ,(command-inputs name arglist)))
......@@ -5089,7 +5090,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(<span style="color: #f47321;">when</span> font
(setf (slot-value label 'font) font)))))
(<span style="color: #f47321;">define-node-macro</span> shell
(<span style="color: #f47321;">define-visual-macro</span> shell
(<span style="color: #db7093;">:super</span> phrase
<span style="color: #db7093;">:slots</span>
((orientation <span style="color: #db7093;">:initform</span> <span style="color: #db7093;">:vertical</span>)
......@@ -5689,7 +5690,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(<span style="color: #f47321;">defmethod</span> <span style="color: #9370db;">layout</span> ((self frame-close-button))
(resize self 20 20))
(<span style="color: #f47321;">define-node-macro</span> titlebar
(<span style="color: #f47321;">define-visual-macro</span> titlebar
(<span style="color: #db7093;">:super</span> phrase
<span style="color: #db7093;">:slots</span> ((frozen <span style="color: #db7093;">:initform</span> t)
(orientation <span style="color: #db7093;">:initform</span> <span style="color: #db7093;">:horizontal</span>)
......@@ -5703,7 +5704,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(<span style="color: #f47321;">defmethod</span> <span style="color: #9370db;">set-title</span> ((self titlebar) title)
(set-value (input-node self <span style="color: #db7093;">:title</span>) title))
(<span style="color: #f47321;">define-node-macro</span> frame
(<span style="color: #f47321;">define-visual-macro</span> frame
(<span style="color: #db7093;">:super</span> phrase
<span style="color: #db7093;">:slots</span> ((frozen <span style="color: #db7093;">:initform</span> t)
(orientation <span style="color: #db7093;">:initform</span> <span style="color: #db7093;">:vertical</span>)
......@@ -5850,7 +5851,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
</div>
<div id="postamble" class="status">
<p class="author">Author: David O'Toole &lt;dto@xelf.me&gt;</p>
<p class="date">Created: 2017-04-12 Wed 11:01</p>
<p class="date">Created: 2017-04-12 Wed 12:16</p>
<p class="validation"><a href="http://validator.w3.org/check?uri=referer">Validate</a></p>
</div>
</body>
......
This diff is collapsed.
......@@ -4276,7 +4276,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(:key #'identity :test 'equal :validator #'identity)
(format nil "~S/~S objects" local global))
(define-node-macro modeline
(define-visual-macro modeline
(:super phrase
:slots
((orientation :initform :horizontal)
......@@ -4290,21 +4290,22 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(defmethod update ((self modeline))
(mapc #'pin (slot-value self 'inputs))
(set-value (input-node self :buffer-id) (or (slot-value (current-buffer) 'buffer-name) "*untitled-buffer*"))
(set-value (input-node self :objects) (modeline-database-string (hash-table-count (slot-value (current-buffer) 'objects))
(with-visual-slots (buffer-id objects position mode status) self
(set-value buffer-id (or (slot-value (current-buffer) 'buffer-name) "*untitled-buffer*"))
(set-value objects (modeline-database-string (hash-table-count (slot-value (current-buffer) 'objects))
(hash-table-count *database*)))
(set-value (input-node self :position)
(modeline-position-string
(slot-value (current-buffer) 'window-x)
(slot-value (current-buffer) 'window-y)))
(set-value (input-node self :mode)
(if (current-buffer)
(if (slot-value (current-buffer) 'paused)
"(paused)"
"(playing)")
"(empty)"))
(set-value (input-node self :status)
(or *modeline-status-string* " ")))
(set-value position
(modeline-position-string
(slot-value (current-buffer) 'window-x)
(slot-value (current-buffer) 'window-y)))
(set-value mode
(if (current-buffer)
(if (slot-value (current-buffer) 'paused)
"(paused)"
"(playing)")
"(empty)"))
(set-value status
(or *modeline-status-string* " "))))
(defmethod draw ((self modeline))
(with-slots (x y width height) self
......@@ -4379,7 +4380,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
`(progn
(defun ,name (&key ,@arglist) ,@body)
(export ',name)
(define-node-macro ,name
(define-visual-macro ,name
(:super phrase
:slots ((orientation :initform :vertical))
:inputs ,(command-inputs name arglist)))
......@@ -4407,7 +4408,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(when font
(setf (slot-value label 'font) font)))))
(define-node-macro shell
(define-visual-macro shell
(:super phrase
:slots
((orientation :initform :vertical)
......@@ -4975,7 +4976,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(defmethod layout ((self frame-close-button))
(resize self 20 20))
(define-node-macro titlebar
(define-visual-macro titlebar
(:super phrase
:slots ((frozen :initform t)
(orientation :initform :horizontal)
......@@ -4989,7 +4990,7 @@ hybrid GUI inspired by MIT Scratch and its derivatives.
(defmethod set-title ((self titlebar) title)
(set-value (input-node self :title) title))
(define-node-macro frame
(define-visual-macro frame
(:super phrase
:slots ((frozen :initform t)
(orientation :initform :vertical)
......
......@@ -78,7 +78,7 @@
(:key #'identity :test 'equal :validator #'identity)
(format nil "~S/~S objects" local global))
(define-node-macro modeline
(define-visual-macro modeline
(:super phrase
:slots
((orientation :initform :horizontal)
......@@ -92,21 +92,22 @@
(defmethod update ((self modeline))
(mapc #'pin (slot-value self 'inputs))
(set-value (input-node self :buffer-id) (or (slot-value (current-buffer) 'buffer-name) "*untitled-buffer*"))
(set-value (input-node self :objects) (modeline-database-string (hash-table-count (slot-value (current-buffer) 'objects))
(with-visual-slots (buffer-id objects position mode status) self
(set-value buffer-id (or (slot-value (current-buffer) 'buffer-name) "*untitled-buffer*"))
(set-value objects (modeline-database-string (hash-table-count (slot-value (current-buffer) 'objects))
(hash-table-count *database*)))
(set-value (input-node self :position)
(modeline-position-string
(slot-value (current-buffer) 'window-x)
(slot-value (current-buffer) 'window-y)))
(set-value (input-node self :mode)
(if (current-buffer)
(if (slot-value (current-buffer) 'paused)
"(paused)"
"(playing)")
"(empty)"))
(set-value (input-node self :status)
(or *modeline-status-string* " ")))
(set-value position
(modeline-position-string
(slot-value (current-buffer) 'window-x)
(slot-value (current-buffer) 'window-y)))
(set-value mode
(if (current-buffer)
(if (slot-value (current-buffer) 'paused)
"(paused)"
"(playing)")
"(empty)"))
(set-value status
(or *modeline-status-string* " "))))
(defmethod draw ((self modeline))
(with-slots (x y width height) self
......@@ -183,7 +184,7 @@
`(progn
(defun ,name (&key ,@arglist) ,@body)
(export ',name)
(define-node-macro ,name
(define-visual-macro ,name
(:super phrase
:slots ((orientation :initform :vertical))
:inputs ,(command-inputs name arglist)))
......@@ -211,7 +212,7 @@
(when font
(setf (slot-value label 'font) font)))))
(define-node-macro shell
(define-visual-macro shell
(:super phrase
:slots
((orientation :initform :vertical)
......
* Task list
** TODO clean up how node macro VSlots work
*** TODO rename to define-visual-macro and with-visual-slots and define nice accessors
** TODO make each buffer have its own command-history?
** TODO [#A] button class
** TODO [#A] checkbox
** TODO [#A] radio buttons
......
......@@ -5572,11 +5572,6 @@ Returns a newly allocated list."
(setf parent nil)))))
(defmethod child-updated ((self node) child))
(defun input-node (object input-name)
(nth (position input-name
(slot-value object 'input-names))
(slot-value object 'inputs)))
;; Semantic node trees:1 ends here
;; TODO Read-only status
......@@ -5596,7 +5591,7 @@ Returns a newly allocated list."
;; [[file:~/xelf/xelf.org::*Node%20macros][Node macros:1]]
(defmacro define-node-macro (name
(defmacro define-visual-macro (name
(&key (super 'node) slots documentation inputs)
&body body)
"Define a new block called NAME according to the given options.
......@@ -5643,6 +5638,30 @@ Returns a newly allocated list."
(mapc #'pin (slot-value self 'inputs))
,@body)
(defmethod recompile ((self ,name)) (evaluate self)))))
(defun input-node (object input-name)
(nth (position input-name
(slot-value object 'input-names))
(slot-value object 'inputs)))
(defun (setf input-node) (new-value object input-name)
(setf (nth (position input-name
(slot-value object 'input-names))
(slot-value object 'inputs))
new-value))
(defmacro with-visual-slots (slots object &body body)
(let ((slot-names (mapcar #'make-keyword slots))
(slot-symbols slots)
(clauses nil)
(ob (gensym)))
(loop while slot-names do
(push `(,(pop slot-symbols) (input-node ,ob ,(pop slot-names)))
clauses))
`(let ((,ob ,object))
(symbol-macrolet ,clauses ,@body))))
;; (xelf::with-visual-slots (a b c) object (list a b c) (setf a b))
;; Node macros:1 ends here
;; Categorizing nodes with "tags"
......
......@@ -5555,11 +5555,6 @@ in the future.
(setf parent nil)))))
(defmethod child-updated ((self node) child))
(defun input-node (object input-name)
(nth (position input-name
(slot-value object 'input-names))
(slot-value object 'inputs)))
#+end_src
** TODO Read-only status
......@@ -5577,7 +5572,7 @@ in the future.
** TODO Node macros
#+begin_src lisp
(defmacro define-node-macro (name
(defmacro define-visual-macro (name
(&key (super 'node) slots documentation inputs)
&body body)
"Define a new block called NAME according to the given options.
......@@ -5624,6 +5619,30 @@ in the future.
(mapc #'pin (slot-value self 'inputs))
,@body)
(defmethod recompile ((self ,name)) (evaluate self)))))
(defun input-node (object input-name)
(nth (position input-name
(slot-value object 'input-names))
(slot-value object 'inputs)))
(defun (setf input-node) (new-value object input-name)
(setf (nth (position input-name
(slot-value object 'input-names))
(slot-value object 'inputs))
new-value))
(defmacro with-visual-slots (slots object &body body)
(let ((slot-names (mapcar #'make-keyword slots))
(slot-symbols slots)
(clauses nil)
(ob (gensym)))
(loop while slot-names do
(push `(,(pop slot-symbols) (input-node ,ob ,(pop slot-names)))
clauses))
`(let ((,ob ,object))
(symbol-macrolet ,clauses ,@body))))
;; (xelf::with-visual-slots (a b c) object (list a b c) (setf a b))
#+end_src
** Categorizing nodes with "tags"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment