summaryrefslogtreecommitdiff
path: root/src/l-system.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/l-system.lisp')
-rw-r--r--src/l-system.lisp22
1 files changed, 17 insertions, 5 deletions
diff --git a/src/l-system.lisp b/src/l-system.lisp
index 13d9992..c3f47d0 100644
--- a/src/l-system.lisp
+++ b/src/l-system.lisp
@@ -4,22 +4,34 @@
;;; "l-system" goes here. Hacks and glory await!
-(defparameter *l-system-clauses* (make-hash-table :test 'eq))
+(defparameter *l-system-clauses* (make-hash-table :test 'equal))
-(defun l-system (axiom depth)
+(defun l-system (fn axiom depth)
(iter (repeat depth)
(with result = axiom)
(setf result
- (map-l-system result))
+ (funcall fn result))
(finally (return result))))
-(defun map-l-system (clauses)
- (iter (for (symbol . parameters) in clauses)
+(defun parametric-grammar (elements)
+ (iter (for (symbol . parameters) in elements)
(for func = (gethash symbol *l-system-clauses*))
(appending (if (functionp func)
(apply func parameters)
(list `(,symbol ,@parameters))))))
+(defun context-sensitive-grammar (elements)
+ (iter (for elt on elements)
+ (with symbol0 = nil)
+ (for (symbol1 . parameters1) = (first elt))
+ (for symbol2 = (first (second elt)))
+ (for func = (or (gethash (list symbol0 symbol1 symbol2) *l-system-clauses*)
+ (gethash symbol1 *l-system-clauses*)))
+ (appending (if (functionp func)
+ (apply func parameters1)
+ (list `(,symbol1 ,@parameters1))))
+ (setf symbol0 (first (first elt)))))
+
(defmacro setf-l-system-rule (symbol lambda)
`(setf (gethash ,symbol *l-system-clauses*)
,lambda))