l-system is now parametric

5 files changed, 25 insertions, 57 deletions

diff --git a/l-system.asd b/l-system.asd
index 2c15fa4..08b4872 100644
--- a/l-system.asd
+++ b/l-system.asd
@@ -10,6 +10,5 @@
 	       :iterate)
   :components ((:file "package")
 	       (:file "turtle-system")
-               (:file "l-system")
-	       (:file "test")))
+               (:file "l-system")))
 
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))
diff --git a/src/package.lisp b/src/package.lisp
index 713a42d..3388533 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -2,7 +2,10 @@
 
 (defpackage #:l-system
   (:use #:cl #:iter #:sb-cga)
-  (:export #:l-system
+  (:export #:*l-system-clauses*
+	   #:l-system
+	   #:map-l-system
+	   #:def-l-system-clause
+
 	   #:turtle-system
-	   #:list-of-vectors->list
-	   #:iter-l-system))
+	   #:list-of-vectors->list))
diff --git a/src/test.lisp b/src/test.lisp
deleted file mode 100644
index b3ddffd..0000000
--- a/src/test.lisp
+++ /dev/null
@@ -1,30 +0,0 @@
-;;;; test.list
-
-(in-package :l-system)
-
-(defun test ()
-  (and
-   (test-l-system)
-   (test-iter-l-system)))
-
-(defun test-l-system ()
-  (tree-equal
-   (iterconcat (l-system (a a i a d a)
-			 (b b d b i b)
-			 (i i b i a i)
-			 (d d a d b d))
-	       '(d))
-   '(D A D B D)))
-
-(defun test-iter-l-system ()
-  (tree-equal
-   (iter-l-system (l-system (a a i a d a)
-			    (b b d b i b)
-			    (i i b i a i)
-			    (d d a d b d))
-		  '(d)
-		  3)
-   '(D A D B D A I A D A D A D B D B D B I B D A D B D A I A D A I B I A I A I A D
-     A D A D B D A I A D A D A D B D A I A D A D A D B D B D B I B D A D B D B D B
-     I B D A D B D B D B I B I B I A I B D B I B D A D B D A I A D A D A D B D B D
-     B I B D A D B D)))
diff --git a/src/turtle-system.lisp b/src/turtle-system.lisp
index 569492d..6e4f7c2 100644
--- a/src/turtle-system.lisp
+++ b/src/turtle-system.lisp
@@ -17,7 +17,7 @@
 	(with stack = '())
 	(with angle = radians)
 	(for item in list)
-	(case item
+	(case (car item)
 	  ;;Move forward one unit,adding data to mesh.
 	  ((f)
 	   (let ((new-pos