diff options
Diffstat (limited to 'chickadee/graphics/texture.scm')
| -rw-r--r-- | chickadee/graphics/texture.scm | 111 |
1 files changed, 67 insertions, 44 deletions
diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm index db59585..9a8a924 100644 --- a/chickadee/graphics/texture.scm +++ b/chickadee/graphics/texture.scm @@ -1,5 +1,5 @@ ;;; Chickadee Game Toolkit -;;; Copyright © 2016 David Thompson <davet@gnu.org> +;;; Copyright © 2016, 2021 David Thompson <davet@gnu.org> ;;; ;;; Chickadee is free software: you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published @@ -25,11 +25,10 @@ #:use-module (gl) #:use-module ((gl enums) #:prefix gl:) #:use-module ((sdl2 surface) #:prefix sdl2:) - #:use-module (oop goops) #:use-module (chickadee math rect) #:use-module (chickadee graphics color) + #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) - #:use-module (chickadee graphics gpu) #:export (make-texture make-texture-region load-image @@ -48,7 +47,10 @@ texture-gl-rect texture-gl-tex-rect null-texture - apply-texture + current-texture-0 + current-texture-1 + current-texture-2 + current-texture-3 texture-atlas list->texture-atlas @@ -101,8 +103,6 @@ (%make-texture 0 #f 'linear 'linear 'repeat 'repeat 0 0 0 0 (make-rect 0.0 0.0 0.0 0.0) (make-rect 0.0 0.0 0.0 0.0))) -(define <<texture>> (class-of null-texture)) - (define (texture-null? texture) "Return #t if TEXTURE is the null texture." (eq? texture null-texture)) @@ -113,14 +113,36 @@ (define (free-texture texture) (gl-delete-texture (texture-id texture))) -(define-method (gpu-finalize (texture <<texture>>)) - (free-texture texture)) +(define (make-bind-texture n) + (lambda (texture) + (let ((texture-unit (+ (version-1-3 texture0) n))) + (set-gl-active-texture texture-unit) + (gl-bind-texture (texture-target texture-2d) + (texture-id texture))))) + +(define-graphics-finalizer texture-finalizer + #:predicate texture? + #:free free-texture) + +(define-graphics-state texture-0 + current-texture-0 + #:default null-texture + #:bind (make-bind-texture 0)) + +(define-graphics-state texture-1 + current-texture-1 + #:default null-texture + #:bind (make-bind-texture 1)) + +(define-graphics-state texture-2 + current-texture-2 + #:default null-texture + #:bind (make-bind-texture 2)) -(define (apply-texture n texture) - (let ((texture-unit (+ (version-1-3 texture0) n))) - (set-gl-active-texture texture-unit) - (gl-bind-texture (texture-target texture-2d) - (texture-id texture)))) +(define-graphics-state texture-3 + current-texture-3 + #:default null-texture + #:bind (make-bind-texture 3)) (define* (make-texture pixels width height #:key flip? @@ -147,37 +169,38 @@ clamp-to-edge. FORMAT specifies the pixel format. Currently only ('clamp-to-border (texture-wrap-mode clamp-to-border-sgis)) ('clamp-to-edge (texture-wrap-mode clamp-to-edge-sgis)))) - (let ((texture (gpu-guard - (%make-texture (gl-generate-texture) #f - min-filter mag-filter wrap-s wrap-t - 0 0 width height - (make-rect 0.0 0.0 width height) - (if flip? - (make-rect 0.0 1.0 1.0 -1.0) - (make-rect 0.0 0.0 1.0 1.0)))))) - (set-gpu-texture! (current-gpu) 0 texture) - (gl-texture-parameter (texture-target texture-2d) - (texture-parameter-name texture-min-filter) - (match min-filter - ('nearest (gl:texture-min-filter nearest)) - ('linear (gl:texture-min-filter linear)))) - (gl-texture-parameter (texture-target texture-2d) - (texture-parameter-name texture-mag-filter) - (match mag-filter - ('nearest (gl:texture-mag-filter nearest)) - ('linear (gl:texture-mag-filter linear)))) - (gl-texture-parameter (texture-target texture-2d) - (texture-parameter-name texture-wrap-s) - (gl-wrap wrap-s)) - (gl-texture-parameter (texture-target texture-2d) - (texture-parameter-name texture-wrap-t) - (gl-wrap wrap-t)) - (gl-texture-image-2d (texture-target texture-2d) - 0 (pixel-format rgba) width height 0 - (match format - ('rgba (pixel-format rgba))) - (color-pointer-type unsigned-byte) - (or pixels %null-pointer)) + (let ((texture (%make-texture (gl-generate-texture) #f + min-filter mag-filter wrap-s wrap-t + 0 0 width height + (make-rect 0.0 0.0 width height) + (if flip? + (make-rect 0.0 1.0 1.0 -1.0) + (make-rect 0.0 0.0 1.0 1.0))))) + (graphics-engine-guard! texture) + (with-graphics-state ((texture-0 texture)) + (graphics-engine-commit!) + (gl-texture-parameter (texture-target texture-2d) + (texture-parameter-name texture-min-filter) + (match min-filter + ('nearest (gl:texture-min-filter nearest)) + ('linear (gl:texture-min-filter linear)))) + (gl-texture-parameter (texture-target texture-2d) + (texture-parameter-name texture-mag-filter) + (match mag-filter + ('nearest (gl:texture-mag-filter nearest)) + ('linear (gl:texture-mag-filter linear)))) + (gl-texture-parameter (texture-target texture-2d) + (texture-parameter-name texture-wrap-s) + (gl-wrap wrap-s)) + (gl-texture-parameter (texture-target texture-2d) + (texture-parameter-name texture-wrap-t) + (gl-wrap wrap-t)) + (gl-texture-image-2d (texture-target texture-2d) + 0 (pixel-format rgba) width height 0 + (match format + ('rgba (pixel-format rgba))) + (color-pointer-type unsigned-byte) + (or pixels %null-pointer))) texture)) (define (make-texture-region texture rect) |