summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/texture.scm38
1 files changed, 17 insertions, 21 deletions
diff --git a/2d/texture.scm b/2d/texture.scm
index 4702029..76c5b92 100644
--- a/2d/texture.scm
+++ b/2d/texture.scm
@@ -25,9 +25,9 @@
(define-module (2d texture)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-42)
- #:use-module ((sdl sdl) #:prefix SDL:)
#:use-module (figl gl)
#:use-module (2d wrappers gl)
+ #:use-module (2d wrappers freeimage)
#:use-module (2d helpers)
#:export (make-texture
make-texture-region
@@ -103,19 +103,10 @@
(add-hook! after-gc-hook reap-textures)
-(define (surface-pixel-format surface)
- "Returns the OpenGL pixel format for a surface. RGB and RGBA formats
-are supported."
- (case (SDL:surface:depth surface)
- ((24) (pixel-format rgb))
- ((32) (pixel-format rgba))
- (else (throw 'unsupported-pixel-format (SDL:surface:depth surface)))))
-
-(define (surface->texture surface)
- "Translates an SDL surface into an OpenGL texture.
-Currently only works with RGBA format surfaces."
+(define (bitmap->texture bitmap)
+ "Translates a freeimage bitmap into an OpenGL texture."
(let ((texture-id (gl-generate-texture))
- (pixel-format (surface-pixel-format surface)))
+ (pixels (freeimage-get-bits bitmap)))
(with-gl-bind-texture (texture-target texture-2d) texture-id
(gl-texture-parameter (texture-target texture-2d)
(texture-parameter-name texture-min-filter)
@@ -125,22 +116,27 @@ Currently only works with RGBA format surfaces."
(texture-mag-filter linear))
(gl-texture-image-2d (texture-target texture-2d)
0
- pixel-format
- (SDL:surface:w surface)
- (SDL:surface:h surface)
+ (pixel-format rgba)
+ (freeimage-get-width bitmap)
+ (freeimage-get-height bitmap)
0
- pixel-format
+ (version-1-2 bgra)
(color-pointer-type unsigned-byte)
- (SDL:surface-pixels surface)))
+ pixels))
(make-texture texture-id
#f
- (SDL:surface:w surface)
- (SDL:surface:h surface)
+ (freeimage-get-width bitmap)
+ (freeimage-get-height bitmap)
0 0 1 1)))
(define (load-texture filename)
"Loads a texture from a file."
- (surface->texture (SDL:load-image filename)))
+ (let* ((bitmap (freeimage-load (freeimage-get-file-type filename) filename))
+ (32bit-bitmap (freeimage-convert-to-32-bits bitmap))
+ (texture (bitmap->texture 32bit-bitmap)))
+ (freeimage-unload bitmap)
+ (freeimage-unload 32bit-bitmap)
+ texture))
(define* (draw-texture texture x y #:optional (color #xffffffff))
"Renders a textured quad in GL immediate mode."