(defstruct line points) (defstruct circle radius centre) (defstruct polygon points) (defun line (start-x start-y end-x end-y) (list (make-line :points (vector start-x start-y end-x end-y)))) (defun circle (radius centre-x centre-y) (list (make-circle :radius radius :centre (vector centre-x centre-y)))) (defun rectangle (left-x bottom-y width height) (let ((right-x (+ left-x width)) (top-y (+ bottom-y height))) (list (make-polygon :points (vector left-x bottom-y left-x top-y right-x top-y right-x bottom-y))))) (defun centre-rectangle (centre-x centre-y width height) (let ((left-x (- centre-x (/ width 2))) (bottom-y (- centre-y (/ height 2)))) (rectangle left-x bottom-y width height))) (defun translate (delta-x delta-y drawing) (defun translate-points (points) (let ((new-points (copy-seq points))) (do ((i 0 (+ i 2))) ((>= i (length points))) (incf (aref new-points i) delta-x) (incf (aref new-points (1+ i)) delta-y)) new-points)) (defun translate-primitive (primitive) (typecase primitive (line (make-line :points (translate-points (line-points primitive)))) (circle (make-circle :radius (circle-radius primitive) :centre (translate-points (circle-centre primitive)))) (polygon (make-polygon :points (translate-points (polygon-points primitive)))))) (mapcar #'translate-primitive drawing)) (defun scale (scale-factor drawing) (defun scale-points (points) (let ((new-points (copy-seq points))) (dotimes (i (length points)) (setf (aref new-points i) (* scale-factor (aref new-points i)))) new-points)) (defun scale-primitive (primitive) (typecase primitive (line (make-line :points (scale-points (line-points primitive)))) (circle (make-circle :radius (* scale-factor (circle-radius primitive)) :centre (scale-points (circle-centre primitive)))) (polygon (make-polygon :points (scale-points (polygon-points primitive)))))) (mapcar #'scale-primitive drawing)) (defun overlay (&rest drawings) (apply #'append drawings))