Add turtle-system

1 files changed, 71 insertions, 0 deletions

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)))))