]> git.jsancho.org Git - gacela.git/commitdiff
(no commit message)
authorjsancho <devnull@localhost>
Sat, 14 May 2011 11:34:17 +0000 (11:34 +0000)
committerjsancho <devnull@localhost>
Sat, 14 May 2011 11:34:17 +0000 (11:34 +0000)
src/Makefile.am
src/gacela.c
src/gacela.scm

index 7eeaebccb77eccab98c8eb6c592b9170d3f869be..948db53d5a29b44b7560421a7aac0a2b59e22f4c 100644 (file)
@@ -1,4 +1,4 @@
 bin_PROGRAMS = gacela
-gacela_SOURCES = *.c
+gacela_SOURCES = gacela.c gacela_SDL.c gacela_GL.c
 gacela_LDADD = @GUILE_LDFLAGS@
 
index c2a9ab7ad0a961880e6d42fa107c6548d64192bc..ff1954fd0305b1b6a152cc1f2dd9426936531675 100644 (file)
@@ -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);
 }
index db6a827d9e4a9b50378b2591530ee788afb77d5c..4a1a7bcf054667d2c09cddff446d5c12df20d371 100644 (file)
 (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?))