summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBruno Cichon <ebrasca.ebrasca@gmail.com>2015-11-04 16:31:55 +0100
committerBruno Cichon <ebrasca.ebrasca@gmail.com>2015-11-04 16:31:55 +0100
commit85ed3c869b52562a5c11a0438d56a304eb409adf (patch)
tree1ab88d9b57791832045dc8fc4238223199986661
parent00e055406031fab6f4e2e5122c50c4050a1eb253 (diff)
Add deflsys
-rw-r--r--examples/l-system-exemple.lisp111
-rw-r--r--src/l-system.lisp8
-rw-r--r--src/package.lisp1
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))