fwd.lisp

(defparameter *white-colour* #\O)

(defun make-image (m n) 
  (make-array (list m n) :initial-element *white-colour*))

(defun clear (image)
  (loop for i from 0 below (reduce #'* (array-dimensions image)) do
    (setf (row-major-aref image i) *white-colour*)))

(defun colour-pixel (image x y c)
  (setf (aref image x y) c))

(defun draw-vertical-segment (image x y1 y2 c)
  (loop for y from y1 to y2 do
    (colour-pixel image x y c)))

(defun draw-horizontal-segment (image x1 x2 y c)
  (loop for x from x1 to x2 do
    (colour-pixel image x y c)))

(defun fill-region (image x y c)
  (unless (>= (1+ x) (elt (array-dimensions image) 0))
    (when (char= (aref image (1+ x) y)
		 (aref image x y))
      (fill-region image (1+ x) y c)))
  (unless (<= (1- x) (elt (array-dimensions image) 0))
    (when (char= (aref image (1- x) y)
		 (aref image x y))
      (fill-region image (1- x) y c)))
  (unless (>= (1+ y) (elt (array-dimensions image) 1))
    (when (char= (aref image x (1+ y))
		 (aref image x y))
      (fill-region image x (1+ y) c)))
  (unless (<= (1- y) (elt (array-dimensions image) 1))
    (when (char= (aref image x (1- y))
		 (aref image x y))
      (fill-region image x (1- y) c)))
  (colour-pixel image x y c))