From: Javier Sancho Date: Tue, 18 Apr 2017 18:09:49 +0000 (+0200) Subject: Merge branch 'feature/stretch-images' into develop X-Git-Url: https://git.jsancho.org/?p=gacela.git;a=commitdiff_plain;h=58fd4b161304ba4fe37581a4bb9e83547a35f40b;hp=553ee324ccbd833eea5f2003ec9d55badd09f3b8 Merge branch 'feature/stretch-images' into develop --- 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/game.scm b/gacela/game.scm index fe5f0b3..326db78 100644 --- a/gacela/game.scm +++ b/gacela/game.scm @@ -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)) diff --git a/gacela/image.scm b/gacela/image.scm index b1ee674..1fa861f 100644 --- a/gacela/image.scm +++ b/gacela/image.scm @@ -22,21 +22,35 @@ #: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) @@ -45,5 +59,12 @@ "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)))) diff --git a/gacela/scene.scm b/gacela/scene.scm index f3803cd..4b66a1e 100644 --- a/gacela/scene.scm +++ b/gacela/scene.scm @@ -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)))