From 7534494c54a049a566bdaecc089aeb2354346b17 Mon Sep 17 00:00:00 2001 From: jsancho Date: Sat, 14 May 2011 11:34:17 +0000 Subject: [PATCH] --- src/Makefile.am | 2 +- src/gacela.c | 19 ++++++++++-- src/gacela.scm | 80 ++++++++++++++++++++++++++++++------------------- 3 files changed, 66 insertions(+), 35 deletions(-) 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 +#include #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?)) -- 2.39.2