;;; Generates Sierpinski carpets by recursively replacing tiles with 
;;; squares of 8 tiles surrounding an empty spot.  Each tile is 
;;; represented by a 2-element list of numbers indicating the 
;;; coordinates of the tile's location. (x y)
;;; Outputs SVG data on stdout.
;;; 
;;; D. Racine, 2006-04-03

(defun re-tile (location)
  "Replaces a tile sitting at location (x y) with a square of 8 tiles
  surrounding an empty square, returned as a list of 8 locations."
  (let* ((xa (* 3 (first location)))
	 (xb (1+ xa))
	 (xc (1+ xb))
	 (ya (* 3 (second location)))
	 (yb (1+ ya))
	 (yc (1+ yb)))
    (list (list xa ya) (list xa yb) (list xa yc) (list xb ya)
	  (list xb yc) (list xc ya) (list xc yb) (list xc yc))))


(defun carpet (n list-of-locations)
  "Returns a list of tile locations comprising the nth generation carpet."
  (cond ((= n 1) (mapcan #'re-tile list-of-locations))
	(t (carpet (1- n) (mapcan #'re-tile list-of-locations)))))


(defun svgcarpet (n xpixels ypixels &optional s)
  "Prints an SVG rendition of an nth-generation carpet on stdout."
  (let ((carpet (carpet n '((0 0))))
        (side (expt 3 n)))
    ;; Spew forth an ugly SVG header:
    (format (or s 't) "~&<?xml version=\"1.0\" standalone=\"no\"?>~%")
    (format (or s 't) "~&<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\" 
            \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">~%")
    (format (or s 't) "<svg width=\"~Dpx\" height=\"~Dpx\" 
            viewBox=\"0 0 ~D ~D\" preserveAspectRatio=\"none\" 
            xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\">~%" 
            xpixels ypixels side side)
    ;; Draw the background:
    (format (or s 't) "~&<rect x=\"0\" y=\"0\" width=\"~D\" height=\"~D\" fill=\"tan\"/>~%"
            side side)
    ;; Draw the tiles:
    (dolist (i carpet)
      (format (or s 't) "~&<rect x=\"~D\" y=\"~D\" width=\"1\" height=\"1\" fill=\"black\"/>~%"
              (first i) (second i)))
    ;; End the SVG document:
    (format (or s 't) "~&</svg>~%")))