define-mob
lambda-mob
define-checking-mobs)
- #:re-export (translate
- get-frame-time
+ #:re-export ;(translate
+ ( get-frame-time
3d-mode?))
(to-origin)
(refresh-active-mobs)
(run-mobs)
- (draw-bricks)
+ (draw-views)
(flip-screen)
(delay-frame))))
(quit-video))
,@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)
draw-rectangle
draw-square
draw-cube
- translate
- rotate
+ gltranslate
+ glrotate
to-origin
add-light
set-camera
(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