diff options
author | Bruno Cichon <ebrasca.ebrasca@gmail.com> | 2015-11-04 16:31:55 +0100 |
---|---|---|
committer | Bruno Cichon <ebrasca.ebrasca@gmail.com> | 2015-11-04 16:31:55 +0100 |
commit | 85ed3c869b52562a5c11a0438d56a304eb409adf (patch) | |
tree | 1ab88d9b57791832045dc8fc4238223199986661 | |
parent | 00e055406031fab6f4e2e5122c50c4050a1eb253 (diff) |
Add deflsys
-rw-r--r-- | examples/l-system-exemple.lisp | 111 | ||||
-rw-r--r-- | src/l-system.lisp | 8 | ||||
-rw-r--r-- | src/package.lisp | 1 |
3 files changed, 62 insertions, 58 deletions
diff --git a/examples/l-system-exemple.lisp b/examples/l-system-exemple.lisp index e95f4d3..63302e7 100644 --- a/examples/l-system-exemple.lisp +++ b/examples/l-system-exemple.lisp @@ -1,62 +1,59 @@ (in-package #:l-system-examples) -(def-l-system-clause 'f - #'(lambda (list) - (let* ((r0 0.5235988) - (n0 (* 1.01 (car list)))) - `((f ,(* 1.11 n0)) - - ([) - (+ ,r0) - (f ,(* 0.89 n0)) - (]) - - ([) - (- ,r0) - (f ,(* 0.89 n0)) - (]) - - ([) - (/ ,r0) - (f ,(* 0.89 n0)) - (]) - - ([) - (q ,r0) - (f ,(* 0.89 n0)) - (]) - - (f ,(* 1.11 n0)) - - ([) - (+ ,r0) - (f ,(* 0.89 n0)) - (]) - - ([) - (- ,r0) - (f ,(* 0.89 n0)) - (]) - - ([) - (/ ,r0) - (f ,(* 0.89 n0)) - (]) - - ([) - (q ,r0) - (f ,(* 0.89 n0)) - (]) - - (f ,(* 1.11 n0)))))) - -(def-l-system-clause '+ - #'(lambda (list) - `((+ ,(+ 0.1 (car list)))))) - -(def-l-system-clause '- - #'(lambda (list) - `((- ,(+ 0.1 (car list)))))) +(deflsys f (n) + (let* ((r0 0.5235988) + (n0 (* 1.01 n))) + `((f ,(* 1.11 n0)) + + ([) + (+ ,r0) + (f ,(* 0.89 n0)) + (]) + + ([) + (- ,r0) + (f ,(* 0.89 n0)) + (]) + + ([) + (/ ,r0) + (f ,(* 0.89 n0)) + (]) + + ([) + (q ,r0) + (f ,(* 0.89 n0)) + (]) + + (f ,(* 1.11 n0)) + + ([) + (+ ,r0) + (f ,(* 0.89 n0)) + (]) + + ([) + (- ,r0) + (f ,(* 0.89 n0)) + (]) + + ([) + (/ ,r0) + (f ,(* 0.89 n0)) + (]) + + ([) + (q ,r0) + (f ,(* 0.89 n0)) + (]) + + (f ,(* 1.11 n0))))) + +(deflsys + (n) + `((+ ,(+ 0.1 n)))) + +(deflsys - (n) + `((- ,(+ 0.1 n)))) ;; Rest (defclass test-window (gl-window) diff --git a/src/l-system.lisp b/src/l-system.lisp index 0fcf0ce..743e5ea 100644 --- a/src/l-system.lisp +++ b/src/l-system.lisp @@ -25,11 +25,17 @@ (iter (for clause in clauses) (appending (let ((func (gethash (car clause) *l-system-clauses*))) (if (functionp func) - (let ((result (funcall func (rest clause)))) + (let ((result (apply func + (rest clause)))) (when result result)) (list clause)))))) +(defmacro deflsys (symbol vars &body body) + `(def-l-system-clause ',symbol + (lambda ,vars + ,@body))) + (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 3388533..346e8a2 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -6,6 +6,7 @@ #:l-system #:map-l-system #:def-l-system-clause + #:deflsys #:turtle-system #:list-of-vectors->list)) |