Show, hide and translate for meshes.

diff --git a/src/gacela.scm b/src/gacela.scm
index 06986b8321737198920e44786781e5faeac358ad..70ac867c2b995108b5ed2a188f043d173c6c84dd 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -345,7 +345,7 @@
 (define* (draw-meshes #:optional (meshes (hash-map->list (lambda (k v) v) default-view)))
   (cond ((not (null? meshes))
         (catch #t
 (define* (draw-meshes #:optional (meshes (hash-map->list (lambda (k v) v) default-view)))
   (cond ((not (null? meshes))
         (catch #t

-                 (lambda () (glmatrix-block ((car meshes))))
+                 (lambda () ((car meshes) 'draw))

                  (lambda (key . args) #f))
         (draw-meshes (cdr meshes)))))
 
                  (lambda (key . args) #f))
         (draw-meshes (cdr meshes)))))
 

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))