diff options
Diffstat (limited to 'chickadee/image/jpeg.scm')
-rw-r--r-- | chickadee/image/jpeg.scm | 45 |
1 files 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 <header> + (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 "#<tjhandle>" 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 <header>))) + (unless (zero? + (tj-decompress-header3 + (unwrap-tjhandle handle) + (bytevector->pointer buffer) + (bytevector-length buffer) + (bytestruct-&ref <header> (width) header) + (bytestruct-&ref <header> (height) header) + (bytestruct-&ref <header> (jpeg-subsamp) header) + (bytestruct-&ref <header> (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 |