From 32f692675ed8654a3baee1d9368b653e798dbce9 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Sat, 27 Jan 2024 14:23:09 +0000 Subject: [PATCH 1/6] Adds a new macro, defsketchx, for adding additional superclasses. --- src/package.lisp | 1 + src/sketch.lisp | 12 +++++++++--- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/package.lisp b/src/package.lisp index e6dfd00..a46cd02 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -15,6 +15,7 @@ :draw :defsketch + :defsketchx :sketch-title :sketch-width diff --git a/src/sketch.lisp b/src/sketch.lisp index d18472a..43d0690 100644 --- a/src/sketch.lisp +++ b/src/sketch.lisp @@ -269,8 +269,8 @@ ;;; DEFSKETCH macro -(defun define-sketch-defclass (name bindings) - `(defclass ,name (sketch) +(defun define-sketch-defclass (name superclasses bindings) + `(defclass ,name (sketch ,@superclasses) (,@(loop for b in bindings unless (eq 'sketch (binding-prefix b)) collect `(,(binding-name b) @@ -308,11 +308,17 @@ collect `(,(binding-accessor b) *sketch*) collect (binding-name b))))) +(defmacro defsketchx (sketch-name superclasses binding-forms &body body) + (make-defsketch sketch-name superclasses binding-forms body)) + (defmacro defsketch (sketch-name binding-forms &body body) + (make-defsketch sketch-name (list) binding-forms body)) + +(defun make-defsketch (sketch-name superclasses binding-forms body) (let ((bindings (parse-bindings sketch-name binding-forms (class-bindings (find-class 'sketch))))) `(progn - ,(define-sketch-defclass sketch-name bindings) + ,(define-sketch-defclass sketch-name superclasses bindings) ,@(define-sketch-channel-observers bindings) ,(define-sketch-prepare-method sketch-name bindings) ,(define-sketch-draw-method sketch-name bindings body) From 54c554d77220d0d323798042e1ca23fcb153e11c Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Sat, 27 Jan 2024 14:48:11 +0000 Subject: [PATCH 2/6] Readme. --- README.org | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/README.org b/README.org index c89ca10..3215486 100644 --- a/README.org +++ b/README.org @@ -549,6 +549,35 @@ This can be used, for example, to draw a static sketch and then disable the draw Example: [[https://github.com/vydd/sketch/blob/master/examples/control-flow.lisp][control-flow.lisp]]. +*** Sharing behaviour between sketches +Let's say you want all your sketches to have a black background, but you don't want to have to reimplement that feature every time. The answer is to use `defsketchx`, which is like `defsketch` but allows you to specify extra superclasses for your sketch class. + +First, define a mixin class that implements the desired behaviour in the `draw` method (with the `:before` method specialiser): + +#+BEGIN_SRC lisp + (defclass black-background () ()) + (defmethod draw :before ((instance black-background) &key &allow-other-keys) + (background +black+)) +#+END_SRC + +Then define your sketches using `defsketchx`: + +#+BEGIN_SRC lisp + (defsketchx moon (black-background) + ((width 200) + (height 200)) + (circle 100 100 50)) +#+END_SRC + +And it should have a black background. Initialization/setup logic for `black-background`, and sketches inheriting from it, could be put in an `initialize-instance` or `setup` method: + +#+BEGIN_SRC lisp + (defmethod initialize-instance :before ((instance black-background) &key &allow-other-keys) + (format t "Initializing black background!")) + (defmethod setup :before ((instance black-background) &key &allow-other-keys) + (format t "Setting up black background!")) +#+END_SRC + ** Made with Sketch - [[https://vydd.itch.io/qelt][QELT]] - [[https://github.com/sjl/coding-math][sjl's implementation of coding math videos]] From f57a6588d475c74be56b1e3de7ff997466d078b7 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Sun, 28 Jan 2024 16:16:11 +0000 Subject: [PATCH 3/6] Change the syntax so that options go in the bindings form. --- src/sketch.lisp | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/src/sketch.lisp b/src/sketch.lisp index 43d0690..6c8acb0 100644 --- a/src/sketch.lisp +++ b/src/sketch.lisp @@ -308,11 +308,22 @@ collect `(,(binding-accessor b) *sketch*) collect (binding-name b))))) -(defmacro defsketchx (sketch-name superclasses binding-forms &body body) - (make-defsketch sketch-name superclasses binding-forms body)) - (defmacro defsketch (sketch-name binding-forms &body body) - (make-defsketch sketch-name (list) binding-forms body)) + (multiple-value-bind (options binding-forms) + (extract-options binding-forms) + (make-defsketch sketch-name + (getf options :mixins) + binding-forms + body))) + +(defun extract-options (binding-forms) + (let (options) + (loop while (and binding-forms (keywordp (caar binding-forms))) + do (progn + (push (cadar binding-forms) options) + (push (caar binding-forms) options) + (pop binding-forms))) + (values options binding-forms))) (defun make-defsketch (sketch-name superclasses binding-forms body) (let ((bindings (parse-bindings sketch-name binding-forms From 4813688d74e92e6e57d59417ed15de0d79e8c786 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Sun, 28 Jan 2024 17:12:14 +0000 Subject: [PATCH 4/6] Update documentation and export *sketch* symbol for accessing state. --- README.org | 20 +++++++++++++++----- src/package.lisp | 3 ++- src/sketch.lisp | 4 ++++ 3 files changed, 21 insertions(+), 6 deletions(-) diff --git a/README.org b/README.org index 3215486..28c58b6 100644 --- a/README.org +++ b/README.org @@ -550,9 +550,9 @@ This can be used, for example, to draw a static sketch and then disable the draw Example: [[https://github.com/vydd/sketch/blob/master/examples/control-flow.lisp][control-flow.lisp]]. *** Sharing behaviour between sketches -Let's say you want all your sketches to have a black background, but you don't want to have to reimplement that feature every time. The answer is to use `defsketchx`, which is like `defsketch` but allows you to specify extra superclasses for your sketch class. +Let's say you want all your sketches to have a black background, but you don't want to have to reimplement that feature every time. The answer is to implement the feature in a class, and then pass the name of that class to `defsketch` through the `:mixins` option. -First, define a mixin class that implements the desired behaviour in the `draw` method (with the `:before` method specialiser): +First, define a mixin class that implements the desired behaviour in the `draw` method (with the `:before` method specialiser, so that it doesn't override the behaviour of your sketches): #+BEGIN_SRC lisp (defclass black-background () ()) @@ -560,11 +560,12 @@ First, define a mixin class that implements the desired behaviour in the `draw` (background +black+)) #+END_SRC -Then define your sketches using `defsketchx`: +Then add the `:mixins` option to your `defsketch` bindings: #+BEGIN_SRC lisp - (defsketchx moon (black-background) - ((width 200) + (defsketch moon + ((:mixins (black-background)) + (width 200) (height 200)) (circle 100 100 50)) #+END_SRC @@ -578,6 +579,15 @@ And it should have a black background. Initialization/setup logic for `black-bac (format t "Setting up black background!")) #+END_SRC +If the mixin class has state that you need to access in the body of your sketch, then you can access it through `*sketch*`, which is bound to the currently active sketch. Example: + +#+BEGIN_SRC lisp + (defclass mixin-with-state () ((name :initform "Ruth" :reader name))) + (defsketch slot-example + ((:mixins (mixin-with-state black-background))) + (text (format nil "Hi ~a!" (name *sketch*)) 100 100)) +#+END_SRC + ** Made with Sketch - [[https://vydd.itch.io/qelt][QELT]] - [[https://github.com/sjl/coding-math][sjl's implementation of coding math videos]] diff --git a/src/package.lisp b/src/package.lisp index a46cd02..a24b5ad 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -15,8 +15,9 @@ :draw :defsketch - :defsketchx + :*sketch* + :sketch-slot-value :sketch-title :sketch-width :sketch-height diff --git a/src/sketch.lisp b/src/sketch.lisp index 6c8acb0..f62666f 100644 --- a/src/sketch.lisp +++ b/src/sketch.lisp @@ -337,6 +337,10 @@ (make-instances-obsolete ',sketch-name) (find-class ',sketch-name)))) +(defmacro sketch-slot-value (slot-name) + "For accessing the slots of a sketch wherever *sketch* is bound." + `(slot-value *sketch* ,slot-name)) + ;;; Control flow (defun stop-loop () From c92d6a5abd307c51fe7cd9f2f4d410c0f935b823 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Sun, 28 Jan 2024 17:16:13 +0000 Subject: [PATCH 5/6] Remove accidentally-included macro, fix example in docs. --- README.org | 3 ++- src/sketch.lisp | 4 ---- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/README.org b/README.org index 28c58b6..9d24f9a 100644 --- a/README.org +++ b/README.org @@ -585,7 +585,8 @@ If the mixin class has state that you need to access in the body of your sketch, (defclass mixin-with-state () ((name :initform "Ruth" :reader name))) (defsketch slot-example ((:mixins (mixin-with-state black-background))) - (text (format nil "Hi ~a!" (name *sketch*)) 100 100)) + (with-font (make-font :color +white+) + (text (format nil "Hi ~a!" (name *sketch*)) 100 100))) #+END_SRC ** Made with Sketch diff --git a/src/sketch.lisp b/src/sketch.lisp index f62666f..6c8acb0 100644 --- a/src/sketch.lisp +++ b/src/sketch.lisp @@ -337,10 +337,6 @@ (make-instances-obsolete ',sketch-name) (find-class ',sketch-name)))) -(defmacro sketch-slot-value (slot-name) - "For accessing the slots of a sketch wherever *sketch* is bound." - `(slot-value *sketch* ,slot-name)) - ;;; Control flow (defun stop-loop () From 22cd7c53a0f8df08a0621879ef8e248c0201d8f1 Mon Sep 17 00:00:00 2001 From: Kevin Galligan Date: Thu, 31 Oct 2024 18:24:57 +0000 Subject: [PATCH 6/6] Change mixins interface, and introduce (sketch-slot-value). As suggested by Gleefre, the :mixins binding form now looks like (:mixins m1 m2) instead of (:mixins (m1 m2)), 'cause it looks neater. Also, it can appear anywhere in the list of binding forms, not just at the start. (sketch-slot-value 'slot-name) can be used to access slots that are introduced by the mixin. Previously, I'd exported *sketch* so that users could do (slot-value *sketch* 'slot-name), but that seems to expose too much implementation detail. --- README.org | 18 ++++++++++-------- src/package.lisp | 1 - src/sketch.lisp | 21 +++++++++++++++------ 3 files changed, 25 insertions(+), 15 deletions(-) diff --git a/README.org b/README.org index 9d24f9a..189247e 100644 --- a/README.org +++ b/README.org @@ -550,9 +550,9 @@ This can be used, for example, to draw a static sketch and then disable the draw Example: [[https://github.com/vydd/sketch/blob/master/examples/control-flow.lisp][control-flow.lisp]]. *** Sharing behaviour between sketches -Let's say you want all your sketches to have a black background, but you don't want to have to reimplement that feature every time. The answer is to implement the feature in a class, and then pass the name of that class to `defsketch` through the `:mixins` option. +Let's say you want all your sketches to have a black background, but you don't want to have to reimplement that feature every time. The answer is to implement the feature in a class, and then pass the name of that class to =defsketch= through the =:mixins= option. -First, define a mixin class that implements the desired behaviour in the `draw` method (with the `:before` method specialiser, so that it doesn't override the behaviour of your sketches): +First, define a mixin class that implements the desired behaviour in the =draw= method (with the =:before= method specialiser, so that it doesn't override the behaviour of your sketches): #+BEGIN_SRC lisp (defclass black-background () ()) @@ -560,17 +560,17 @@ First, define a mixin class that implements the desired behaviour in the `draw` (background +black+)) #+END_SRC -Then add the `:mixins` option to your `defsketch` bindings: +Then add the =:mixins= option to your =defsketch= bindings: #+BEGIN_SRC lisp (defsketch moon - ((:mixins (black-background)) + ((:mixins black-background)) (width 200) (height 200)) (circle 100 100 50)) #+END_SRC -And it should have a black background. Initialization/setup logic for `black-background`, and sketches inheriting from it, could be put in an `initialize-instance` or `setup` method: +The resulting sketch should have a black background. Initialization/setup logic for =black-background=, and sketches inheriting from it, could be put in an =initialize-instance= or =setup= method: #+BEGIN_SRC lisp (defmethod initialize-instance :before ((instance black-background) &key &allow-other-keys) @@ -579,14 +579,16 @@ And it should have a black background. Initialization/setup logic for `black-bac (format t "Setting up black background!")) #+END_SRC -If the mixin class has state that you need to access in the body of your sketch, then you can access it through `*sketch*`, which is bound to the currently active sketch. Example: +If the mixin class has state that you need to access in the body of your sketch, then use =(sketch-slot-value 'slot-name)=. + +Example: #+BEGIN_SRC lisp (defclass mixin-with-state () ((name :initform "Ruth" :reader name))) (defsketch slot-example - ((:mixins (mixin-with-state black-background))) + ((:mixins mixin-with-state black-background)) (with-font (make-font :color +white+) - (text (format nil "Hi ~a!" (name *sketch*)) 100 100))) + (text (format nil "Hi ~a!" (sketch-slot-value 'name)) 100 100))) #+END_SRC ** Made with Sketch diff --git a/src/package.lisp b/src/package.lisp index a24b5ad..ab39a64 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -15,7 +15,6 @@ :draw :defsketch - :*sketch* :sketch-slot-value :sketch-title diff --git a/src/sketch.lisp b/src/sketch.lisp index 6c8acb0..5747fd1 100644 --- a/src/sketch.lisp +++ b/src/sketch.lisp @@ -316,14 +316,23 @@ binding-forms body))) +(defun sketch-slot-value (slot-sym) + (slot-value *sketch* slot-sym)) + +;;; To be able to set the slots of the currently bound sketch +;;; class without needing a reference to it. +(defun (setf sketch-slot-value) (val slot-sym) + (setf (slot-value *sketch* slot-sym) val)) + (defun extract-options (binding-forms) (let (options) - (loop while (and binding-forms (keywordp (caar binding-forms))) - do (progn - (push (cadar binding-forms) options) - (push (caar binding-forms) options) - (pop binding-forms))) - (values options binding-forms))) + (loop for form in binding-forms + if (keywordp (car form)) + do (progn + (push (cdr form) options) + (push (car form) options)) + else collect form into the-rest + finally (return (values options the-rest))))) (defun make-defsketch (sketch-name superclasses binding-forms body) (let ((bindings (parse-bindings sketch-name binding-forms