(no commit message)

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index 38b57f01988a5eaa4642132db74711ca3b80a65c..6a0b50126870a0d3dae4dfbb3c9fd4b00021e49a 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -16,14 +16,19 @@
 
 
 ;;; Default values for Gacela
 
 
 ;;; Default values for Gacela

+
+(define *title* "Gacela")

 (define *width-screen* 640)
 (define *height-screen* 480)
 (define *bpp-screen* 32)
 (define *frames-per-second* 20)
 (define *width-screen* 640)
 (define *height-screen* 480)
 (define *bpp-screen* 32)
 (define *frames-per-second* 20)

+(define *mode* '2d)

 
 
 ;;; 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 +37,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,40 +48,44 @@
 
 
 ;;; 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
 
   (set! quit-video-mode

-       (lambda () (set! screen #f))))
+       (lambda ()
+         (SDL_FreeSurface screen)
+         (set! screen #f))))

 
 (define (set-2d-mode)
   (cond ((not (3d-mode?))
 
 (define (set-2d-mode)
   (cond ((not (3d-mode?))


@@ -88,10 +101,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)


@@ -106,13 +124,13 @@
   (glEnable GL_LIGHTING))
 
 (define (resize-screen-GL width height)
   (glEnable GL_LIGHTING))
 
 (define (resize-screen-GL width height)

-  (glViewPort 0 0 width height)
+  (glViewport 0 0 width height)

   (glMatrixMode GL_PROJECTION)
   (glLoadIdentity)
   (cond ((3d-mode?) (let ((ratio (if (= height 0) width (/ width height))))
                      (gluPerspective 45 ratio 0.1 100))) ;0.1
   (glMatrixMode GL_PROJECTION)
   (glLoadIdentity)
   (cond ((3d-mode?) (let ((ratio (if (= height 0) width (/ width height))))
                      (gluPerspective 45 ratio 0.1 100))) ;0.1

-       (else (let* ((w (/ width 2)) (-w (neg w)) (h (/ height 2)) (-h (neg h)))
-               (glOrtho -w w -h h 0 1))))
+       (else (let* ((w (/ width 2)) (h (/ height 2)))
+               (glOrtho (- w) w (- h) h 0 1))))

   (glMatrixMode GL_MODELVIEW)
   (glLoadIdentity)
   #t)
   (glMatrixMode GL_MODELVIEW)
   (glLoadIdentity)
   #t)


@@ -130,24 +148,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 +167,7 @@
 
 
 ;;; GaCeLa Functions
 
 
 ;;; GaCeLa Functions

+

 (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)


@@ -187,19 +191,29 @@
 (define set-game-properties #f)
 (define get-game-properties #f)
 
 (define set-game-properties #f)
 (define get-game-properties #f)
 

-(let ((ptitle "") (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode '2d))
+(let ((ptitle *title*) (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode *mode*))

   (set! set-game-properties
        (lambda* (#:key title width height bpp fps mode)
   (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 +222,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 +234,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)))
 


@@ -244,13 +265,3 @@
   (set! set-game-code
        (lambda (game-function)
          (set! game-code game-function))))
   (set! set-game-code
        (lambda (game-function)
          (set! game-code game-function))))

-
-(define (quit-game)
-;  (free-all-resources)
-   (quit-audio)
-   (quit-video-mode)
-;  (quit-all-mobs)
-;   (kill-all-objects)
-;  (clear-events)
-;  (quit-events)
-   (quit-sdl))