From 85ed3c869b52562a5c11a0438d56a304eb409adf Mon Sep 17 00:00:00 2001
From: Bruno Cichon <ebrasca.ebrasca@gmail.com>
Date: Wed, 4 Nov 2015 16:31:55 +0100
Subject: Add deflsys

---
 examples/l-system-exemple.lisp | 111 ++++++++++++++++++++---------------------
 src/l-system.lisp              |   8 ++-
 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))
-- 
cgit v1.2.2