diff options
Diffstat (limited to 'src/turtle-system.lisp')
| -rw-r--r-- | src/turtle-system.lisp | 106 |
1 files changed, 63 insertions, 43 deletions
diff --git a/src/turtle-system.lisp b/src/turtle-system.lisp index b9b3510..86a56a1 100644 --- a/src/turtle-system.lisp +++ b/src/turtle-system.lisp @@ -4,80 +4,100 @@ ;;;(matrix* translate rotate scale) -(export 'f) -(export 'q) -(export '[) -(export ']) +(export '(f j + - & ^ q / [ ])) + +(defvar coor-sys (identity-matrix)) +(defvar stack '()) (defun turtle-system (fn list) - (iter (with pos = (sb-cga:vec 0.0 0.0 0.0)) - (with vec-x = (sb-cga:vec 1.0 0.0 0.0)) - (with vec-y = (sb-cga:vec 0.0 1.0 0.0)) - (with vec-z = (sb-cga:vec 0.0 0.0 1.0)) - (with stack = '()) - (for item in list) + (iter (for item in list) (case (car item) ;;Move forward one unit,adding data to mesh. ((f) - (let ((new-pos - (vec+ pos - (vec* vec-y - (cadr item))))) - (appending (funcall fn pos new-pos vec-x vec-y vec-z)) - (setf pos new-pos))) + (let ((pos (get-vec coor-sys)) + (vec-x (get-axis coor-sys 0)) + (vec-y (get-axis coor-sys 1)) + (vec-z (get-axis coor-sys 2))) + (setf coor-sys (mtranslate coor-sys + (vec* (vec 0.0 1.0 0.0) + (cadr item)))) + (appending (funcall fn pos (get-vec coor-sys) + vec-x vec-y vec-z)))) ;;Move forward one unit,without adding data to mesh. ((j) - (setf pos - (vec+ pos - (vec* vec-y - (cadr item))))) + (setf coor-sys (mtranslate coor-sys + (vec* (vec 0.0 1.0 0.0) + (cadr item))))) ;;Rotate left on axis z ((+) - (setf vec-x (vec-rotate-around vec-x vec-z (cadr item)) - vec-y (vec-rotate-around vec-y vec-z (cadr item)))) + (setf coor-sys (mrotate + (get-axis coor-sys 2) + coor-sys + (cadr item)))) ;;Rotate right on axis z ((-) - (setf vec-x (vec-rotate-around vec-x vec-z (- (cadr item))) - vec-y (vec-rotate-around vec-y vec-z (- (cadr item))))) + (setf coor-sys (mrotate + (get-axis coor-sys 2) + coor-sys + (- (cadr item))))) ;;Rotate left on axis y ((&) - (setf vec-x (vec-rotate-around vec-x vec-y (cadr item)) - vec-z (vec-rotate-around vec-z vec-y (cadr item)))) + (setf coor-sys (mrotate + (get-axis coor-sys 1) + coor-sys + (cadr item)))) ;;Rotate right on axis y ((^) - (setf vec-x (vec-rotate-around vec-x vec-y (- (cadr item))) - vec-z (vec-rotate-around vec-z vec-y (- (cadr item))))) + (setf coor-sys (mrotate + (get-axis coor-sys 1) + coor-sys + (- (cadr item))))) ;;Rotate left on axis x ((q) - (setf vec-z (vec-rotate-around vec-z vec-x (cadr item)) - vec-y (vec-rotate-around vec-y vec-x (cadr item)))) + (setf coor-sys (mrotate + (get-axis coor-sys 0) + coor-sys + (cadr item)))) ;;Rotate right on axis x ((/) - (setf vec-z (vec-rotate-around vec-z vec-x (- (cadr item))) - vec-y (vec-rotate-around vec-y vec-x (- (cadr item))))) + (setf coor-sys (mrotate + (get-axis coor-sys 0) + coor-sys + (- (cadr item))))) ;;Push the current turtle state onto a stack (([) - (push (list pos vec-x vec-y vec-z) + (push (copy-seq coor-sys) stack)) ;;Pop the turtle stack, restoring an earlier state ((]) - (let* ((asd (pop stack))) - (setf pos (pop asd) - vec-x (pop asd) - vec-y (pop asd) - vec-z (pop asd))))))) + (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 vec-rotate-around (vec vec-rotation angle) - "Rotate vec around vec-rotation axis by angle" +(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* - (rotate-around vec-rotation angle) - (translate vec)))) + matrix)) |