From 951c966fdc9913a9d08341a65fafe936a20cdf59 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 28 Aug 2015 21:45:00 +0200 Subject: Add turtle-system --- l-system.asd | 4 ++- src/l-system.lisp | 52 +++++------------------------------- src/package.lisp | 9 +++---- src/test.lisp | 57 ++++++++++++++++++++++++++++++++++++++++ src/turtle-system.lisp | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 142 insertions(+), 51 deletions(-) create mode 100644 src/test.lisp create mode 100644 src/turtle-system.lisp 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))))) -- cgit v1.2.2