diff options
author | David Thompson <dthompson2@worcester.edu> | 2023-01-04 08:58:46 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2023-01-04 08:58:46 -0500 |
commit | 16d496e2c27e6f8416ed42851a5561c48fccd88f (patch) | |
tree | 97e3877b8e87121b91300700aaa40d14ddc92f52 | |
parent | aea73cea36a93078810bcdbcef3f67e43931e5d3 (diff) |
image: png: Fix completely broken libpng warning/error printing.
Ugh!
Thanks to ArneBab for trying to load a PNG file that exposed this
issue.
-rw-r--r-- | chickadee/image/png.scm | 16 |
1 files changed, 8 insertions, 8 deletions
diff --git a/chickadee/image/png.scm b/chickadee/image/png.scm index 6cdbc14..938dede 100644 --- a/chickadee/image/png.scm +++ b/chickadee/image/png.scm @@ -121,13 +121,13 @@ (define-wrapped-pointer-type <png-info-struct> png-info-struct? wrap-png-info-struct unwrap-png-info-struct display-png-info-struct) -(define (on-error read-struct message) - (display (current-error-port) message)) - -(define (on-warning read-struct message) - (display (current-error-port) message)) - -(define (create-read-struct) +(define (create-read-struct file-name) + (define (on-error read-struct message) + (format (current-error-port) "libpng error: ~a: ~a\n" + file-name (pointer->string message))) + (define (on-warning read-struct message) + (format (current-error-port) "libpng warning: ~a: ~a\n" + file-name (pointer->string message))) (let ((ptr (png-create-read-struct (string->pointer %libpng-version) %null-pointer (procedure->pointer void on-error '(* *)) @@ -326,7 +326,7 @@ (if (file-exists? file-name) (call-with-input-file file-name (lambda (port) - (let* ((read-struct (create-read-struct)) + (let* ((read-struct (create-read-struct file-name)) (info-struct (create-info-struct read-struct))) (dynamic-wind (lambda () #t) |