;;
;; svg-generator.el
;;
;; Automagically generates random SVG files
;;
;; Warning: tested only with XEmacs
:;
;; Usage sample:
;;    xemacs -vanilla -batch -l svg-generator.el -eval "(svg-generate-file 10 \"output.svg\")"
;; Where:
;;    10	   is the random seed
;;    output.svg   is the output file
;;
;; ----------------------------------------------------------------------------
;; "THE BEER-WARE LICENSE" (Revision 42.1):
;; <sandro@sigala.it> wrote this file. As long as you retain this notice you
;; can do whatever you want with this stuff. If we meet some day, and you think
;; this stuff is worth it, you can buy me a beer in return -- Sandro Sigala
;; ----------------------------------------------------------------------------
;;

(require 'string)

(defconst svg-header
  "<?xml version=\"1.0\" standalone=\"no\"?>
<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"
  \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\">
<svg width=\"10cm\" height=\"15cm\" viewBox=\"0 0 1000 1500\"
     xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\">
<!-- generated by svg-generator.el with random seed %d -->
<g transform=\"scale(.75, .75) translate(100, 200)\">
")

(defconst svg-footer
  "</g>
</svg>
")

(defconst svg-colours
  '("aqua" "black" "blue" "fuchsia" "gray" "green" "lime" "maroon"
    "navy" "olive" "purple" "red" "silver" "teal" "white" "yellow"))

(defun svg-random-colour (state)
  (nth (random* (1- (length svg-colours))) svg-colours)
)

;;; XXX broken
(defun svg-random-transformation (state)
  (let ((n (random* 5)) (transform ""))
    (while (< n 5)
      (let* ((q (random* 3 state))
	     (x (random* 50 state))
	     (y (random* 50 state))
	     (xf (* x 0.01))
	     (yf (* y 0.01))
	     (a (random* 360 state)))
	(cond
	 ((= q 0) (setq transform (concat transform (format " translate(%d, %d)" x y))))
	 ((= q 1) (setq transform (concat transform (format " scale(%.3f, %.3f)" xf yf))))
	 ((= q 2) (setq transform (concat transform (format " rotate(%d)" a))))
	 )
	(setq n (1+ n))
	)
      )
    (if (> (length transform) 0)
	"" ;;; (concat " transform=\"" transform "\"")
      ""
      )
    )
  )

(defun svg-indent-string (s depth)
  (string-replace-match "@" s (make-string (* depth 2) ?\ ) t t))

(defconst svg-circle
  "@<circle cx=\"%d\" cy=\"%d\" r=\"%d\"
   @      style=\"fill:%s;stroke:%s;stroke-width:%d;opacity:%.2f\"%s />
")

(defun svg-output-circle (depth state)
  (let* ((cx (random* 800 state))
	 (cy (random* 1300 state))
	 (r (random* 200 state))
	 (fill (svg-random-colour state))
	 (stroke (svg-random-colour state))
	 (stroke-width (1+ (random* 4 state)))
	 (opacity (* (1+ (random* 100 state)) 0.01))
	 (transform (svg-random-transformation state))
	 (s (format svg-circle cx cy r fill stroke stroke-width opacity transform))
	 )
    (insert (svg-indent-string s depth))
    )
  )

(defconst svg-ellipse
  "@<ellipse cx=\"%d\" cy=\"%d\" rx=\"%d\" ry=\"%d\"
   @         style=\"fill:%s;stroke:%s;stroke-width:%d;opacity:%.2f\"%s />
")

(defun svg-output-ellipse (depth state)
  (let* ((cx (random* 800 state))
	 (cy (random* 1300 state))
	 (rx (random* 200 state))
	 (ry (random* 200 state))
	 (fill (svg-random-colour state))
	 (stroke (svg-random-colour state))
	 (stroke-width (1+ (random* 4 state)))
	 (opacity (* (1+ (random* 100 state)) 0.01))
	 (transform (svg-random-transformation state))
	 (s (format svg-ellipse cx cy rx ry fill stroke stroke-width opacity transform))
	 )
    (insert (svg-indent-string s depth))
    )
  )

(defconst svg-rect
  "@<rect x=\"%d\" y=\"%d\" width=\"%d\" height=\"%d\"
   @      style=\"fill:%s;stroke:%s;stroke-width:%d;opacity:%.2f\"%s />
")

(defun svg-output-rect (depth state)
  (let* ((x (random* 800 state))
	 (y (random* 1300 state))
	 (width (random* 500 state))
	 (height (random* 500 state))
	 (fill (svg-random-colour state))
	 (stroke (svg-random-colour state))
	 (stroke-width (1+ (random* 4 state)))
	 (opacity (* (1+ (random* 100 state)) 0.01))
	 (transform (svg-random-transformation state))
	 (s (format svg-rect x y width height fill stroke stroke-width opacity transform))
	 )
    (insert (svg-indent-string s depth))
    )
  )

(defconst svg-group-header
  "@<g>
")
(defconst svg-group-footer
  "@</g>
")

(defconst svg-generators
  '(svg-output-circle svg-output-ellipse svg-output-rect svg-output-group))

(defun svg-output-group (depth state)
  (if (< depth 5)
  (let ((i 0))
    (insert (svg-indent-string svg-group-header depth))
    (while (< i 7)
      (let ((gen (random* (length svg-generators) state)))
	(funcall (nth gen svg-generators) (1+ depth) state))
      (setq i (1+ i))
      )
    (insert (svg-indent-string svg-group-footer depth))
    )
  )
)

(defun svg-generator (n)
  (interactive "nSeed: ")
  (let ((state (make-random-state n)))
    (insert (format svg-header n))
    (svg-output-group 1 state)
    (insert svg-footer)
    )
  )

(defun svg-generate-file (n filename)
  (find-file filename)
  (erase-buffer)
  (svg-generator n)
  (save-buffer)
  (kill-buffer nil))
