]> git.jsancho.org Git - gacela.git/commitdiff
Merge branch 'release/0.4'
authorJavier Sancho <jsf@jsancho.org>
Tue, 18 Apr 2017 18:13:30 +0000 (20:13 +0200)
committerJavier Sancho <jsf@jsancho.org>
Tue, 18 Apr 2017 18:13:30 +0000 (20:13 +0200)
examples/04-stretch-images/04-stretch-images.scm [new file with mode: 0644]
examples/04-stretch-images/stretch.bmp [new file with mode: 0755]
gacela/game.scm
gacela/image.scm
gacela/scene.scm

diff --git a/examples/04-stretch-images/04-stretch-images.scm b/examples/04-stretch-images/04-stretch-images.scm
new file mode 100644 (file)
index 0000000..e23daef
--- /dev/null
@@ -0,0 +1,26 @@
+#!/usr/bin/env guile
+!#
+
+;;; Gacela, a GNU Guile extension for fast games development
+;;; Copyright (C) 2017 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (gacela))
+
+(display-scene
+ (window ((resolution '(640 480)))
+   (stretch
+    (bitmap "stretch.bmp")
+    2)))
diff --git a/examples/04-stretch-images/stretch.bmp b/examples/04-stretch-images/stretch.bmp
new file mode 100755 (executable)
index 0000000..8457f19
Binary files /dev/null and b/examples/04-stretch-images/stretch.bmp differ
index fe5f0b3a1cfdc993d413ee9371f29c02b04a7fc0..326db782c7651c0bd80cd71524d75db467e7b78b 100644 (file)
@@ -56,8 +56,7 @@ instead of becoming completely unresponsive and possibly crashing."
     (define (draw dt alpha)
       "Render a frame."
       (let ((size (sdl2:window-size %sdl-window)))
-       (gl-viewport 0 0 (car size) (cadr size)))
-      (gl-clear (clear-buffer-mask color-buffer depth-buffer))
+        (resize-window (car size) (cadr size)))
       (if %root-scene
          (%root-scene))
       ;;(run-hook draw-hook dt alpha)
@@ -139,14 +138,22 @@ milliseconds of the last iteration of the game loop."
 
 (define (init-window)
   (sdl2:sdl-init)
-  (set! %sdl-window (sdl2:make-window #:opengl? #t #:show? #t))
-  (set! %sdl-renderer (sdl2:make-renderer %sdl-window))
   (sdl2:set-gl-attribute! 'context-major-version 3)
   (sdl2:set-gl-attribute! 'context-minor-version 2)
   (sdl2:set-gl-attribute! 'double-buffer 1)
   (sdl2:set-gl-attribute! 'depth-size 24)
+  (set! %sdl-window (sdl2:make-window #:opengl? #t #:show? #t))
+  (set! %sdl-renderer (sdl2:make-renderer %sdl-window))
   (set! %gl-context (sdl2:make-gl-context %sdl-window))
-  (sdl2:set-gl-swap-interval! 'vsync))
+  (sdl2:set-gl-swap-interval! 'vsync)
+  (init-gl))
+
+(define (init-gl)
+  (set-gl-matrix-mode (matrix-mode projection))
+  (gl-load-identity)
+  (set-gl-matrix-mode (matrix-mode modelview))
+  (gl-load-identity)
+  (set-gl-clear-color 0 0 0 1))
 
 (define (open-window title resolution fullscreen?)
   (sdl2:set-window-title! %sdl-window title)
@@ -158,6 +165,17 @@ milliseconds of the last iteration of the game loop."
   (sdl2:hide-window! %sdl-window)
   (sdl2:sdl-quit))
 
+(define (resize-window width height)
+  (gl-viewport 0 0 width height)
+  (set-gl-matrix-mode (matrix-mode projection))
+  (gl-load-identity)
+  (let ((w (/ width 2))
+        (h (/ height 2)))
+    (gl-ortho (- w) w (- h) h 0 1))
+  (set-gl-matrix-mode (matrix-mode modelview))
+  (gl-clear (clear-buffer-mask color-buffer depth-buffer))
+  (gl-load-identity))
+
 (define* (start-game scene #:key
                    (title "Untitled")
                    (resolution '(640 480))
index b1ee674bbe501fe38e8b514277665d49c3c2485d..1fa861f09b440746c45c3a11d82dfa3d4352f3a1 100644 (file)
   #:use-module ((sdl2 image) #:prefix sdl2:)
   #:use-module ((sdl2 render) #:prefix sdl2:)
   #:use-module ((sdl2 surface) #:prefix sdl2:)
+  #:use-module (gl)
   #:export (bitmap
-           move-xy))
+            move-xy
+            stretch))
 
 (define (bitmap filename)
   (make-scene
    "bitmap"
    (let ((image (sdl2:load-image filename))
-        (texture #f))
-     (let ((a 0))
-       (lambda* (#:key (xy '(0 0)))
-        (if (not texture)
-            (set! texture (sdl2:surface->texture %sdl-renderer image)))
-        (sdl2:clear-renderer %sdl-renderer)
-        (sdl2:render-copy %sdl-renderer texture #:dest-rect (sdl2:make-rect (car xy) (cadr xy) (sdl2:surface-width image) (sdl2:surface-height image)))
-        (sdl2:present-renderer %sdl-renderer))))))
+         (texture #f)
+         (w/2 0)
+         (h/2 0))
+     (lambda ()
+       (when (not texture)
+         (set! texture (sdl2:surface->texture %sdl-renderer image))
+         (set! w/2 (/ (sdl2:surface-width image) 2))
+         (set! h/2 (/ (sdl2:surface-height image) 2)))
+       (gl-enable (oes-framebuffer-object texture-2d))
+       (sdl2:bind-texture texture)
+       (gl-begin (begin-mode quads)
+         (gl-texture-coordinates 0 0)
+         (gl-vertex (- w/2) h/2 0)
+         (gl-texture-coordinates 1 0)
+         (gl-vertex w/2 h/2 0)
+         (gl-texture-coordinates 1 1)
+         (gl-vertex w/2 (- h/2) 0)
+         (gl-texture-coordinates 0 1)
+         (gl-vertex (- w/2) (- h/2) 0))
+       (gl-disable (oes-framebuffer-object texture-2d))))))
 
 (define (move-xy x y scene)
   (define (to-integer n)
    "move-xy"
    (lambda ()
      (let ((xy (list (to-integer (if (procedure? x) (x) x))
-                    (to-integer (if (procedure? y) (y) y)))))
+                     (to-integer (if (procedure? y) (y) y)))))
        (display-scene scene #:xy xy)))))
+
+(define* (stretch scene x #:optional (y x) (z y))
+  (make-scene
+   "stretch"
+   (lambda ()
+     (gl-scale x y z)
+     (display-scene scene))))
index f3803cdf7b4a2cf197a571dcee5d1c6615f400d9..4b66a1e9731048631add71edd5f9e255a89e44ea 100644 (file)
@@ -20,8 +20,8 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:export (make-scene
-           display-scene
-           run-scene))
+            display-scene
+            run-scene))
 
 
 ;;; Scene Type
@@ -48,8 +48,8 @@
 
 (define (run-scene scene . args)
   (apply start-game
-        (cons
-         (if (scene? scene)
-             (scene-procedure scene)
-             scene)
-         args)))
+         (cons
+          (if (scene? scene)
+              (scene-procedure scene)
+              scene)
+          args)))