(no commit message)

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index 9fb7c30c05dbdb039c10db4f1a9f3c1a6879ff69..c8c9fffc35d178e1b83ad104cca44d78fb19c1bb 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -26,6 +26,7 @@
 ;;; SDL Initialization Subsystem
 
 (define init-sdl #f)
 ;;; SDL Initialization Subsystem
 
 (define init-sdl #f)

+(define sdl-on? #f)

 (define quit-sdl #f)
 
 (let ((initialized #f))
 (define quit-sdl #f)
 
 (let ((initialized #f))


@@ -34,6 +35,10 @@
          (cond ((not initialized) (SDL_Init SDL_INIT_EVERYTHING) (set! initialized #t))
                (else initialized))))
 
          (cond ((not initialized) (SDL_Init SDL_INIT_EVERYTHING) (set! initialized #t))
                (else initialized))))
 

+  (set! sdl-on?
+       (lambda ()
+         (if initialized #t #f)))
+

   (set! quit-sdl
        (lambda ()
          (SDL_Quit)
   (set! quit-sdl
        (lambda ()
          (SDL_Quit)


@@ -43,40 +48,37 @@
 ;;; Video Subsystem
 
 (define init-video-mode #f)
 ;;; Video Subsystem
 
 (define init-video-mode #f)

-(define video-mode? #f)
+(define video-mode-on? #f)

 (define resize-screen #f)
 (define resize-screen #f)

-(define apply-mode-change #f)

 (define quit-video-mode #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
   (set! init-video-mode

-       (lambda* (#:optional (width current-width) (height current-height) (bpp current-bpp))
+       (lambda ()

          (cond ((not screen)
                 (init-sdl)
          (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))))
 
                (else #t))))
 

-  (set! video-mode?
+  (set! video-mode-on?

        (lambda () (if screen #t #f)))
 
   (set! resize-screen
        (lambda* (width height #:optional (bpp current-bpp))
          (cond (screen (set! screen (SDL_SetVideoMode width height bpp flags))
        (lambda () (if screen #t #f)))
 
   (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))))
 
   (set! quit-video-mode
        (lambda () (set! screen #f))))


@@ -95,6 +97,11 @@
         (glDepthFunc GL_LEQUAL)
         (apply-mode-change))))
 
         (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))
 
 (define (3d-mode?)
   (eq? (assoc-ref (get-game-properties) 'mode) '3d))
 


@@ -137,22 +144,6 @@
          (set! current-color (list red green blue alpha))
          (glColor4f red green blue alpha))))
 
          (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
 
 
 ;;; Audio Subsystem
 


@@ -205,15 +196,25 @@
   (set! set-game-properties
        (lambda* (#:key title width height bpp fps mode)
 ;        (init-video-mode)
   (set! set-game-properties
        (lambda* (#:key title width height bpp fps mode)
 ;        (init-video-mode)

-         (if title (begin (set! ptitle title) (if (video-mode?) (SDL_WM_SetCaption title ""))))
+         (if title
+             (begin
+               (set! ptitle title)
+               (if (video-mode-on?) (SDL_WM_SetCaption title ""))))

          (if (or width height bpp)
              (begin
                (if width (set! pwidth width))
                (if height (set! pheight height))
                (if bpp (set! pbpp bpp))
          (if (or width height bpp)
              (begin
                (if width (set! pwidth width))
                (if height (set! pheight height))
                (if bpp (set! pbpp bpp))

-               (resize-screen pwidth pheight pbpp)))
-         (if fps (begin (set! pfps fps) (set-frames-per-second fps)))
-         (if mode (begin (set! pmode mode) (if (eq? mode '3d) (set-3d-mode) (set-2d-mode))))
+               (if (video-mode-on?) (resize-screen pwidth pheight pbpp))))
+         (if fps
+             (begin
+               (set! pfps fps)
+               (set-frames-per-second fps)))
+         (if mode
+             (begin
+               (set! pmode mode)
+               (if (video-mode-on?)
+                   (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))))

          (get-game-properties)))
 
   (set! get-game-properties
          (get-game-properties)))
 
   (set! get-game-properties


@@ -239,20 +240,22 @@
        (lambda ()
          (set! mobs (get-active-mobs))
          (set! running #t)
        (lambda ()
          (set! mobs (get-active-mobs))
          (set! running #t)

-         (quit? #f)
+         (quit! #f)

          (do () ((quit?))
          (do () ((quit?))

-           (init-frame-time)
-;          (check-connections)
-;          (eval-from-clients)
-           (process-events)
-           (cond ((not (quit?))
-                  (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
-                  (to-origin)
-                  (cond ((mobs-changed?) (set! mobs (get-active-mobs))))
-                  (if (procedure? game-code) (game-code))
-                  (process-mobs mobs)
-                  (SDL_GL_SwapBuffers)
-                  (delay-frame))))
+           (if (sdl-on?) (init-frame-time))
+           (check-connections)
+           (eval-from-clients)
+           (cond ((sdl-on?)
+                  (process-events)
+                  (cond ((not (quit?))
+                         (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
+                         (to-origin)
+                         (cond ((mobs-changed?) (set! mobs (get-active-mobs))))
+                         (if (procedure? game-code) (game-code))
+                         (run-mob-actions mobs)
+                         (render-mobs mobs)
+                         (SDL_GL_SwapBuffers)
+                         (delay-frame))))))

          (set! running #f)))
 
   (set! game-running?
          (set! running #f)))
 
   (set! game-running?