From: Javier Sancho Date: Sat, 23 Jun 2012 08:08:06 +0000 (+0200) Subject: Introducing views X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=d93e90690ad41aae3203e93ba01cf8fa658203b3;p=gacela.git Introducing views --- diff --git a/src/gacela.scm b/src/gacela.scm index 2b9a19e..6719f82 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -50,8 +50,8 @@ define-mob lambda-mob define-checking-mobs) - #:re-export (translate - get-frame-time + #:re-export ;(translate + ( get-frame-time 3d-mode?)) @@ -119,7 +119,7 @@ (to-origin) (refresh-active-mobs) (run-mobs) - (draw-bricks) + (draw-views) (flip-screen) (delay-frame)))) (quit-video)) @@ -339,33 +339,31 @@ ,@body)) -;;; Bricks Factory +;;; Views Factory -(define active-bricks '()) +(define active-views (make-hash-table)) -(define* (draw-bricks #:optional (bricks active-bricks)) - (cond ((not (null? bricks)) - ((car bricks)) - (draw-bricks (cdr bricks))))) - -(define-macro (show-brick brick-name) - `(set! active-bricks (cons (lambda () (,brick-name)) active-bricks))) - -(define-macro (simple-brick brick-code) - (let ((name (gensym))) - `(begin - (define (,name) - ,brick-code) - (show-brick ,name) - ,name))) +(define* (draw-views #:optional (views (hash-map->list (lambda (k v) v) active-views))) + (cond ((not (null? views)) + (catch #t + (lambda* () ((car views))) + (lambda (key . args) #f)) + (draw-views (cdr views))))) +(define-macro (define-view name content) + `(begin + (hash-set! active-views ',name (lambda () (glmatrix-block ,content))) + ',name)) -;;; Primitive bricks -(define-macro (draw-square . args) - `(simple-brick (apply video:draw-square ',args))) +;;; Views Primitives -(re-export video:draw-square) +(define-macro (translate x y view-or-z . view) + (let* ((z (if (null? view) 0 view-or-z)) + (view (if (null? view) view-or-z (car view)))) + `(begin + (gltranslate ,x ,y ,z) + ,view))) (module-map (lambda (sym var) diff --git a/src/video.scm b/src/video.scm index e58fab9..d3fbdfb 100644 --- a/src/video.scm +++ b/src/video.scm @@ -58,8 +58,8 @@ draw-rectangle draw-square draw-cube - translate - rotate + gltranslate + glrotate to-origin add-light set-camera @@ -374,10 +374,10 @@ (glNormal3f -1 0 0) (draw-quad (list -size -size size) (list -size -size -size) (list -size size -size) (list -size size size) #:texture (or texture-6 texture) #:color (or color-6 color))))) -(define* (translate x y #:optional (z 0)) +(define* (gltranslate x y #:optional (z 0)) (glTranslatef x y z)) -(define* (rotate #:rest rot) +(define* (glrotate #:rest rot) (cond ((3d-mode?) (apply 3d-rotate rot)) (else