Miscellaneous renaming. Deleted unrelated code.

6 files changed, 12 insertions, 313 deletions

diff --git a/README.txt b/README.txt
index ff5e5f1..391a2f3 100644
--- a/README.txt
+++ b/README.txt
@@ -3,11 +3,8 @@
 This is based on Lindenmayer system with lists on place of strings.
 Main goal of this proyect are flexibility.
 
-The basic idea are : l-system -> turtle-system -> graphics
-
 At the moment, this includes the following functionality:
 
-*Manage parametric l system based on list
-*Early turtle-system
+*Manage parametric l system.
 
 For an example, see 'examples/l-system-exemple.lisp'.
diff --git a/examples/l-system-exemple.lisp b/examples/l-system-exemple.lisp
index 6480dc5..cbe4c99 100644
--- a/examples/l-system-exemple.lisp
+++ b/examples/l-system-exemple.lisp
@@ -1,169 +1,11 @@
 (in-package #:l-system-examples)
 
-(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))
-	(])
+(-> f (x)
+  '((f 1)
+    (j 1)
+    (f 1)))
 
-	([)
-	(/ ,r0)
-	(f ,(* 0.89 n0))
-	(])
-	
-	([)
-	(q ,r0)
-	(f ,(* 0.89 n0))
-	(])
+(-> j (x)
+  `((j ,(* 3 x))))
 
-	(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)
-  ((start-time :initform (get-internal-real-time))
-   (frames :initform 0)
-   (dt :initform 0)
-   (rotate :initform 0.0)
-   
-   (view-matrix :initform (kit.glm:perspective-matrix 50.0 1.1 1.0 800.0))
-   (vao :initform nil)
-   (programs :initform nil)))
-
-(defmethod initialize-instance :after ((w test-window)
-				       &key shaders &allow-other-keys)
-  (setf (idle-render w) t)
-  (gl:viewport 0 0 800 600)
-
-  (with-slots (vao programs) w
-    (let* ((data
-	    ;;convert list of vecs to array
-	    (list-of-vectors->list
-	     ;;make list of vecs
-	     (turtle-system
-	      ;;Specific geometry for symbol f
-	      #'(lambda (o n list)
-		  (cube o n))
-	      ;;make structure of turtle commands
-	      (l-system '((f 1.0)) 3))))
-	   (length (length data))
-	   (array (make-array length
-		    :element-type 'single-float
-		    :initial-contents data)))
-      (setf programs (compile-shader-dictionary shaders))
-      (setf vao
-	    (make-instance 'vao
-			   :type 'vertex-3d
-			   :primitive :triangles
-			   :vertex-count (/ length 3)))
-      (vao-buffer-vector vao 0 (* 4 length) array)
-      (vao-buffer-vector vao 1 (* 4 length) array))))
-
-
-;;; Rest
-
-(defmethod render ((window test-window))
-  (with-slots (view-matrix vao programs rotate) window
-    (gl:clear-color 0.0 0.0 1.0 1.0)
-    (gl:clear :color-buffer)
-
-    (use-program programs :vertex-color)
-    (uniform-matrix programs :view-m 4 (vector
-					(sb-cga:matrix*
-					 view-matrix
-					 (kit.glm:look-at
-					  (sb-cga:vec 0.0 0.0 200.0)
-					  (sb-cga:vec 0.0 10.0 0.0)
-					  (sb-cga:vec 0.0 -1.0 0.0))
-					 (sb-cga:rotate* 0.0
-							 (incf rotate 0.00625)
-							 0.0))))
-    (vao-draw vao)))
-
-(defmethod render :after ((window test-window))
-  (with-slots (start-time frames rotate) window
-    (incf frames)
-    (let* ((current-time (get-internal-real-time))
-           (seconds (/ (- current-time start-time) internal-time-units-per-second)))
-      
-      (when (> seconds 5)
-	(format t "FPS: ~A~%" (float (/ frames seconds)))
-        (setf frames 0)
-        (setf start-time (get-internal-real-time))))))
-
-(defun start-example ()
-  (kit.sdl2:start)
-  (sdl2:in-main-thread ()
-    (sdl2:gl-set-attr :context-major-version 3)
-    (sdl2:gl-set-attr :context-minor-version 3))
-  (make-instance 'test-window :shaders 'vao-color.programs.330))
-
-(defvao vertex-3d ()
-  (:separate ()
-    (vertex :float 3)
-    (color :float 3)))
-
-(defdict vao-color.programs.330 ()
-  (program :vertex-color (:view-m)
-           (:vertex-shader "
-#version 330
-
-uniform mat4 view_m;
-
-layout (location = 0) in vec3 vertex;
-layout (location = 1) in vec3 color;
-
-smooth out vec3 f_color;
-
-void main() {
-    gl_Position = view_m * vec4(vertex, 1.0);
-    f_color = color;
-}
-")
-           (:fragment-shader "
-#version 330
-
-smooth in vec3 f_color;
-out vec4 f_out;
-
-void main() {
-    f_out = vec4(f_color,
-                 1.0);
-}
-")))
+(l-system '((f 1.0)) 2)
diff --git a/l-system.asd b/l-system.asd
index 08b4872..335fd9e 100644
--- a/l-system.asd
+++ b/l-system.asd
@@ -9,6 +9,5 @@
   :depends-on (:sb-cga
 	       :iterate)
   :components ((:file "package")
-	       (:file "turtle-system")
                (:file "l-system")))
 
diff --git a/src/l-system.lisp b/src/l-system.lisp
index 743e5ea..80d6f81 100644
--- a/src/l-system.lisp
+++ b/src/l-system.lisp
@@ -1,7 +1,4 @@
 ;;;; l-system.lisp
-#|
-(ql:quickload :l-system)
-|#
 
 (in-package #:l-system)
 
@@ -31,11 +28,11 @@
 			     result))
 			 (list clause))))))
 
-(defmacro deflsys (symbol vars &body body)
+(defmacro -> (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))
+ 	lambda))
diff --git a/src/package.lisp b/src/package.lisp
index d1f0c24..ee670e5 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -2,18 +2,5 @@
 
 (defpackage #:l-system
   (:use #:cl #:iter #:sb-cga)
-  (:export #:*l-system-clauses*
-	   #:l-system
-	   #:map-l-system
-	   #:def-l-system-clause
-	   #:deflsys
-
-	   #:turtle-system
-	   #:list-of-vectors->list
-
-	   #:mtranslate
-	   #:mrotate
-	   #:get-axis
-	   #:get-vec
-
-	   #:cube))
+  (:export #:l-system
+  	   #:->))
diff --git a/src/turtle-system.lisp b/src/turtle-system.lisp
deleted file mode 100644
index 48f1f91..0000000
--- a/src/turtle-system.lisp
+++ /dev/null
@@ -1,123 +0,0 @@
-;;;; turtle-system.lisp
-
-(in-package #:l-system)
-
-;;;(matrix* translate rotate scale)
-
-(export '(f j + - & ^ q / [ ]))
-
-(defvar coor-sys (identity-matrix))
-(defvar stack '())
-
-(defun turtle-system (fn list)
-  (iter (for item in list)
-	(case (car item)
-	  ;;Move forward one unit,adding data to mesh.
-	  ((f)
-	   (let ((new-coor-sys (mtranslate coor-sys
-					   (vec* (vec 0.0 1.0 0.0)
-						 (cadr item)))))
-	     (appending (funcall fn coor-sys new-coor-sys (cdr item)))
-	     (setf coor-sys new-coor-sys)))
-	  ;;Move forward one unit,without adding data to mesh.
-	  ((j)
-	   (setf coor-sys (mtranslate coor-sys
-				      (vec* (vec 0.0 1.0 0.0)
-					    (cadr item)))))
-	  ;;Rotate left on axis z
-	  ((+)
-	   (setf coor-sys (mrotate
-			   (get-axis coor-sys 2)
-			   coor-sys
-			   (cadr item))))
-	  ;;Rotate right on axis z
-	  ((-)
-	   (setf coor-sys (mrotate
-			   (get-axis coor-sys 2)
-			   coor-sys
-			   (- (cadr item)))))
-	  ;;Rotate left on axis y
-	  ((&)
-	   (setf coor-sys (mrotate
-			   (get-axis coor-sys 1)
-			   coor-sys
-			   (cadr item))))
-	  ;;Rotate right on axis y
-	  ((^)
-	   (setf coor-sys (mrotate
-			   (get-axis coor-sys 1)
-			   coor-sys
-			   (- (cadr item)))))
-	  ;;Rotate left on axis x
-	  ((q)
-	   (setf coor-sys (mrotate
-			   (get-axis coor-sys 0)
-			   coor-sys
-			   (cadr item))))
-	  ;;Rotate right on axis x
-	  ((/)
-	   (setf coor-sys (mrotate
-			   (get-axis coor-sys 0)
-			   coor-sys
-			   (- (cadr item)))))
-	  ;;Push the current turtle state onto a stack
-	  (([)
-	   (push (copy-seq coor-sys)
-		 stack))
-	  ;;Pop the turtle stack, restoring an earlier state
-	  ((])
-	   (setf coor-sys (pop stack))))
-	(finally (init))))
-
-;;; Turgle utils
-
-(defun init ()
-  (setf coor-sys (identity-matrix)
-	stack '()))
-
-(defun list-of-vectors->list (list-of-vectors)
-  (iterconcat #'(lambda (vec)
-		  (concatenate 'list
-			       vec))
-	      list-of-vectors))
-
-(defun mtranslate (matrix vec)
-  (matrix* matrix
-	   (translate vec)))
-
-(defun mrotate (axis matrix radians)
-  (matrix* matrix
-	   (rotate-around axis radians)))
-
-(defun get-axis (matrix column)
-  (vec (mref matrix 0 column)
-       (mref matrix 1 column)
-       (mref matrix 2 column)))
-
-(defun get-vec (matrix)
-  (transform-point (vec 0.0 0.0 0.0)
-		   matrix))
-
-;;; Test geometry
-
-(defun cube (matrix0 matrix1)
-  (let ((x0 (get-axis matrix0 0))
-	(y0 (get-axis matrix0 1))
-	(z0 (get-axis matrix0 2))
-	(pos0 (get-vec matrix0))
-	(x1 (get-axis matrix1 0))
-	(y1 (get-axis matrix1 1))
-	(z1 (get-axis matrix1 2))
-	(pos1 (get-vec matrix1)))
-    (list
-     pos0 pos1 (vec+ pos0 x0)
-     (vec+ pos0 x0) (vec+ pos1 x1) pos1
-     
-     (vec+ pos0 z0) (vec+ pos0 (vec+ x0 z0)) (vec+ pos1 z1)
-     (vec+ pos0 (vec+ x0 z0)) (vec+ pos1 z1) (vec+ pos1 (vec+ x1 z1))
-
-     (vec+ pos0 x0) (vec+ pos1 x1) (vec+ pos0 (vec+ x0 z0))
-     (vec+ pos0 (vec+ x0 z0)) (vec+ pos1 x1) (vec+ pos1  (vec+ x1 z1))
-
-     pos0 pos1 (vec+ pos0 z0)
-     (vec+ pos0 z0) pos1 (vec+ pos1 z1))))