summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sly/wrappers/gl.scm30
1 files changed, 25 insertions, 5 deletions
diff --git a/sly/wrappers/gl.scm b/sly/wrappers/gl.scm
index 4d5afcc..66b08cf 100644
--- a/sly/wrappers/gl.scm
+++ b/sly/wrappers/gl.scm
@@ -23,7 +23,11 @@
;;; Code:
(define-module (sly wrappers gl)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-4)
+ #:use-module ((system foreign) #:select (bytevector->pointer))
#:use-module ((gl low-level) #:renamer (symbol-prefix-proc '%))
+ #:use-module (gl enums)
#:use-module (gl runtime)
#:use-module (gl types))
@@ -68,13 +72,29 @@
(re-export (%glTexParameteri . gl-texture-parameter))
+(define gl-current-texture
+ (let ((binding-map (list (cons (texture-target texture-1d)
+ (get-p-name texture-binding-1d))
+ (cons (texture-target texture-2d)
+ (get-p-name texture-binding-2d))
+ (cons (texture-target texture-3d-ext)
+ (get-p-name texture-binding-3d)))))
+ (lambda (target)
+ "Return the id of the currently bound texture."
+ (let ((bv (make-s32vector 1)))
+ (%glGetIntegerv (assoc-ref binding-map target)
+ (bytevector->pointer bv))
+ (s32vector-ref bv 0)))))
+
;; emacs: (put 'with-gl-bind-texture 'scheme-indent-function 2)
(define-syntax-rule (with-gl-bind-texture target id body ...)
- (begin
- (%glBindTexture target id)
- body
- ...
- (%glBindTexture target 0)))
+ (let ((old-id (gl-current-texture target)))
+ (if (= id old-id)
+ (begin body ...)
+ (begin
+ (%glBindTexture target id)
+ body ...
+ (%glBindTexture target old-id)))))
(export with-gl-bind-texture)