diff --git a/README.org b/README.org index c89ca10..189247e 100644 --- a/README.org +++ b/README.org @@ -549,6 +549,48 @@ 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. + +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 () ()) + (defmethod draw :before ((instance black-background) &key &allow-other-keys) + (background +black+)) +#+END_SRC + +Then add the =:mixins= option to your =defsketch= bindings: + +#+BEGIN_SRC lisp + (defsketch moon + ((:mixins black-background)) + (width 200) + (height 200)) + (circle 100 100 50)) +#+END_SRC + +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) + (format t "Initializing black background!")) + (defmethod setup :before ((instance black-background) &key &allow-other-keys) + (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 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)) + (with-font (make-font :color +white+) + (text (format nil "Hi ~a!" (sketch-slot-value 'name)) 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 e6dfd00..ab39a64 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -16,6 +16,7 @@ :defsketch + :sketch-slot-value :sketch-title :sketch-width :sketch-height diff --git a/src/sketch.lisp b/src/sketch.lisp index d18472a..5747fd1 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) @@ -309,10 +309,36 @@ collect (binding-name b))))) (defmacro defsketch (sketch-name binding-forms &body body) + (multiple-value-bind (options binding-forms) + (extract-options binding-forms) + (make-defsketch sketch-name + (getf options :mixins) + 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 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 (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)