]> git.jsancho.org Git - gacela.git/blobdiff - src/gacela.scm
Gacela as Guile modules.
[gacela.git] / src / gacela.scm
index d440c087399421842ae1a6b8bd16517c0566b7ac..0de0b7b33bb1e5bd08d57f930355d870b26ccec0 100644 (file)
 (define *mode* '2d)
 
 
-;;; SDL Initialization Subsystem
-
-(define init-sdl #f)
-(define sdl-on? #f)
-(define quit-sdl #f)
-
-(let ((initialized #f))
-  (set! init-sdl
-       (lambda ()
-         (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! initialized #f))))
-
-
-;;; Video Subsystem
-
-(define init-video-mode #f)
-(define video-mode-on? #f)
-(define resize-screen #f)
-(define quit-video-mode #f)
-
-(let ((screen #f) (flags 0))
-  (set! init-video-mode
-       (lambda ()
-         (cond ((not screen)
-                (init-sdl)
-                (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))))
-
-  (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))
-                       (resize-screen-GL width height)))))
-
-  (set! quit-video-mode
-       (lambda ()
-         (SDL_FreeSurface screen)
-         (set! screen #f))))
-
-(define (set-2d-mode)
-  (cond ((not (3d-mode?))
-        (init-video-mode)
-        (glDisable GL_DEPTH_TEST)
-        (apply-mode-change))))
-
-(define (set-3d-mode)
-  (cond ((3d-mode?)
-        (init-video-mode)
-        (glClearDepth 1)
-        (glEnable GL_DEPTH_TEST)
-        (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 (init-gl)
-  (glShadeModel GL_SMOOTH)
-  (glClearColor 0 0 0 0)
-;  (glClearDepth 1)
-;  (glDepthFunc GL_LEQUAL)
-  (glEnable GL_BLEND)
-;  (glBlendFunc GL_SRC_ALPHA GL_ONE)
-  (glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
-  (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
-  #t)
-
-(define (init-lighting)
-  (init-video-mode)
-  (glEnable GL_LIGHTING))
-
-(define (resize-screen-GL 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)) (h (/ height 2)))
-               (glOrtho (- w) w (- h) h 0 1))))
-  (glMatrixMode GL_MODELVIEW)
-  (glLoadIdentity)
-  #t)
-
-
 ;;; Audio Subsystem
 
 (define init-audio #f)