(no commit message)

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index 7d6306825261e44044da3f4ae1071749b462af4a..f83e11737b920d59f2a64c670471edc8b4446a36 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -51,8 +51,8 @@
                 (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)))
+                               (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)
@@ -106,13 +106,13 @@
   (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
-       (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)
@@ -204,46 +204,55 @@
 
   (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 (lambda () (begin ,@code))))
      (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)
+(define game-loop #f)
+(define game-running? #f)
+(define set-game-code #f)
+
+(let ((running #f) (game-code #f))
+  (set! game-loop
+       (lambda ()
+         (set! running #t)
+;        (do () ((quit?))
+         (do () (#f)
+           (init-frame-time)
+;          (check-connections)
+;          (eval-from-clients)
+;          (process-events)
+;          (cond ((not (quit?))
+           (cond ((not #f)
+                  (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)
+                  (delay-frame))))
+         (set! running #f)))
+
+  (set! game-running?
+       (lambda ()
+         running))
+
+  (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)
+;   (kill-all-objects)
 ;  (clear-events)
 ;  (quit-events)
-  (quit-sdl))
+   (quit-sdl))