X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela.scm;h=54b705fcf4f0553840f7fbb7095448525c61fe59;hb=f97bfd3b82bd6c337c85468a8b5e2c14ef8d63ab;hp=22228aec02fcea509fd8bd5ba173b13fa4c24c47;hpb=0e1f1aa7c657293c85d147c4b156e92c46f8ad4f;p=gacela.git diff --git a/src/gacela.scm b/src/gacela.scm index 22228ae..54b705f 100644 --- a/src/gacela.scm +++ b/src/gacela.scm @@ -45,24 +45,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 +73,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 +92,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 +139,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