X-Git-Url: https://git.jsancho.org/?a=blobdiff_plain;f=src%2Fgacela.scm;h=f83e11737b920d59f2a64c670471edc8b4446a36;hb=e2ab9ffff05259980c1b333030fcb074d665acc1;hp=7d6306825261e44044da3f4ae1071749b462af4a;hpb=6a3d1ffb69036e6d4f1c239fd7d52f9bfc48d50c;p=gacela.git

diff --git a/src/gacela.scm b/src/gacela.scm
index 7d63068..f83e117 100644
--- 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))