summaryrefslogtreecommitdiff
path: root/src/l-system.lisp
blob: 743e5ea35ff375053d4ff264e80d71a9d41ca1aa (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
;;;; l-system.lisp
#|
(ql:quickload :l-system)
|#

(in-package #:l-system)

;;; "l-system" goes here. Hacks and glory await!

(defparameter *l-system-clauses* (make-hash-table :test 'eq))

(defun iterconcat (fn list)
  "Applies fn on each element of list, and concatenate a copy of the resulting lists."
  (iter (for item in list)
	(appending (funcall fn item))))

(defun l-system (axiom depth)
  (iter (repeat depth)
	(with result = axiom)
	(setf result
	      (map-l-system result))
	(finally (return result))))

(defun map-l-system (clauses)
  (iter (for clause in clauses)
	(appending (let ((func (gethash (car clause) *l-system-clauses*)))
		     (if (functionp func)
			 (let ((result (apply func
					      (rest clause))))
			   (when result
			     result))
			 (list clause))))))

(defmacro deflsys (symbol vars &body body)
  `(def-l-system-clause ',symbol
       (lambda ,vars
	 ,@body)))

(defun def-l-system-clause (symbol lambda)
  (setf (gethash symbol *l-system-clauses*)
	lambda))