From 8759cc51f11ca1750cab66374026befafed71238 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 15 Feb 2024 08:35:35 -0500 Subject: image: jpeg: Use bytestruct for header data. --- chickadee/image/jpeg.scm | 45 +++++++++++++++++++++++++++------------------ 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/chickadee/image/jpeg.scm b/chickadee/image/jpeg.scm index 98a7189..c19fa6c 100644 --- a/chickadee/image/jpeg.scm +++ b/chickadee/image/jpeg.scm @@ -21,6 +21,7 @@ (define-module (chickadee image jpeg) #:use-module (chickadee config) + #:use-module (chickadee data bytestruct) #:use-module (ice-9 binary-ports) #:use-module (ice-9 exceptions) #:use-module (ice-9 format) @@ -82,6 +83,14 @@ ;;; High-level bindings ;;; +(define-byterecord-type
+ (make-header) + header? + (width int header-width) + (height int header-height) + (jpeg-subsamp int header-jpeg-subsamp) + (jpeg-colorspace int header-jpeg-colorspace)) + (define (display-tjhandle handle port) (display "#" port)) @@ -103,19 +112,18 @@ (tj-destroy (unwrap-tjhandle handle))) (define (decompress-headers handle buffer) - (let ((result (make-s32vector 4))) - (unless (zero? (tj-decompress-header3 (unwrap-tjhandle handle) - (bytevector->pointer buffer) - (bytevector-length buffer) - (bytevector->pointer result) - (bytevector->pointer result 4) - (bytevector->pointer result 8) - (bytevector->pointer result 12))) + (let ((header (bytestruct-alloc
))) + (unless (zero? + (tj-decompress-header3 + (unwrap-tjhandle handle) + (bytevector->pointer buffer) + (bytevector-length buffer) + (bytestruct-&ref
(width) header) + (bytestruct-&ref
(height) header) + (bytestruct-&ref
(jpeg-subsamp) header) + (bytestruct-&ref
(jpeg-colorspace) header))) (check-error handle)) - (values (s32vector-ref result 0) - (s32vector-ref result 1) - (s32vector-ref result 2) - (s32vector-ref result 3)))) + header)) (define (decompress handle buffer width pitch height pixel-format flags) (let ((bv (make-bytevector (* pitch height)))) @@ -134,12 +142,13 @@ (dynamic-wind (lambda () #t) (lambda () - (let-values (((width height subsamples color-space) - (decompress-headers handle buffer))) - (let ((pitch (* width 4))) - (values (decompress handle buffer width pitch height - TJPF_RGBA 0) ; TJFLAG_BOTTOMUP - width height)))) + (let* ((header (decompress-headers handle buffer)) + (width (header-width header)) + (height (header-height header)) + (pitch (* width 4))) + (values (decompress handle buffer width pitch height + TJPF_RGBA 0) ; TJFLAG_BOTTOMUP + width height))) (lambda () (destroy-handle handle)))) (raise-exception -- cgit v1.2.3