Introducing bricks.

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index 9096ddf88f4ee7401c16705d7e72f6479e7a4f82..cf72902541cd0c521fd79308a7c9917ce1017df4 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -18,6 +18,7 @@
 (define-module (gacela gacela)
   #:use-module (gacela events)
   #:use-module (gacela video)
+  #:use-module ((gacela video) #:renamer (symbol-prefix-proc 'video:))
   #:use-module (gacela audio)
   #:use-module (ice-9 optargs)
   #:export (*title*
@@ -129,6 +130,7 @@
                           (lambda () (game-code))
                           (lambda (key . args) #f)))
                (run-mobs)
+               (draw-bricks)
                (flip-screen)
                (delay-frame))))
   (quit-video))
@@ -151,8 +153,9 @@
 (define *bpp-screen* 32)
 (define *frames-per-second* 20)
 (define *mode* '2d)
+(define *fullscreen* 'off)
 
-(define* (set-game-properties! #:key title width height bpp fps mode)
+(define* (set-game-properties! #:key title width height bpp fps mode fullscreen)
   (if title
       (set-screen-title! title))
   (if bpp
@@ -166,10 +169,12 @@
       (set-frames-per-second! fps))
   (if mode
       (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))
+  (if fullscreen
+      (set-fullscreen! fullscreen))
   (get-game-properties))
 
 (define (get-game-properties)
-  `((title . ,(get-screen-title)) (width . ,(get-screen-width)) (height . ,(get-screen-height)) (bpp . ,(get-screen-bpp)) (fps . ,(get-frames-per-second)) (mode . ,(if (3d-mode?) '3d '2d))))
+  `((title . ,(get-screen-title)) (width . ,(get-screen-width)) (height . ,(get-screen-height)) (bpp . ,(get-screen-bpp)) (fps . ,(get-frames-per-second)) (mode . ,(if (3d-mode?) '3d '2d)) (fullscreen . ,(get-fullscreen))))
 
 
 ;;; Mobs Factory
@@ -346,3 +351,36 @@
 (define-macro (define-scene name . body)
   `(define (,name)
      ,@body))
+
+
+;;; Bricks Factory
+
+(define active-bricks '())
+
+(define* (draw-bricks #:optional (bricks active-bricks))
+  (cond ((not (null? bricks))
+        ((car bricks))
+        (draw-bricks (cdr bricks)))))
+
+(define (show-brick brick)
+  (set! active-bricks (cons brick active-bricks)))
+
+(define-macro (simple-brick brick-code)
+  (let ((name (gensym)))
+    `(begin
+       (define (,name)
+        ,brick-code)
+       (show-brick ,name)
+       ,name)))
+
+
+;;; Primitive bricks
+
+(define (draw-square . args)
+  (simple-brick (apply video:draw-square args)))
+
+
+(module-map (lambda (sym var)
+             (if (not (eq? sym '%module-public-interface))
+                 (module-export! (current-module) (list sym))))
+           (current-module))