diff --git a/drawing.lisp b/drawing.lisp
index 1b71a5d..42349fd 100644
--- a/drawing.lisp
+++ b/drawing.lisp
@@ -22,44 +22,44 @@
         (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))
+(defmacro define-transform (name (&rest params)
+                            &key x-transform y-transform scalar-transform)
+  `(defun ,name (,@params drawing)
+     (labels ((transform-points (points)
+                (let ((new-points (copy-seq points)))
+                  (do ((i 0 (+ i 2)))
+                      ((>= i (length points)))
+                    (let ((x (aref new-points i))
+                          (y (aref new-points (1+ i))))
+                      (setf (aref new-points i) ,x-transform)
+                      (setf (aref new-points (1+ i)) ,y-transform)))
+                  new-points))
+              (transform-primitive (primitive)
+                (typecase primitive
+                  (line
+                   (make-line
+                    :points (transform-points (line-points primitive))))
+                  (circle
+                   (make-circle
+                    :radius ,(if scalar-transform
+                                 `(let ((s (circle-radius primitive)))
+                                    ,scalar-transform)
+                                 '(circle-radius primitive))
+                    :centre (transform-points (circle-centre primitive))))
+                  (polygon
+                   (make-polygon
+                    :points (transform-points
+                             (polygon-points primitive)))))))
+       (mapcar #'transform-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))
+(define-transform translate (delta-x delta-y)
+                  :x-transform (+ delta-x x)
+                  :y-transform (+ delta-y y))
+
+(define-transform scale (scale-factor)
+                  :x-transform (* scale-factor x)
+                  :y-transform (* scale-factor y)
+                  :scalar-transform (* scale-factor s))
 
 (defun overlay (&rest drawings)
   (apply #'append drawings))