Gacela as Guile modules.

[gacela.git] / src / gacela.scm

diff --git a/src/gacela.scm b/src/gacela.scm
index bfb4d123d47a9d896bb4cdc8d9c615845f5bacc6..52b0442f5b9f79d3056a0dde572b79e740bdbcb9 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -15,6 +15,14 @@
 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 
+(define-module (gacela gacela)
+  #:use-module (gacela events)
+  #:use-module (gacela video)
+  #:use-module (gacela audio)
+  #:use-module (ice-9 optargs)
+  #:export ())
+
+
 ;;; Default values for Gacela
 
 (define *title* "Gacela")
@@ -25,164 +33,27 @@
 (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)
-
-(define get-current-color #f)
-(define set-current-color #f)
-
-(let ((current-color '(1 1 1 1)))
-  (set! get-current-color
-       (lambda ()
-         current-color))
-
-  (set! set-current-color
-       (lambda* (red green blue #:optional (alpha 1))
-         (set! current-color (list red green blue alpha))
-         (glColor4f red green blue alpha))))
-
-
-;;; Audio Subsystem
-
-(define init-audio #f)
-(define quit-audio #f)
-
-(let ((audio #f))
-  (set! init-audio
-       (lambda ()
-         (cond ((not audio) (begin (init-sdl) (set! audio (Mix_OpenAudio 22050 MIX_DEFAULT_FORMAT 2 4096))))
-               (else audio))))
-
-  (set! quit-audio
-       (lambda ()
-         (Mix_CloseAudio)
-         (set! audio #f))))
-
-
 ;;; Resources Cache
 
 (define resources-cache (make-weak-value-hash-table))
 
-(define get-resource-from-cache #f)
-(define insert-resource-into-cache #f)
+(define from-cache #f)
+(define into-cache #f)
 
 (let ()
-  (set! get-resource-from-cache
+  (set! from-cache
        (lambda (key)
          (hash-ref resources-cache key)))
 
-  (set! insert-resource-into-cache
+  (set! into-cache
        (lambda (key res)
          (hash-set! resources-cache key res))))
 
+(define-macro (use-cache-with-procedure proc-name)
+  `(begin
+     (define ,(string->symbol (string-concatenate (list (symbol->string proc-name) "-without-cache"))) ,proc-name)))
+
+
 ;;; GaCeLa Functions
 
 (define set-frames-per-second #f)