diff options
Diffstat (limited to 'src/l-system.lisp')
| -rw-r--r-- | src/l-system.lisp | 38 |
1 files changed, 17 insertions, 21 deletions
diff --git a/src/l-system.lisp b/src/l-system.lisp index 79122c7..0fcf0ce 100644 --- a/src/l-system.lisp +++ b/src/l-system.lisp @@ -7,33 +7,29 @@ ;;; "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 make-case-clause (keys value) - "Make one CASE clause mapping a list of KEYS to one VALUE" - `((,@keys) ',value)) - -(defun make-case-clauses-from-rules (rules) - "Makes a list of CASE clauses from the RULES." - (mapcar (lambda (rule) (make-case-clause (list (first rule)) (rest rule))) - rules)) - -(defun generate-l-system (rules) - "Make lambda Lindenmayer system" - `(lambda (atom) (case atom - ,@(make-case-clauses-from-rules rules) - (t (list atom))))) - -(defmacro l-system (&rest rules) - (generate-l-system rules)) - -(defun iter-l-system (rules axiom depth) +(defun l-system (axiom depth) (iter (repeat depth) (with result = axiom) (setf result - (iterconcat rules - 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 (funcall func (rest clause)))) + (when result + result)) + (list clause)))))) + +(defun def-l-system-clause (symbol lambda) + (setf (gethash symbol *l-system-clauses*) + lambda)) |