(no commit message)

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index 54691562bfe46ca5fa977c3111e617ef384bc0a5..4f1a4ddf54b3030a4cac38a73064009e6d3131b7 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -16,6 +16,7 @@
 
 
 ;;; Default values for Gacela
 
 
 ;;; Default values for Gacela

+

 (define *width-screen* 640)
 (define *height-screen* 480)
 (define *bpp-screen* 32)
 (define *width-screen* 640)
 (define *height-screen* 480)
 (define *bpp-screen* 32)


@@ -23,7 +24,9 @@
 
 
 ;;; SDL Initialization Subsystem
 
 
 ;;; SDL Initialization Subsystem

+

 (define init-sdl #f)
 (define init-sdl #f)

+(define sdl-on? #f)

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


@@ -32,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)


@@ -39,37 +46,39 @@
 
 
 ;;; Video Subsystem
 
 
 ;;; Video Subsystem

+

 (define init-video-mode #f)
 (define init-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-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))
   (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))))


@@ -88,10 +97,15 @@
         (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))
 

-(define (init-GL)
+(define (init-gl)

   (glShadeModel GL_SMOOTH)
   (glClearColor 0 0 0 0)
 ;  (glClearDepth 1)
   (glShadeModel GL_SMOOTH)
   (glClearColor 0 0 0 0)
 ;  (glClearDepth 1)


@@ -130,24 +144,9 @@
          (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

+

 (define init-audio #f)
 (define quit-audio #f)
 
 (define init-audio #f)
 (define quit-audio #f)
 


@@ -164,6 +163,12 @@
 
 
 ;;; GaCeLa Functions
 
 
 ;;; GaCeLa Functions

+
+(define (init-gacela)
+  (init-sdl)
+  (init-gl))
+
+

 (define set-frames-per-second #f)
 (define init-frame-time #f)
 (define delay-frame #f)
 (define set-frames-per-second #f)
 (define init-frame-time #f)
 (define delay-frame #f)


@@ -190,16 +195,26 @@
 (let ((ptitle "") (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode '2d))
   (set! set-game-properties
        (lambda* (#:key title width height bpp fps mode)
 (let ((ptitle "") (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode '2d))
   (set! set-game-properties
        (lambda* (#:key title width height bpp fps mode)

-         (init-video-mode)
-         (if title (begin (set! ptitle title) (SDL_WM_SetCaption title "")))
+;        (init-video-mode)
+         (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


@@ -208,7 +223,9 @@
 
 
 (define-macro (run-game . code)
 
 
 (define-macro (run-game . code)

-  `(let ((game-function (lambda () ,@code)))
+  `(let ((game-function ,(if (null? code)
+                            `(lambda () #f)
+                            `(lambda () ,@code))))

      (init-video-mode)
      (set-game-code game-function)
      (cond ((not (game-running?))
      (init-video-mode)
      (set-game-code game-function)
      (cond ((not (game-running?))


@@ -218,22 +235,27 @@
 (define game-running? #f)
 (define set-game-code #f)
 
 (define game-running? #f)
 (define set-game-code #f)
 

-(let ((running #f) (game-code #f))
+(let ((running #f) (game-code #f) (mobs '()))

   (set! game-loop
        (lambda ()
   (set! game-loop
        (lambda ()

+         (set! mobs (get-active-mobs))

          (set! running #t)
          (set! running #t)

+         (quit! #f)

          (do () ((quit?))
            (init-frame-time)
            (check-connections)
            (eval-from-clients)
            (process-events)
            (cond ((not (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)
-                  (refresh-active-objects)
-                  (if (functionp game-code) (funcall game-code))
-                  (render-objects)
-                  (SDL_GL_SwapBuffers)
+                  (cond ((video-mode-on?)
+                         (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)
+                  (cond ((video-mode-on?)
+                         (render-mobs mobs)
+                         (SDL_GL_SwapBuffers)))

                   (delay-frame))))
          (set! running #f)))
 
                   (delay-frame))))
          (set! running #f)))
 


@@ -246,11 +268,10 @@
          (set! game-code game-function))))
 
 (define (quit-game)
          (set! game-code game-function))))
 
 (define (quit-game)

-;  (free-all-resources)

    (quit-audio)
    (quit-video-mode)
 ;  (quit-all-mobs)
 ;   (kill-all-objects)
    (quit-audio)
    (quit-video-mode)
 ;  (quit-all-mobs)
 ;   (kill-all-objects)

-;  (clear-events)
-;  (quit-events)
+;   (clear-events)
+   (quit-events)

    (quit-sdl))
    (quit-sdl))