Fullscreen mode.

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index 2a440b2abd10f09a9c0214a06837fdf5da8e3930..63d6bd3e6992ea3d5703671faf90a699d80c385c 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -20,9 +20,7 @@
   #:use-module (gacela video)
   #:use-module (gacela audio)
   #:use-module (ice-9 optargs)
-  #:export (load-texture
-           load-font
-           *title*
+  #:export (*title*
            *width-screen*
            *height-screen*
            *bpp-screen*
@@ -52,59 +50,11 @@
                   define-mob
                   lambda-mob
                   define-checking-mobs)
-  #:re-export (get-current-color
-              set-current-color
-              with-color
-              progn-textures
-              draw
-              draw-texture
-              draw-line
-              draw-quad
-              draw-rectangle
-              draw-square
-              draw-cube
-              translate
-              rotate
-              to-origin
-              add-light
-              set-camera
-              camera-look
-              render-text
+  #:re-export (translate
               get-frame-time
-              key?
-              key-pressed?
-              key-released?
               3d-mode?))
 
 
-;;; Resources Cache
-
-(define resources-cache (make-weak-value-hash-table))
-
-(define (from-cache key)
-  (hash-ref resources-cache key))
-
-(define (into-cache key res)
-  (hash-set! resources-cache key res))
-
-(define-macro (use-cache-with module proc)
-  (let ((pwc (string->symbol (string-concatenate (list (symbol->string proc) "-without-cache")))))
-    `(begin
-       (define ,pwc (@ ,module ,proc))
-       (define (,proc . param)
-        (let* ((key param)
-               (res (from-cache key)))
-          (cond (res
-                 res)
-                (else
-                 (set! res (apply ,pwc param))
-                 (into-cache key res)
-                 res)))))))
-
-(use-cache-with (gacela video) load-texture)
-(use-cache-with (gacela video) load-font)
-
-
 ;;; Main Loop
 
 (define loop-flag #f)
@@ -201,8 +151,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
@@ -216,10 +167,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
@@ -294,7 +247,7 @@
           (hash-set! mob-functions mob-name name)))
     name))
 
-(define-macro (the-mob type init-data fun-name)
+(define-macro (the-mob mob-name init-data)
   `(let ((mob-id (gensym))
         (mob-z-index 0)
         (mob-time 0)
@@ -312,7 +265,7 @@
         ((get-z-index)
          mob-z-index)
         ((get-type)
-         ,type)
+         (procedure-name ,mob-name))
         ((get-data)
          (save-data)
          saved-data)
@@ -321,17 +274,16 @@
                 (assoc-ref saved-data (keyword->symbol option)))
                (else
                 (save-data)
-                (let ((res (,fun-name mob-id mob-data)))
+                (let ((res (,mob-name mob-id mob-data)))
                   (set! mob-z-index (car res))
                   (set! mob-data (cadr res))))))))))
 
-(define-macro (define-mob-function head . body)
-  (let ((fun-name (car head))
-       (attr (map (lambda (a) (if (list? a) a (list a #f))) (cdr head)))
+(define-macro (define-mob-function attr . body)
+  (let ((attr (map (lambda (a) (if (list? a) a (list a #f))) attr))
        (mob-id-symbol (gensym))
        (mob-id-z-index (gensym))
        (data-symbol (gensym)))
-    `(define (,fun-name ,mob-id-symbol ,data-symbol)
+    `(lambda (,mob-id-symbol ,data-symbol)
        (let ((,mob-id-z-index 0))
         (define (kill-me)
           (hide-mob-hash ,mob-id-symbol))
@@ -341,7 +293,7 @@
                 (else
                  (set! ,mob-id-z-index (+ ,mob-id-z-index z))
                  (translate-mob x y))))
-        (let ,attr
+        (let* ,attr
           ,@(map
              (lambda (a)
                `(let ((val (assoc-ref ,data-symbol ',(car a))))
@@ -353,13 +305,21 @@
           (list ,mob-id-z-index (list ,@(map (lambda (a) `(cons ',(car a) ,(car a))) attr))))))))
 
 (define-macro (define-mob mob-head . body)
-  (let* ((name (car mob-head)) (attr (cdr mob-head))
-        (fun-name (get-mob-function-name name)))
-    `(begin
-       (define-mob-function ,(cons fun-name attr) ,@body)
-       (define ,name
+  (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)) ,fun-name))))))
+          (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-macro (lambda-mob attr . body)
   (let ((fun-name (gensym)))