X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela.scm;h=4f1a4ddf54b3030a4cac38a73064009e6d3131b7;hb=cd001a2c183f65f0894500569fea2ffcf7362f30;hp=22228aec02fcea509fd8bd5ba173b13fa4c24c47;hpb=0e1f1aa7c657293c85d147c4b156e92c46f8ad4f;p=gacela.git

diff --git a/src/gacela.scm b/src/gacela.scm
index 22228ae..4f1a4dd 100644
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -26,6 +26,7 @@
 ;;; SDL Initialization Subsystem
 
 (define init-sdl #f)
+(define sdl-on? #f)
 (define quit-sdl #f)
 
 (let ((initialized #f))
@@ -34,6 +35,10 @@
 	  (cond ((not initialized) (SDL_Init SDL_INIT_EVERYTHING) (set! initialized #t))
 		(else initialized))))
 
+  (set! sdl-on?
+	(lambda ()
+	  (if initialized #t #f)))
+
   (set! quit-sdl
 	(lambda ()
 	  (SDL_Quit)
@@ -45,24 +50,26 @@
 (define init-video-mode #f)
 (define video-mode-on? #f)
 (define resize-screen #f)
-(define apply-mode-change #f)
 (define quit-video-mode #f)
 
-(let ((screen #f) (flags 0) (current-width *width-screen*) (current-height *height-screen*) (current-bpp *bpp-screen*))
+(let ((screen #f) (flags 0))
   (set! init-video-mode
-	(lambda* (#:optional (width current-width) (height current-height) (bpp current-bpp))
+	(lambda ()
 	  (cond ((not screen)
 		 (init-sdl)
-		 (SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1)
-		 (set! flags (+ SDL_OPENGL SDL_GL_DOUBLEBUFFER SDL_HWPALETTE SDL_RESIZABLE
-				(if (= (assoc-ref (SDL_GetVideoInfo) 'hw_available) 0) SDL_SWSURFACE SDL_HWSURFACE)
-				(if (= (assoc-ref (SDL_GetVideoInfo) 'blit_hw) 0) 0 SDL_HWACCEL)))
-		 (set! screen (SDL_SetVideoMode width height bpp flags))
-		 (init-gl)
-		 (resize-screen-GL width height)
-		 (set! current-width width)
-		 (set! current-height height)
-		 (set! current-bpp bpp))
+		 (let* ((props (get-game-properties))
+			(width (assoc-ref props 'width)) (height (assoc-ref props 'height))
+			(bpp (assoc-ref props 'bpp)) (title (assoc-ref props 'title))
+			(mode (assoc-ref props 'mode))
+			(info (SDL_GetVideoInfo)))
+		   (SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1)
+		   (set! flags (+ SDL_OPENGL SDL_GL_DOUBLEBUFFER SDL_HWPALETTE SDL_RESIZABLE
+				  (if (= (assoc-ref info 'hw_available) 0) SDL_SWSURFACE SDL_HWSURFACE)
+				  (if (= (assoc-ref info 'blit_hw) 0) 0 SDL_HWACCEL)))
+		   (set! screen (SDL_SetVideoMode width height bpp flags))
+		   (SDL_WM_SetCaption title "")
+		   (init-gl)
+		   (if (eq? mode '3d) (set-3d-mode) (set-2d-mode))))
 		(else #t))))
 
   (set! video-mode-on?
@@ -71,12 +78,7 @@
   (set! resize-screen
 	(lambda* (width height #:optional (bpp current-bpp))
 	  (cond (screen (set! screen (SDL_SetVideoMode width height bpp flags))
-			(resize-screen-GL width height)))
-	  (set! current-width width)
-	  (set! current-height height)))
-
-  (set! apply-mode-change
-	(lambda () (resize-screen-GL current-width current-height)))
+			(resize-screen-GL width height)))))
 
   (set! quit-video-mode
 	(lambda () (set! screen #f))))
@@ -95,6 +97,11 @@
 	 (glDepthFunc GL_LEQUAL)
 	 (apply-mode-change))))
 
+(define (apply-mode-change)
+  (let* ((props (get-game-properties))
+	 (width (assoc-ref props 'width)) (height (assoc-ref props 'height)))
+    (resize-screen-GL width height)))
+
 (define (3d-mode?)
   (eq? (assoc-ref (get-game-properties) 'mode) '3d))
 
@@ -137,22 +144,6 @@
 	  (set! current-color (list red green blue alpha))
 	  (glColor4f red green blue alpha))))
 
-(define* (load-image image-file #:key transparent-color)
-  (init-video-mode)
-  (let ((loaded-image (IMG_Load image-file)))
-    (cond ((= loaded-image 0) #f)
-	  (else (let ((optimized-image (SDL_DisplayFormat loaded-image)))
-		  (SDL_FreeSurface loaded-image)
-		  (cond ((= optimized-image 0) #f)
-			((not transparent-color) optimized-image)
-			(else (SDL_SetColorKey optimized-image
-					       SDL_SRCCOLORKEY
-					       (SDL_MapRGB (surface-format optimized-image)
-							   (car transparent-color)
-							   (cadr transparent-color)
-							   (caddr transparent-color)))
-			      optimized-image)))))))
-
 
 ;;; Audio Subsystem
 
@@ -249,19 +240,22 @@
 	(lambda ()
 	  (set! mobs (get-active-mobs))
 	  (set! running #t)
-	  (quit? #f)
+	  (quit! #f)
 	  (do () ((quit?))
 	    (init-frame-time)
-;	    (check-connections)
-;	    (eval-from-clients)
+	    (check-connections)
+	    (eval-from-clients)
 	    (process-events)
 	    (cond ((not (quit?))
-		   (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
-		   (to-origin)
+		   (cond ((video-mode-on?)
+			  (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
+			  (to-origin)))
 		   (cond ((mobs-changed?) (set! mobs (get-active-mobs))))
 		   (if (procedure? game-code) (game-code))
-		   (process-mobs mobs)
-		   (SDL_GL_SwapBuffers)
+		   (run-mob-actions mobs)
+		   (cond ((video-mode-on?)
+			  (render-mobs mobs)
+			  (SDL_GL_SwapBuffers)))
 		   (delay-frame))))
 	  (set! running #f)))