From: jsancho <devnull@localhost>
Date: Sat, 14 May 2011 11:34:17 +0000 (+0000)
Subject: (no commit message)
X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=7534494c54a049a566bdaecc089aeb2354346b17;p=gacela.git

---

diff --git a/src/Makefile.am b/src/Makefile.am
index 7eeaebc..948db53 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -1,4 +1,4 @@
 bin_PROGRAMS = gacela
-gacela_SOURCES = *.c
+gacela_SOURCES = gacela.c gacela_SDL.c gacela_GL.c
 gacela_LDADD = @GUILE_LDFLAGS@
 
diff --git a/src/gacela.c b/src/gacela.c
index c2a9ab7..ff1954f 100644
--- a/src/gacela.c
+++ b/src/gacela.c
@@ -16,6 +16,7 @@
 */
 
 #include <libguile.h>
+#include <libgen.h>
 #include "gacela_SDL.h"
 #include "gacela_GL.h"
 
@@ -28,9 +29,21 @@ register_functions (void* data)
 }
 
 void
-load_scheme_files (void)
+load_scheme_files (char *path)
 {
-//  scm_c_primitive_load ("gacela.scm");
+  //  load_scheme_file (path, "gacela.scm");
+}
+
+void
+load_scheme_file (char *path, char *filename)
+{
+  char fn[strlen (path) + 1024];
+
+  strcpy (fn, path);
+  strcat (fn, "/");
+  strcat (fn, filename);
+
+  scm_c_primitive_load (fn);
 }
 
 int
@@ -41,6 +54,6 @@ main (int argc, char *argv[])
   scm_c_eval_string ("(set-repl-prompt! \"gacela>\")");
   scm_c_eval_string ("(use-modules (ice-9 readline))");
   scm_c_eval_string ("(activate-readline)");
-  load_scheme_files ();
+  load_scheme_files (dirname (argv[0]));
   scm_shell (argc, argv);
 }
diff --git a/src/gacela.scm b/src/gacela.scm
index db6a827..4a1a7bc 100644
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -22,42 +22,60 @@
 (define *frames-per-second* 20)
 
 ;;; SDL Initialization Subsystem
-(let (initialized)
+(define init-sdl #f)
+(define quit-sdl #f)
 
-  (define (init-sdl)
-    (cond ((null initialized) (set! initialized (SDL_Init SDL_INIT_EVERYTHING)))
-	  (#t initialized)))
+(let ((initialized #f))
+  (set! init-sdl
+	(lambda ()
+	  (cond ((not initialized) (SDL_Init SDL_INIT_EVERYTHING) (set! initialized #t))
+		(else initialized))))
+
+  (set! quit-sdl
+	(lambda ()
+	  (SDL_Quit)
+	  (set! initialized #f))))
 
-  (define (quit-sdl)
-    (set! initialized (SDL_Quit))))
 
 
 ;;; Video Subsystem
-(let (screen flags (current-width *width-screen*) (current-height *height-screen*) current-bpp)
-
-  (defun init-video-mode (&key (width current-width) (height current-height) (bpp *bpp-screen*))
-    (cond ((null screen)
-	   (init-sdl)
-	   (SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1)
-	   (setq flags (+ SDL_OPENGL SDL_GL_DOUBLEBUFFER SDL_HWPALETTE SDL_RESIZABLE
-			  (if (= (getf (SDL_GetVideoInfo) :hw_available) 0) SDL_SWSURFACE SDL_HWSURFACE)
-			  (if (= (getf (SDL_GetVideoInfo) :blit_hw) 0) 0 SDL_HWACCEL)))
-	   (setq screen (SDL_SetVideoMode width height bpp flags))
-	   (init-GL)
-	   (resize-screen-GL width height)
-	   (setq current-width width current-height height current-bpp bpp))
-	  (t t)))
-
-  (defun resize-screen (width height &optional (bpp current-bpp))
-    (cond (screen (setq screen (SDL_SetVideoMode width height bpp flags))
-		  (resize-screen-GL width height)))
-    (setq current-width width current-height height))
-
-  (defun apply-mode-change ()
-    (resize-screen-GL current-width current-height))
-
-  (defun quit-video-mode ()
-    (setq screen nil)))
+(define init-video-mode #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*))
+  (set! init-video-mode
+	(lambda (. args)
+	  (let ((width (cond ((assq 'width args
+
+	(lambda (&key (width current-width) (height current-height) (bpp *bpp-screen*))
+	  (cond ((not screen)
+		 (init-sdl)
+		 (SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER 1)
+		 (set! flags (+ SDL_OPENGL SDL_GL_DOUBLEBUFFER SDL_HWPALETTE SDL_RESIZABLE
+				(if (= (getf (SDL_GetVideoInfo) :hw_available) 0) SDL_SWSURFACE SDL_HWSURFACE)
+				(if (= (getf (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))
+		(else #t))))
+
+  (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)))
+
+  (set! quit-video-mode
+	(lambda () (set! screen #f))))
 
 (defun set-2d-mode ()
   (cond ((not (3d-mode?))