From 16d496e2c27e6f8416ed42851a5561c48fccd88f Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 4 Jan 2023 08:58:46 -0500 Subject: image: png: Fix completely broken libpng warning/error printing. Ugh! Thanks to ArneBab for trying to load a PNG file that exposed this issue. --- chickadee/image/png.scm | 16 ++++++++-------- 1 file 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? 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) -- cgit v1.2.3