*/
#include <libguile.h>
+#include <libgen.h>
#include "gacela_SDL.h"
#include "gacela_GL.h"
}
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
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);
}
(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?))