summaryrefslogtreecommitdiff
path: root/chickadee/image/jpeg.scm
diff options
context:
space:
mode:
Diffstat (limited to 'chickadee/image/jpeg.scm')
-rw-r--r--chickadee/image/jpeg.scm45
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