Gacela as Guile modules.

diff --git a/src/gacela.scm b/src/gacela.scm
index d440c087399421842ae1a6b8bd16517c0566b7ac..0de0b7b33bb1e5bd08d57f930355d870b26ccec0 100644 (file)
--- a/src/gacela.scm
+++ b/src/gacela.scm
@@ -25,118 +25,6 @@
 (define *mode* '2d)
 
 
 (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)
 ;;; Audio Subsystem
 
 (define init-audio #f)

diff --git a/src/video.scm b/src/video.scm
index 1b2a9e73a588eb2c3fbc1eab0b9a5012edede6eb..d12e5ecd532f8df768e9111cc329c6a108a0929c 100644 (file)
--- a/src/video.scm
+++ b/src/video.scm
@@ -21,7 +21,20 @@
   #:use-module (gacela ftgl)
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 receive)
   #:use-module (gacela ftgl)
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 receive)

-  #:export (with-color
+  #:export (init-video
+           get-screen-height
+           get-screen-width
+           get-screen-bpp
+           resize-screen
+           quit-video
+           clear-screen
+           flip-screen
+           set-2d-mode
+           set-3d-mode
+           3d-mode?
+           get-current-color
+           set-current-color
+           with-color

            progn-textures
            draw
            load-image
            progn-textures
            draw
            load-image


@@ -33,16 +46,119 @@
            draw-rectangle
            draw-square
            draw-cube
            draw-rectangle
            draw-square
            draw-cube

-           add-light

            translate
            rotate
            to-origin
            translate
            rotate
            to-origin

+           add-light

            set-camera
            camera-look
            load-font
            render-text))
 
 
            set-camera
            camera-look
            load-font
            render-text))
 
 

+;;; Screen
+
+(define init-video #f)
+(define get-screen-height #f)
+(define get-screen-width #f)
+(define get-screen-bpp #f)
+(define resize-screen #f)
+(define quit-video #f)
+
+(let ((screen #f) (flags 0))
+  (set! init-video
+       (lambda* (width height bpp #:key (mode '2d) (title ""))
+         (cond ((not screen)
+                (SDL_Init SDL_INIT_VIDEO)
+                (let ((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! get-screen-height
+       (lambda ()
+         (surface-h screen)))
+
+  (set! get-screen-width
+       (lambda ()
+         (surface-w screen)))
+
+  (set! get-screen-bpp
+       (lambda ()
+         (surface-format-BytesPerPixel screen)))
+
+  (set! resize-screen
+       (lambda (width height)
+         (cond (screen
+                (set! screen (SDL_SetVideoMode width height (get-screen-bpp) flags))
+                (resize-screen-GL width height)))))
+
+  (set! quit-video
+       (lambda ()
+         (SDL_FreeSurface screen)
+         (set! screen #f)
+         (SDL_Quit))))
+
+(define (clear-screen)
+  (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT)))
+
+(define (flip-screen)
+  (SDL_GL_SwapBuffers))
+
+
+(define set-2d-mode #f)
+(define set-3d-mode #f)
+(define 3d-mode? #f)
+
+(let ((mode '2d))
+  (set! set-2d-mode
+       (lambda ()
+         (set! mode '2d)
+         (glDisable GL_DEPTH_TEST)
+         (resize-screen-GL (get-screen-width) (get-screen-height))))
+
+  (set! set-3d-mode
+       (lambda ()
+         (set! mode '3d)
+         (glClearDepth 1)
+         (glEnable GL_DEPTH_TEST)
+         (glDepthFunc GL_LEQUAL)
+         (resize-screen-GL (get-screen-width) (get-screen-height))))
+
+  (set! 3d-mode?
+       (lambda ()
+         (eq? mode '3d))))
+
+
+(define (init-gl)
+  (glShadeModel GL_SMOOTH)
+  (glClearColor 0 0 0 0)
+  (glEnable GL_BLEND)
+  (glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
+  (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST))
+
+(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)))
+       (else
+        (let* ((w (/ width 2)) (h (/ height 2)))
+          (glOrtho (- w) w (- h) h 0 1))))
+  (glMatrixMode GL_MODELVIEW)
+  (glLoadIdentity))
+
+
+;;; Drawing
+

 (define get-current-color #f)
 (define set-current-color #f)
 
 (define get-current-color #f)
 (define set-current-color #f)
 


@@ -147,10 +263,6 @@
                      (insert-resource-into-cache key texture)
                      texture)))))))))
 
                      (insert-resource-into-cache key texture)
                      texture)))))))))
 

-;; (define* (draw-image filename #:optional (zoom 1))
-;;   (let ((texture (load-texture filename)))
-;;     (cond (texture (draw-texture texture zoom)))))
-

 (define* (draw-texture texture #:optional (zoom 1))
   (cond (texture
         (let ((width (texture-w texture))
 (define* (draw-texture texture #:optional (zoom 1))
   (cond (texture
         (let ((width (texture-w texture))


@@ -209,20 +321,14 @@
      (glNormal3f -1 0 0)
      (draw-quad (list -size -size size) (list -size -size -size) (list -size size -size) (list -size size size) :texture (or texture-6 texture) #:color (or color-6 color)))))
 
      (glNormal3f -1 0 0)
      (draw-quad (list -size -size size) (list -size -size -size) (list -size size -size) (list -size size size) :texture (or texture-6 texture) #:color (or color-6 color)))))
 

-(define* (add-light #:key light position ambient (id GL_LIGHT1) (turn-on t))
-  (init-lighting)
-  (and light (glLightfv id GL_DIFFUSE (first light) (second light) (third light) (fourth light)))
-  (and light position (glLightfv GL_POSITION (first position) (second position) (third position) (fourth position)))
-  (and ambient (glLightfv id GL_AMBIENT (first ambient) (second ambient) (third ambient) (fourth ambient)))
-  (and turn-on (glEnable id))
-  id)
-

 (define* (translate x y #:optional (z 0))
   (glTranslatef x y z))
 
 (define* (rotate #:rest rot)
 (define* (translate x y #:optional (z 0))
   (glTranslatef x y z))
 
 (define* (rotate #:rest rot)

-  (cond ((3d-mode?) (apply 3d-rotate rot))
-       (else (apply 2d-rotate rot))))
+  (cond ((3d-mode?)
+        (apply 3d-rotate rot))
+       (else
+        (apply 2d-rotate rot))))

 
 (define (3d-rotate xrot yrot zrot)
   (glRotatef xrot 1 0 0)
 
 (define (3d-rotate xrot yrot zrot)
   (glRotatef xrot 1 0 0)


@@ -236,6 +342,20 @@
   (glLoadIdentity)
   (cond ((3d-mode?) (camera-look))))
 
   (glLoadIdentity)
   (cond ((3d-mode?) (camera-look))))
 

+
+;;; Lights
+
+(define* (add-light #:key light position ambient (id GL_LIGHT1) (turn-on t))
+  (init-lighting)
+  (and light (glLightfv id GL_DIFFUSE (first light) (second light) (third light) (fourth light)))
+  (and light position (glLightfv GL_POSITION (first position) (second position) (third position) (fourth position)))
+  (and ambient (glLightfv id GL_AMBIENT (first ambient) (second ambient) (third ambient) (fourth ambient)))
+  (and turn-on (glEnable id))
+  id)
+
+
+;;; Camera
+

 (define set-camera #f)
 (define camera-look #f)
 
 (define set-camera #f)
 (define camera-look #f)