From 8f33c32a7b23d245493f0879d181ab6661d64a2d Mon Sep 17 00:00:00 2001
From: Javier Sancho <jsf@jsancho.org>
Date: Wed, 12 Apr 2017 18:40:48 +0200
Subject: [PATCH] Display images using OpenGL and textures
---
gacela/game.scm | 28 +++++++++++++++++++++++-----
gacela/image.scm | 29 +++++++++++++++++++++--------
2 files changed, 44 insertions(+), 13 deletions(-)
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 cd0d273..40d4075 100644
--- a/gacela/image.scm
+++ b/gacela/image.scm
@@ -22,6 +22,7 @@
#: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))
@@ -29,14 +30,26 @@
(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)
--
2.39.5