Only one function for mobs.

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index e07ef2f641b94a6702a56937fc98aa846e665164..ab0748b722e863e364b9ef819b21aec3729dcb3e 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -33,6 +33,7 @@
            init-gacela
            quit-gacela
            game-loop
+           gacela-script
            game-running?
            set-game-code
            show-mob-hash
@@ -41,7 +42,8 @@
            hide-all-mobs
            get-current-mob-id
            get-mob-function-name
-           map-mobs)
+           map-mobs
+           translate-mob)
   #:export-syntax (game
                   show-mob
                   hide-mob
@@ -71,7 +73,8 @@
               get-frame-time
               key?
               key-pressed?
-              key-released?))
+              key-released?
+              3d-mode?))
 
 
 ;;; Resources Cache
@@ -144,11 +147,16 @@
            (game-loop)))))
 
 (define (init-gacela)
-  (set! game-loop-thread (call-with-new-thread (lambda () (game))))
+  (hide-all-mobs)
+  (set-game-code (lambda () #f))
+  (cond ((not game-loop-thread)
+        (set! game-loop-thread (call-with-new-thread (lambda () (game))))))
   (while (not loop-flag))
   #t)
 
 (define (quit-gacela)
+  (hide-all-mobs)
+  (set-game-code (lambda () #f))
   (set! game-loop-thread #f)
   (set! loop-flag #f))
 
@@ -175,6 +183,9 @@
                (delay-frame))))
   (quit-video))
 
+(define (gacela-script args)
+  (while loop-flag (sleep 1)))
+
 (define (game-running?)
   loop-flag)
 
@@ -257,16 +268,19 @@
 
 (define current-mob-id #f)
 
+(define translate-mob translate)
+
 (define (get-current-mob-id)
   current-mob-id)
 
 (define* (run-mobs #:optional (mobs (get-active-mobs)))
-  (for-each
-   (lambda (m)
-     (set! current-mob-id (m 'get-mob-id))
-     (glmatrix-block (m)))
-   mobs)
-  (set! current-mob-id #f))
+  (let ((sorted-mobs (sort mobs (lambda (m1 m2) (< (m1 'get-z-index) (m2 'get-z-index))))))
+    (for-each
+     (lambda (m)
+       (set! current-mob-id (m 'get-mob-id))
+       (glmatrix-block (m)))
+     sorted-mobs)
+    (set! current-mob-id #f)))
 
 
 ;;; Making mobs
@@ -280,8 +294,9 @@
           (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)
         (mob-data ,init-data)
         (saved-data ,init-data))
@@ -294,42 +309,64 @@
        (case option
         ((get-mob-id)
          mob-id)
+        ((get-z-index)
+         mob-z-index)
         ((get-type)
-         ,type)
+         (procedure-name ,mob-name))
         ((get-data)
          (save-data)
          saved-data)
         (else
-         (save-data)
-         (set! mob-data (,fun-name mob-id mob-data)))))))
-
-(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)))
+         (cond ((keyword? option)
+                (assoc-ref saved-data (keyword->symbol option)))
+               (else
+                (save-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 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)
-       (define (kill-me)
-        (hide-mob-hash ,mob-id-symbol))
-       (let ,attr
-        ,@(map
-           (lambda (a)
-             `(let ((val (assoc-ref ,data-symbol ',(car a))))
-                (cond (val (set! ,(car a) val)))))
-           attr)
-        (catch #t
-               (lambda* () ,@body)
-               (lambda (key . args) #f))
-        (list ,@(map (lambda (a) `(cons ',(car a) ,(car a))) attr))))))
+    `(lambda (,mob-id-symbol ,data-symbol)
+       (let ((,mob-id-z-index 0))
+        (define (kill-me)
+          (hide-mob-hash ,mob-id-symbol))
+        (define* (translate x y #:optional (z 0))
+          (cond ((3d-mode?)
+                 (translate-mob x y z))
+                (else
+                 (set! ,mob-id-z-index (+ ,mob-id-z-index z))
+                 (translate-mob x y))))
+        (let ,attr
+          ,@(map
+             (lambda (a)
+               `(let ((val (assoc-ref ,data-symbol ',(car a))))
+                  (cond (val (set! ,(car a) val)))))
+             attr)
+          (catch #t
+                 (lambda* () ,@body)
+                 (lambda (key . args) #f))
+          (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 ,(string->symbol (string-concatenate (list "make-" (symbol->string 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)))
@@ -352,3 +389,10 @@
          (let ,(map (lambda (a) `(,(car a) (assoc-ref m ',(cadr a)))) attr)
            ,@body))
        ',type))))
+
+
+;;; Scenes
+
+(define-macro (define-scene name . body)
+  `(define (,name)
+     ,@body))