X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela.scm;h=3b65aff208d01470b6954ef2166c9096e8b11649;hb=f3d35ed115ff03f513c93a05325885e44da10891;hp=0de0b7b33bb1e5bd08d57f930355d870b26ccec0;hpb=437150d98d8bb5c833cba657f296152762586436;p=gacela.git

diff --git a/src/gacela.scm b/src/gacela.scm
index 0de0b7b..3b65aff 100644
--- 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
@@ -15,152 +15,51 @@
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 
-;;; Default values for Gacela
+(define-module (gacela gacela)
+  #:use-module (gacela system)
+  #:use-module (ice-9 threads)
+  #:use-module (srfi srfi-1)
+  #:export (make-world))
 
-(define *title* "Gacela")
-(define *width-screen* 640)
-(define *height-screen* 480)
-(define *bpp-screen* 32)
-(define *frames-per-second* 20)
-(define *mode* '2d)
 
+;;; Entities and components
 
-;;; Audio Subsystem
+(define (make-world . entities)
+  (apply make-entity-set entities))
 
-(define init-audio #f)
-(define quit-audio #f)
+(define entities-mutex (make-mutex))
+(define game-entities '())
+(define game-components '())
 
-(let ((audio #f))
-  (set! init-audio
-	(lambda ()
-	  (cond ((not audio) (begin (init-sdl) (set! audio (Mix_OpenAudio 22050 MIX_DEFAULT_FORMAT 2 4096))))
-		(else audio))))
 
-  (set! quit-audio
-	(lambda ()
-	  (Mix_CloseAudio)
-	  (set! audio #f))))
+(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)))
 
 
-;;; Resources Cache
+(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)))))))))
 
-(define resources-cache (make-weak-value-hash-table))
 
-(define get-resource-from-cache #f)
-(define insert-resource-into-cache #f)
+(define (get-entity key)
+  (with-mutex entities-mutex
+   (assoc key game-entities)))
 
-(let ()
-  (set! get-resource-from-cache
-	(lambda (key)
-	  (hash-ref resources-cache key)))
 
-  (set! insert-resource-into-cache
-	(lambda (key res)
-	  (hash-set! resources-cache key res))))
-
-;;; GaCeLa Functions
-
-(define set-frames-per-second #f)
-(define init-frame-time #f)
-(define get-frame-time #f)
-(define delay-frame #f)
-
-(let ((time 0) (time-per-frame (/ 1000.0 *frames-per-second*)))
-  (set! set-frames-per-second
-	(lambda (fps)
-	  (set! time-per-frame (/ 1000.0 fps))))
-
-  (set! init-frame-time
-	(lambda ()
-	  (set! time (SDL_GetTicks))))
-
-  (set! get-frame-time
-	(lambda ()
-	  time))
-
-  (set! delay-frame
-	(lambda ()
-	  (let ((frame-time (- (SDL_GetTicks) time)))
-	    (cond ((< frame-time time-per-frame)
-		   (SDL_Delay (- time-per-frame frame-time))))))))
-
-
-(define set-game-properties! #f)
-(define get-game-properties #f)
-
-(let ((ptitle *title*) (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode *mode*))
-  (set! set-game-properties!
-	(lambda* (#:key title width height bpp fps mode)
-;	  (init-video-mode)
-	  (if title
-	      (begin
-		(set! ptitle title)
-		(if (video-mode-on?) (SDL_WM_SetCaption title ""))))
-	  (if (or width height bpp)
-	      (begin
-		(if width (set! pwidth width))
-		(if height (set! pheight height))
-		(if bpp (set! pbpp bpp))
-		(if (video-mode-on?) (resize-screen pwidth pheight pbpp))))
-	  (if fps
-	      (begin
-		(set! pfps fps)
-		(set-frames-per-second fps)))
-	  (if mode
-	      (begin
-		(set! pmode mode)
-		(if (video-mode-on?)
-		    (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))))
-	  (get-game-properties)))
-
-  (set! get-game-properties
-	(lambda ()
-	  `((title . ,ptitle) (width . ,pwidth) (height . ,pheight) (bpp . ,pbpp) (fps . ,pfps) (mode . ,pmode)))))
-
-
-(define-macro (run-game . code)
-  `(let ((game-function ,(if (null? code)
-			     `(lambda () #f)
-			     `(lambda () ,@code))))
-     (init-video-mode)
-     (set-game-code game-function)
-     (cond ((not (game-running?))
-	    (game-loop)))))
-
-(define game-loop #f)
-(define game-running? #f)
-(define set-game-code #f)
-
-(let ((running #f) (game-code #f))
-  (set! game-loop
-	(lambda ()
-	  (refresh-active-mobs)
-	  (set! running #t)
-	  (quit! #f)
-	  (do () ((quit?))
-	    (init-frame-time)
-	    (check-connections)
-	    (eval-from-clients)
-	    (process-events)
-	    (cond ((not (quit?))
-		   (cond ((video-mode-on?)
-			  (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
-			  (to-origin)))
-		   (refresh-active-mobs)
-		   (if (procedure? game-code)
-		       (catch #t
-			      (lambda () (game-code))
-			      (lambda (key . args) #f)))
-		   (cond ((video-mode-on?)
-			  (run-mobs)
-			  (SDL_GL_SwapBuffers)))
-		   (delay-frame))))
-	  (set! running #f)))
-
-  (set! game-running?
-	(lambda ()
-	  running))
-
-  (set! set-game-code
-	(lambda (game-function)
-	  (set! game-code game-function))))
+(export entity
+	get-entity)