#!/usr/local/bin/emacs -script

(defun jw-trees ()
  "Draws some trees."
  (interactive)
  (defun jw-coords-insert (str x y)
    (when (and (<= x xmax) (<= y ymax)
               (> x 0) (> y 0))
      (let ((p (+ x (- y 1) (* xmax (- y 1)))))
        (goto-char p)
        (delete-char 1)
        (insert str))))
  (defface jw-tree-leaves '((t ())) "tree leaves" :group 'jw-trees)
  (face-spec-set
   'jw-tree-leaves '((t (:foreground "green"))))
  (set-face-bold 'jw-tree-leaves t)
  (defface jw-tree-dirt '((t ())) "tree dirt" :group 'jw-trees)
  (face-spec-set
   'jw-tree-dirt '((t (:foreground "DarkSeaGreen4"))))  
  (defface jw-tree-trunks '((t ())) "tree trunks" :group 'jw-trees)
  (face-spec-set
   'jw-tree-trunks '((t (:foreground "sienna4"))))
  (set-face-bold 'jw-tree-trunks t) 
  (let ((xmax 55) (ymax 15)
        (density 0.1)
        (min-height 2) (max-height 3)
        (forest-floor ?`)
        (trunk ?|) (boughs ?^))
    (pop-to-buffer "*trees*")
    (delete-other-windows)
    (erase-buffer)
    (dotimes (i ymax)
      (dotimes (j xmax) (insert (elt '("." "`" ",") (random 3))))
      (newline))
    (let ((trees nil))
      (dotimes (i (floor (* density xmax ymax)))
        (setq trees (cons (cons (random xmax) (random ymax)) trees)))
      (dolist (tr trees)
        (jw-coords-insert trunk (car tr) (cdr tr))
        (let ((bough (elt '(?^ ?# ?^ ?^ ?v ?@) (random 6))))
          (dotimes (h (+ min-height (random (- max-height min-height))))
            (jw-coords-insert bough (car tr) (- (cdr tr) (+ h 1))))))))
  (dolist
      (p '((jw-tree-dirt . "\\.")
           (jw-tree-dirt . "`")
           (jw-tree-dirt . ",")                        
           (jw-tree-leaves . "\\^")
           (jw-tree-leaves . "#")
           (jw-tree-leaves . "v")
           (jw-tree-leaves . "@")          
           (jw-tree-trunks . "|")
           (jw-tree-trunks . "I")))
    (unhighlight-regexp (cdr p))
    (highlight-regexp (cdr p) (car p))))


(progn
  (jw-trees)
  (switch-to-buffer "*trees*")
  (goto-char 1)
  (insert (current-time-string))
  (newline)
  (write-file "~/gopher/trees.txt"))