@@ -71,3 +71,37 @@
|
71 | 71 | do (setf (aref bitmap y 0) t |
72 | 72 | (aref bitmap y (1- width)) t)))) |
73 | 73 | |
| 74 | +;;; Described in |
| 75 | +;;; Computer Graphics - Principles and Practice by Donald Hearn and M. Pauline Baker |
| 76 | + |
| 77 | +(defun draw-circle (bitmap x-center y-center radius) |
| 78 | + (labels ((pixel (x y) (set-pixel bitmap (+ x-center x) (+ y-center y))) |
| 79 | + (draw-points (x y) |
| 80 | + (pixel x y) |
| 81 | + (pixel (- x) y) |
| 82 | + (pixel x (- y)) |
| 83 | + (pixel (- x) (- y)) |
| 84 | + (pixel y x) |
| 85 | + (pixel (- y) x) |
| 86 | + (pixel y (- x)) |
| 87 | + (pixel (- y) (- x)))) |
| 88 | + (loop with x = 0 |
| 89 | + with y = radius |
| 90 | + with p = (- 1 radius) |
| 91 | + initially (draw-points x y) |
| 92 | + while (< x y) |
| 93 | +do (incf x) |
| 94 | + (if (< p 0) |
| 95 | + (incf p (+ (* 2 x) 1)) |
| 96 | + (progn |
| 97 | + (decf y) |
| 98 | + (incf p (+ (* 2 (- x y)) 1)))) |
| 99 | + (draw-points x y)))) |
| 100 | + |
| 101 | +(defun bullseye (&optional (size 64) (step 4)) |
| 102 | +"Draw a bullseye." |
| 103 | + (let ((bitmap (make-bitmap size size)) |
| 104 | + (mid (floor size 2))) |
| 105 | + (loop for radius from 2 to mid by step |
| 106 | +do (draw-circle bitmap mid mid radius)) |
| 107 | + (draw bitmap))) |