Show, hide and translate for meshes.

[gacela.git] / src / views.scm

diff --git a/src/views.scm b/src/views.scm
index d658eafaf0786a28caa9344640bddf638e8e2fb7..63c162a9d954e4b2a9238b7a7aaefbb721a74539 100644 (file)
--- a/src/views.scm
+++ b/src/views.scm
@@ -29,51 +29,39 @@
 (define (mesh primitive)
   (let ((x 0) (y 0) (z 0)
        (ax 0) (ay 0) (az 0)
 (define (mesh primitive)
   (let ((x 0) (y 0) (z 0)
        (ax 0) (ay 0) (az 0)

-       (rx 0) (ry 0) (rz 0))
-    (lambda (option . params)
-      (case option
-       ((draw)
-        (video:glatrix-block
-         (video:rotate rx ry rz)
-         (video:translate x y z)
-         (video:rotate ax ay az)
-         (primitive)))
-       ((get-properties)
-        `((x . ,x) (y . ,y) (z . ,z) (ax . ,ax) (ay . ,ay) (az . ,az) (rx . ,rx) (ry . ,ry) (rz . ,rz)))))))
+       (rx 0) (ry 0) (rz 0)
+       (id (gensym)))
+    (let ((get-properties
+          (lambda ()
+            `((id . ,id) (x . ,x) (y . ,y) (z . ,z) (ax . ,ax) (ay . ,ay) (az . ,az) (rx . ,rx) (ry . ,ry) (rz . ,rz)))))
+      (lambda (option . params)
+       (case option
+         ((draw)
+          (video:glmatrix-block
+           (video:rotate rx ry rz)
+           (video:translate x y z)
+           (video:rotate ax ay az)
+           (primitive)))
+         ((translate)
+          (set! x (+ x (car params)))
+          (set! y (+ y (cadr params)))
+          (set! z (+ z (caddr params))))
+         ((get-properties)
+          (get-properties))
+         ((get-property)
+          (assoc-ref (get-properties) (car params))))))))

 
 

-(define-macro (define-mob mob-head . body)
-  (let* ((name (car mob-head))
-        (attr (cdr mob-head))
-        (make-fun-symbol (gensym))
-        (mob-fun-symbol (gensym))
-        (params-symbol (gensym)))
-    `(define (,name . ,params-symbol)
-       (define ,make-fun-symbol
-        (lambda* ,(if (null? attr) '() `(#:key ,@attr))
-          (the-mob ,name (list ,@(map (lambda (a) `(cons ',(car a) ,(car a))) attr)))))
-       (define ,mob-fun-symbol
-        (define-mob-function ,attr ,@body))
-       (cond ((or (null? ,params-symbol) (keyword? (car ,params-symbol)))
-             (apply ,make-fun-symbol ,params-symbol))
-            (else
-             (apply ,mob-fun-symbol ,params-symbol))))))
+(define* (show-mesh mesh #:optional (view default-view))
+  (let ((id (mesh 'get-property 'id)))
+    (if (not (hash-ref view id))
+       (hash-set! view id mesh))))

 
 

+(define* (hide-mesh mesh #:optional (view default-view))
+  (hash-remove! view (mesh 'get-property 'id)))

 
 

-(define-macro (define-mesh name . mesh)
-  (let* ((make-fun-symbol (gensym))
-        (mesh-fun-symbol (gensym))
-        (params-symbol (gensym)))
-    `(define ,name
-       (let ((,make-fun-symbol
-             (lambda ()))
-            (,mesh-fun-symbol
-             (lambda ())))
-        (lambda (. ,params-symbol)
-          (cond ((or (null? ,params-symbol) (keyword? (car ,params-symbol)))
-                 (apply ,make-fun-symbol ,params-symbol))
-                (else
-                 (apply ,mesh-fun-symbol ,params-symbol))))))))
-        
+(define* (translate mesh x y #:optional (z 0))
+  (mesh 'translate x y z)
+  mesh)

 
 (define-macro (define-primitives . symbols)
   (cond ((null? symbols)
 
 (define-macro (define-primitives . symbols)
   (cond ((null? symbols)


@@ -83,8 +71,6 @@
            (define (,(caar symbols) . params) (mesh (lambda () (apply ,(cadar symbols) params))))
            (define-primitives ,@(cdr symbols))))))
 
            (define (,(caar symbols) . params) (mesh (lambda () (apply ,(cadar symbols) params))))
            (define-primitives ,@(cdr symbols))))))
 

-; (define-macro (,(caar symbols) . params) (let ((f ',(cadar symbols))) `(mesh (lambda () (apply ,f ',params)))))
-

 (define-primitives
   (rectangle video:draw-rectangle)
   (square video:draw-square))
 (define-primitives
   (rectangle video:draw-rectangle)
   (square video:draw-square))