diff options
Diffstat (limited to 'chickadee/graphics/texture.scm')
| -rw-r--r-- | chickadee/graphics/texture.scm | 92 |
1 files changed, 25 insertions, 67 deletions
diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm index 65b7300..86702a3 100644 --- a/chickadee/graphics/texture.scm +++ b/chickadee/graphics/texture.scm @@ -29,6 +29,7 @@ #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics pixbuf) #:use-module (chickadee image) #:use-module (chickadee utils) @@ -45,6 +46,7 @@ texture-region? cube-map? texture-null? + texture-id texture-type texture-parent texture-min-filter @@ -113,7 +115,7 @@ (set-record-type-printer! <texture> (lambda (texture port) (format port - "#<texture id: ~d region?: ~a x: ~d y: ~d width: ~d height: ~d min-filter: ~a mag-filter: ~a wrap-s: ~a wrap-t: ~a>" + "#<texture id: ~s region?: ~a x: ~d y: ~d width: ~d height: ~d min-filter: ~a mag-filter: ~a wrap-s: ~a wrap-t: ~a>" (texture-id texture) (texture-region? texture) (texture-x texture) @@ -126,7 +128,7 @@ (texture-wrap-t texture)))) (define null-texture - (%make-texture 0 '2d #f 'linear 'linear 'repeat 'repeat 0 0 0 0 + (%make-texture gpu-texture:null '2d #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-null? texture) @@ -139,9 +141,6 @@ (define (cube-map? texture) (and (texture? texture) (eq? (texture-type texture) 'cube-map))) -(define (free-texture texture) - (gl-delete-texture (texture-id texture))) - (define (gl-texture-target type) (case type ((2d) @@ -149,47 +148,6 @@ ((cube-map) (version-1-3 texture-cube-map)))) -(define (make-bind-texture n) - (lambda (texture) - (let ((texture-unit (+ (version-1-3 texture0) n))) - (set-gl-active-texture texture-unit) - (gl-bind-texture (gl-texture-target (texture-type texture)) - (texture-id texture))))) - -(define-graphics-finalizer texture-finalizer - #:predicate texture? - #:free free-texture) - -(define-graphics-state g:texture-0 - current-texture-0 - #:default null-texture - #:bind (make-bind-texture 0)) - -(define-graphics-state g:texture-1 - current-texture-1 - #:default null-texture - #:bind (make-bind-texture 1)) - -(define-graphics-state g:texture-2 - current-texture-2 - #:default null-texture - #:bind (make-bind-texture 2)) - -(define-graphics-state g:texture-3 - current-texture-3 - #:default null-texture - #:bind (make-bind-texture 3)) - -(define-graphics-state g:texture-4 - current-texture-4 - #:default null-texture - #:bind (make-bind-texture 4)) - -(define-graphics-state g:texture-5 - current-texture-5 - #:default null-texture - #:bind (make-bind-texture 5)) - (define (gl-wrap-mode mode) (case mode ((repeat) @@ -248,15 +206,15 @@ Allowed symbols are: repeat (the default), mirrored-repeat, clamp, clamp-to-border, clamp-to-edge. FORMAT specifies the pixel format. Currently only 32-bit RGBA format is supported." (assert-current-graphics-engine) - (let ((texture (%make-texture (gl-generate-texture) '2d #f + (let ((texture (%make-texture (fresh-gpu-texture (current-gpu) '2d) + '2d #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! ((g:texture-0 texture)) + (with-graphics-state! ((texture 0 (texture-id texture))) ;; Ensure that we are using texture unit 0 because ;; with-graphics-state! doesn't guarantee it. (set-gl-active-texture (version-1-3 texture0)) @@ -283,8 +241,8 @@ Currently only 32-bit RGBA format is supported." linear-mipmap-nearest nearest-mipmap-linear linear-mipmap-linear)) - (gl-generate-mipmap (texture-target texture-2d)))) - texture)) + (gl-generate-mipmap (texture-target texture-2d))) + texture))) (define* (pixbuf->texture pixbuf #:key flip? @@ -298,15 +256,15 @@ Currently only 32-bit RGBA format is supported." (assert-current-graphics-engine) (let* ((width (pixbuf-width pixbuf)) (height (pixbuf-height pixbuf)) - (texture (%make-texture (gl-generate-texture) '2d #f + (texture (%make-texture (fresh-gpu-texture (current-gpu) '2d) + '2d #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! ((g:texture-0 texture)) + (with-graphics-state! ((texture 0 (texture-id texture))) ;; Ensure that we are using texture unit 0 because ;; with-graphics-state! doesn't guarantee it. (set-gl-active-texture (version-1-3 texture0)) @@ -333,8 +291,8 @@ Currently only 32-bit RGBA format is supported." linear-mipmap-nearest nearest-mipmap-linear linear-mipmap-linear)) - (gl-generate-mipmap (texture-target texture-2d)))) - texture)) + (gl-generate-mipmap (texture-target texture-2d))) + texture))) (define* (make-cube-map #:key right left top bottom front back @@ -364,12 +322,12 @@ Currently only 32-bit RGBA format is supported." (color-pointer-type unsigned-byte) (pixbuf-pixels pixbuf))) (assert-current-graphics-engine) - (let ((texture (%make-texture (gl-generate-texture) 'cube-map #f + (let ((texture (%make-texture (fresh-gpu-texture (current-gpu) 'cube-map) + 'cube-map #f min-filter mag-filter 'clamp-to-edge 'clamp-to-edge 0 0 0 0 #f #f))) - (graphics-engine-guard! texture) - (with-graphics-state! ((g:texture-0 texture)) + (with-graphics-state! ((texture 0 (texture-id texture))) ;; Ensure that we are using texture unit 0 because ;; with-graphics-state! doesn't guarantee it. (set-gl-active-texture (version-1-3 texture0)) @@ -400,8 +358,8 @@ Currently only 32-bit RGBA format is supported." linear-mipmap-nearest nearest-mipmap-linear linear-mipmap-linear)) - (gl-generate-mipmap (gl-texture-target 'cube-map)))) - texture)) + (gl-generate-mipmap (gl-texture-target 'cube-map))) + texture))) (define (make-texture-region texture rect) "Create a new texture region covering a section of TEXTURE defined @@ -483,12 +441,12 @@ are 'nearest and 'linear. By default, 'nearest is used." (let* ((w (texture-width texture)) (h (texture-height texture)) (pixels (make-bytevector (* w h 4) 0))) - (with-graphics-state! ((g:texture-0 texture)) - (gl-get-tex-image (texture-target texture-2d) - 0 - (gl-pixel-format 'rgba) - (color-pointer-type unsigned-byte) - (bytevector->pointer pixels))) + (set-gpu-texture! (current-gpu) 0 texture) + (gl-get-tex-image (texture-target texture-2d) + 0 + (gl-pixel-format 'rgba) + (color-pointer-type unsigned-byte) + (bytevector->pointer pixels)) (let ((pixbuf (bytevector->pixbuf pixels w h #:format 'rgba #:bit-depth 8))) |