From: Javier Sancho Date: Tue, 18 Apr 2017 18:08:55 +0000 (+0200) Subject: Stretch scene X-Git-Url: https://git.jsancho.org/?a=commitdiff_plain;h=cb3f530e232d5f72e971df88613daf17ccbac445;p=gacela.git 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 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 +;;; +;;; 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 . + +(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 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 40d4075..1fa861f 100644 --- a/gacela/image.scm +++ b/gacela/image.scm @@ -24,7 +24,8 @@ #:use-module ((sdl2 surface) #:prefix sdl2:) #:use-module (gl) #:export (bitmap - move-xy)) + move-xy + stretch)) (define (bitmap filename) (make-scene @@ -33,7 +34,7 @@ (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)) @@ -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))))) + +(define* (stretch scene x #:optional (y x) (z y)) + (make-scene + "stretch" + (lambda () + (gl-scale x y z) + (display-scene scene))))