Add turtle-system

5 files changed, 142 insertions, 51 deletions

diff --git a/l-system.asd b/l-system.asd
index 335fd9e..2c15fa4 100644
--- a/l-system.asd
+++ b/l-system.asd
@@ -9,5 +9,7 @@
   :depends-on (:sb-cga
 	       :iterate)
   :components ((:file "package")
-               (:file "l-system")))
+	       (:file "turtle-system")
+               (:file "l-system")
+	       (:file "test")))
 
diff --git a/src/l-system.lisp b/src/l-system.lisp
index d57c419..c5255a5 100644
--- a/src/l-system.lisp
+++ b/src/l-system.lisp
@@ -28,48 +28,10 @@
 (defmacro l-system (&rest rules)
   (generate-l-system rules))
 
-(defun iter-l-system (fn seed n)
-  (iter (repeat n)
-	(with item = seed)
-	(setf item
-	      (iterconcat fn
-			  item))
-	(finally (return item))))
-
-(defun eval-l-system (fn list)
-  (iter (with seed = '(0 0 0))
-	(for item in list)
-	(appending (setf seed
-			 (mapcar #'+
-				 seed
-				 (car (funcall fn item)))))))
-
-#|
-(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)
-
-(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)
-
-(eval-l-system (l-system (a (0.0 1.0 0.0))
-			 (b (0.0 -1.0 0.0))
-			 (i (-1.0 0.0 0.0))
-			 (d (1.0 0.0 0.0)))
-	       (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))
-|#
+(defun iter-l-system (rules axiom depth)
+  (iter (repeat depth)
+	(with result = axiom)
+	(setf result
+	      (iterconcat rules
+			  result))
+	(finally (return result))))
diff --git a/src/package.lisp b/src/package.lisp
index be69e5f..6f912dd 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1,9 +1,8 @@
 ;;;; package.lisp
 
 (defpackage #:l-system
-  (:use #:cl #:iter)
+  (:use #:cl #:iter #:sb-cga)
   (:export #:l-system
-	   #:turtle
-	   #:iter-l-system
-	   #:eval-l-system))
-
+	   #:turtle-system
+	   #:temp
+	   #:iter-l-system))
diff --git a/src/test.lisp b/src/test.lisp
new file mode 100644
index 0000000..f742809
--- /dev/null
+++ b/src/test.lisp
@@ -0,0 +1,57 @@
+;;;; test.list
+
+(in-package :l-system)
+
+(defun test ()
+  (and
+   (test-l-system)
+   (test-iter-l-system)))
+   ;;(turle-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)))
+
+#|
+(defun turle-system ()
+  (tree-equal
+   (turtle-system (l-system (a (0 1 0))
+			    (b (0 -1 0))
+			    (i (-1 0 0))
+			    (d (1 0 0)))
+		  (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))
+   '(1 0 0 1 1 0 2 1 0 2 0 0 3 0 0 3 1 0 2 1 0 2 2 0 3 2 0 3 3 0 4 3 0 4 4 0 5 4 0
+     5 3 0 6 3 0 6 2 0 7 2 0 7 1 0 6 1 0 6 0 0 7 0 0 7 1 0 8 1 0 8 0 0 9 0 0 9 1 0
+     8 1 0 8 2 0 9 2 0 9 3 0 8 3 0 8 2 0 7 2 0 7 3 0 6 3 0 6 4 0 5 4 0 5 5 0 6 5 0
+     6 6 0 7 6 0 7 7 0 8 7 0 8 6 0 9 6 0 9 7 0 8 7 0 8 8 0 9 8 0 9 9 0 10 9 0 10 10
+     0 11 10 0 11 9 0 12 9 0 12 10 0 11 10 0 11 11 0 12 11 0 12 12 0 13 12 0 13 13
+     0 14 13 0 14 12 0 15 12 0 15 11 0 16 11 0 16 10 0 15 10 0 15 9 0 16 9 0 16 10
+     0 17 10 0 17 9 0 18 9 0 18 8 0 19 8 0 19 7 0 18 7 0 18 6 0 19 6 0 19 7 0 20 7
+     0 20 6 0 21 6 0 21 5 0 22 5 0 22 4 0 21 4 0 21 3 0 20 3 0 20 2 0 19 2 0 19 3 0
+     18 3 0 18 2 0 19 2 0 19 1 0 18 1 0 18 0 0 19 0 0 19 1 0 20 1 0 20 0 0 21 0 0
+     21 1 0 20 1 0 20 2 0 21 2 0 21 3 0 22 3 0 22 4 0 23 4 0 23 3 0 24 3 0 24 2 0
+     25 2 0 25 1 0 24 1 0 24 0 0 25 0 0 25 1 0 26 1 0 26 0 0 27 0 0)))
+|#
diff --git a/src/turtle-system.lisp b/src/turtle-system.lisp
new file mode 100644
index 0000000..4c1acc9
--- /dev/null
+++ b/src/turtle-system.lisp
@@ -0,0 +1,71 @@
+;;;; turtle-system.lisp
+
+(in-package #:l-system)
+
+;;;(matrix* translate rotate scale)
+
+(export 'f)
+
+(defun turtle-system (list radians)
+  (iter (with seed = sb-cga:+identity-matrix+)
+	(with vec = (sb-cga:vec 1.0 0.0 0.0))
+	(with angle = radians)
+	(for item in list)
+	(case item
+	  ((f)
+	   (collect
+	       (setf seed
+		     (matrix* seed
+			      (translate vec)))))
+	  ((j)
+	   (setf seed
+		 (matrix* seed
+			  (translate vec))))
+	  ((+)
+	   (setf vec
+		 (transform-point (vec 0.0 0.0 0.0)
+				  (matrix*
+				   (rotate-around (vec 0.0 0.0 1.0) angle)
+				   (translate vec)))))
+	  ((-)
+	   (setf vec
+		 (transform-point (vec 0.0 0.0 0.0)
+				  (matrix*
+				   (rotate-around (vec 0.0 0.0 1.0) (- angle))
+				   (translate vec)))))
+	  ((&)
+	   (setf vec
+		 (transform-point (vec 0.0 0.0 0.0)
+				  (matrix*
+				   (rotate-around (vec 0.0 1.0 0.0) angle)
+				   (translate vec)))))
+	  ((^)
+	   (setf vec
+		 (transform-point (vec 0.0 0.0 0.0)
+				  (matrix*
+				   (rotate-around (vec 0.0 1.0 0.0) (- angle))
+				   (translate vec)))))
+	  ((\ )
+	   (setf vec
+		 (transform-point (vec 0.0 0.0 0.0)
+				  (matrix*
+				   (rotate-around (vec 1.0 0.0 0.0) angle)
+				   (translate vec)))))
+	  ((/)
+	   (setf vec
+		 (transform-point (vec 0.0 0.0 0.0)
+				  (matrix*
+				   (rotate-around (vec 1.0 0.0 0.0) (- angle))
+				   (translate vec)))))
+	  #|
+	  (([) )
+	  ((]) )
+	  |#
+	  )))
+
+(defun temp (list)
+    (iter (for matrix in list)
+	  (appending
+	   (concatenate 'list
+			(sb-cga:transform-point (vec 0.0 0.0 0.0)
+						matrix)))))