Trash

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index a0b9b22a137a4d8d958c9952ed880f18de61bf0a..3b65aff208d01470b6954ef2166c9096e8b11649 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -1,5 +1,5 @@
 ;;; Gacela, a GNU Guile extension for fast games development
-;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;; Copyright (C) 2013 by Javier Sancho Fernandez <jsf at jsancho dot org>
 ;;;
 ;;; This program is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -16,147 +16,50 @@
 
 
 (define-module (gacela gacela)
-  #:use-module (gacela events)
-  #:use-module (gacela video)
-  #:use-module (gacela audio)
-  #:use-module (ice-9 optargs)
-  #:export (load-texture
-           load-font
-           *title*
-           *width-screen*
-           *height-screen*
-           *bpp-screen*
-           *frames-per-second*
-           *mode*
-           set-game-properties!
-           get-game-properties
-           init-gacela
-           quit-gacela
-           game-loop
-           game-running?
-           set-game-code)
-  #:export-syntax (game)
-  #: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))
+  #:use-module (gacela system)
+  #:use-module (ice-9 threads)
+  #:use-module (srfi srfi-1)
+  #:export (make-world))
 
 
-;;; Resources Cache
+;;; Entities and components
 
-(define resources-cache (make-weak-value-hash-table))
+(define (make-world . entities)
+  (apply make-entity-set entities))
 
-(define (from-cache key)
-  (hash-ref resources-cache key))
+(define entities-mutex (make-mutex))
+(define game-entities '())
+(define game-components '())
 
-(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)))))))
+(define (entity . components)
+  (with-mutex entities-mutex
+   (let ((key (gensym)))
+     (set! game-entities
+          (acons key
+                 (map (lambda (c) (list (get-component-type c) c)) components)
+                 game-entities))
+     (set! game-components (register-components key components))
+     key)))
 
-(use-cache-with (gacela video) load-texture)
-(use-cache-with (gacela video) load-font)
 
+(define* (register-components entity components #:optional (clist game-components))
+  (cond ((null? components) clist)
+       (else
+        (let* ((type (get-component-type (car components)))
+               (elist (assoc-ref clist type)))
+          (register-components entity (cdr components)
+            (assoc-set! clist type
+              (cond (elist
+                     (lset-adjoin eq? elist entity))
+                    (else
+                     (list entity)))))))))
 
-;;; Game Properties
 
-(define *title* "Gacela")
-(define *width-screen* 640)
-(define *height-screen* 480)
-(define *bpp-screen* 32)
-(define *frames-per-second* 20)
-(define *mode* '2d)
+(define (get-entity key)
+  (with-mutex entities-mutex
+   (assoc key game-entities)))
 
-(define* (set-game-properties! #:key title width height bpp fps mode)
-  (if title
-      (set-screen-title! title))
-  (if bpp
-      (set-screen-bpp! bpp))
-  (if (or width height)
-      (begin
-       (if (not width) (set! width (get-screen-width)))
-       (if (not height) (set! height (get-screen-height)))
-       (resize-screen width height)))
-  (if fps
-      (set-frames-per-second! fps))
-  (if mode
-      (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))
-  (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))))
-
-
-;;; Main Loop
-
-(define loop-flag #f)
-(define game-code #f)
-
-(define-macro (game . code)
-  `(let ((game-function ,(if (null? code)
-                            `(lambda () #f)
-                            `(lambda () ,@code))))
-     (set-game-code game-function)
-     (cond ((not (game-running?))
-           (game-loop)))))
-
-(define (init-gacela)
-  (call-with-new-thread (lambda () (game))))
-
-(define (quit-gacela)
-  (set! loop-flag #f))
-
-(define (game-loop)
-;        (refresh-active-mobs)
-  (set! loop-flag #t)
-  (init-video *width-screen* *height-screen* *bpp-screen* #:title *title* #:mode *mode* #:fps *frames-per-second*)
-  (while loop-flag
-        (init-frame-time)
-;          (check-connections)
-        (process-events)
-        (cond ((quit-signal?)
-               (quit-gacela))
-              (else
-               (clear-screen)
-               (to-origin)
-;                 (refresh-active-mobs)
-               (if (procedure? game-code)
-                   (catch #t
-                          (lambda () (game-code))
-                          (lambda (key . args) #f)))
-;                        (run-mobs)
-               (flip-screen)
-               (delay-frame))))
-  (quit-video))
-
-(define (game-running?)
-  loop-flag)
-
-(define (set-game-code game-function)
-  (set! game-code game-function))
+(export entity
+       get-entity)