(no commit message)

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index f70a9c62e826ec75c08d8af9fffdd057a206966b..9bea00ec2506d0487d83dc93734aac7f97ef4a68 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,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)
 


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


@@ -187,19 +192,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


@@ -220,23 +235,30 @@
 (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)
+         (quit! #f)

          (do () ((quit?))
            (init-frame-time)
          (do () ((quit?))
            (init-frame-time)

-;          (check-connections)
-;          (eval-from-clients)
+           (check-connections)
+           (eval-from-clients)

            (process-events)
            (cond ((not (quit?))
            (process-events)
            (cond ((not (quit?))

-                  (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
-;                (to-origin)
-;                (refresh-active-objects)
-                  (if (procedure? game-code) (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)
+                      (catch #t
+                             (lambda () (game-code))
+                             (lambda (key . args) #f)))
+                  (run-mob-actions mobs)
+                  (cond ((video-mode-on?)
+                         (render-mobs mobs)
+                         (SDL_GL_SwapBuffers)))

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


@@ -247,13 +269,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))