summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-01-04 08:58:46 -0500
committerDavid Thompson <dthompson2@worcester.edu>2023-01-04 08:58:46 -0500
commit16d496e2c27e6f8416ed42851a5561c48fccd88f (patch)
tree97e3877b8e87121b91300700aaa40d14ddc92f52
parentaea73cea36a93078810bcdbcef3f67e43931e5d3 (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.scm16
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)