Bugscript drawing library in Common Lisp
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

80 lines
2.6 KiB

;;;; canvas.lisp
(in-package #:bugscript)
;;; The artist
(defclass bugscript-artist ()
((cursor :accessor cursor :initarg :cursor)
(height :accessor height :initarg :height)
(stroke :accessor stroke :initarg :stroke)
(margin :accessor margin :initarg :margin)
(elements :accessor elements :initform ())
(outfile :accessor outfile))
:height 80
:cursor 0
:margin 20
:stroke 3))
(defgeneric advance-cursor (artist value)
(:method ((artist bugscript-artist) (value number))
(incf (cursor artist) value)))
(defmethod initialize-instance :after ((artist bugscript-artist)
&key output-filename &allow-other-keys)
(advance-cursor artist (margin artist))
(setf (outfile artist) (make-pathname :name output-filename :type "svg"
:defaults *here*)))
(defgeneric u-size (artist frac)
(:method ((artist bugscript-artist) (frac number))
(* (height artist) frac)))
;;; Adding content
(defgeneric width (object))
(defgeneric fiduciary-width (artist)
(:method ((artist bugscript-artist))
(reduce #'+ (elements artist) :key #'width)))
(defgeneric total-height (artist)
(:method ((artist bugscript-artist))
(u-size artist 6)))
(defgeneric centreline (artist)
(:method ((artist bugscript-artist))
(/ (total-height artist) 2)))
;;; Finishing up
(defgeneric draw (scene artist shape)
(:documentation "The complete drawing code, complete with cursor movements."))
(defgeneric draw-on-artist (element props shape)
(:documentation "Draw SHAPE on ELEMENT with PROPS.
This should not move the cursor in response to general spacing."))
(defgeneric pre-movement (artist figure))
(defgeneric post-movement (artist figure))
(defun create-body-group (scene &optional (transform-string ""))
(when scene
(svg:make-group scene (:id (symbol-name (gensym "PHONEME"))
:transform transform-string))))
(defun make-bodies (artist &rest bodies)
BODIES create the list of bodies, in order. Each body is of the form:
\((body-class &rest body-initargs)
(accessories &rest accessory-initargs) ...\),
where the latter can be repeated for as many times as needed.
A raw symbol may be substituted for each of the inner lists
if no initargs are needed."
(dolist (bodydef bodies)
(destructuring-bind (body &rest accessories) bodydef
(let ((b (apply #'make-instance (alexandria:ensure-list body))))
(dolist (i accessories)
(register-accessory b (apply #'make-instance
(alexandria:ensure-list i))))
(register-body artist b)))))