Stretch scene

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
+++ b/examples/04-stretch-images/04-stretch-images.scm
@@ -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

diff --git a/gacela/image.scm b/gacela/image.scm
index 40d407560a0b4a06e2aa2f26087569e3dd98a215..1fa861f09b440746c45c3a11d82dfa3d4352f3a1 100644 (file)
--- a/gacela/image.scm
+++ b/gacela/image.scm
@@ -24,7 +24,8 @@
   #:use-module ((sdl2 surface) #:prefix sdl2:)
   #:use-module (gl)
   #:export (bitmap
   #:use-module ((sdl2 surface) #:prefix sdl2:)
   #:use-module (gl)
   #:export (bitmap

-            move-xy))
+            move-xy
+            stretch))

 
 (define (bitmap filename)
   (make-scene
 
 (define (bitmap filename)
   (make-scene


@@ -33,7 +34,7 @@
          (texture #f)
          (w/2 0)
          (h/2 0))
          (texture #f)
          (w/2 0)
          (h/2 0))

-     (lambda* ()
+     (lambda ()

        (when (not texture)
          (set! texture (sdl2:surface->texture %sdl-renderer image))
          (set! w/2 (/ (sdl2:surface-width image) 2))
        (when (not texture)
          (set! texture (sdl2:surface->texture %sdl-renderer image))
          (set! w/2 (/ (sdl2:surface-width image) 2))


@@ -60,3 +61,10 @@
      (let ((xy (list (to-integer (if (procedure? x) (x) x))
                      (to-integer (if (procedure? y) (y) y)))))
        (display-scene scene #:xy xy)))))
      (let ((xy (list (to-integer (if (procedure? x) (x) x))
                      (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))))