(no commit message)

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index 7d6306825261e44044da3f4ae1071749b462af4a..1d963c6772b29a5f1924d84f0aef14d4890c97d4 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 (= (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))
+                (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,16 +101,22 @@
         (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)
 ;  (glDepthFunc GL_LEQUAL)
   (glShadeModel GL_SMOOTH)
   (glClearColor 0 0 0 0)
 ;  (glClearDepth 1)
 ;  (glDepthFunc GL_LEQUAL)

-;  (glEnable GL_BLEND)
+  (glEnable GL_BLEND)

 ;  (glBlendFunc GL_SRC_ALPHA GL_ONE)
 ;  (glBlendFunc GL_SRC_ALPHA GL_ONE)

+  (glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)

   (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
   #t)
 
   (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
   #t)
 


@@ -106,13 +125,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 +149,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 +168,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)


@@ -184,66 +189,82 @@
                   (SDL_Delay (- time-per-frame frame-time))))))))
 
 
                   (SDL_Delay (- time-per-frame frame-time))))))))
 
 

-(define set-game-properties #f)
+(define set-game-properties! #f)

 (define get-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))
-  (set! set-game-properties
+(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)
        (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
        (lambda ()
          (get-game-properties)))
 
   (set! get-game-properties
        (lambda ()

-         (list :title ptitle :width pwidth :height pheight :bpp pbpp :fps pfps :mode pmode)))
+         `((title . ,ptitle) (width . ,pwidth) (height . ,pheight) (bpp . ,pbpp) (fps . ,pfps) (mode . ,pmode)))))

 
 
 
 

-(defmacro run-game (&body code)
-  `(let ((game-function (lambda () ,@code)))
+(define-macro (run-game . code)
+  `(let ((game-function ,(if (null? code)
+                            `(lambda () #f)
+                            `(lambda () ,@code))))

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

-(let (running game-code)
-  (defun game-loop ()
-    (setq running t)
-    (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)
-              (when (functionp game-code) (funcall game-code))
-              (render-objects)
-              (SDL_GL_SwapBuffers)
-              (delay-frame))))
-    (setq running nil))
-
-  (defun game-running? ()
-    running)
-
-  (defun set-game-code (game-function)
-    (setq game-code game-function)))
-
-(defun quit-game ()
-  (free-all-resources)
-  (quit-audio)
-  (quit-video-mode)
-;  (quit-all-mobs)
-  (kill-all-objects)
-;  (clear-events)
-;  (quit-events)
-  (quit-sdl))
+(define game-loop #f)
+(define game-running? #f)
+(define set-game-code #f)
+
+(let ((running #f) (game-code #f) (mobs '()))
+  (set! game-loop
+       (lambda ()
+         (set! mobs (get-active-mobs))
+         (set! running #t)
+         (quit! #f)
+         (do () ((quit?))
+           (init-frame-time)
+           (check-connections)
+           (eval-from-clients)
+           (process-events)
+           (cond ((not (quit?))
+                  (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)
+                      (catch #t
+                             (lambda () (game-code))
+                             (lambda (key . args) #f)))
+                  (cond ((video-mode-on?)
+                         (run-mobs mobs)
+                         (SDL_GL_SwapBuffers)))
+                  (delay-frame))))
+         (set! running #f)))
+
+  (set! game-running?
+       (lambda ()
+         running))
+
+  (set! set-game-code
+       (lambda (game-function)
+         (set! game-code game-function))))