Adds a new macro, defsketchx, for adding additional superclasses.

Author: Kevinpgalligan

src/package.lisp

@@ -15,6 +15,7 @@
            :draw
 
            :defsketch
+           :defsketchx
 
            :sketch-title
            :sketch-width

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)