#! /usr/local/bin/scsh \ -ll sunterlib.scm -m tiff-testbed -s !# ;**************************************************************************** ; Validate the TIFF reading package ; ; We test reading of a known TIFF file, print out its directory. ; We also test an internal consistency of the package. ; ; Derived from vtiff.scm 1.1 2003/09/29 20:41:51 oleg ; Note: some tests below depend on the exact parameters ; of the following sample file ; The file is a GNU logo (from http://www.gnu.org) ; converted from JPG to TIFF (define sample-tiff-file "gnu-head-sm.tif") (cerr nl "Verifying the TIFF library" nl) (cerr nl "Verifying tagdict operations..." nl) (let () (assert (= 256 (tagdict-get-by-name tiff-standard-tagdict 'TIFFTAG:IMAGEWIDTH))) (assert (eq? 'TIFFTAG:IMAGEWIDTH (tagdict-get-by-num tiff-standard-tagdict 256))) (assert (eq? #f (tagdict-get-by-num tiff-standard-tagdict 65500))) (assert (= 5 (tagdict-tagval-get-by-name tiff-standard-tagdict 'TIFFTAG:COMPRESSION 'LZW))) (assert (eq? 'LZW (tagdict-tagval-get-by-num tiff-standard-tagdict 'TIFFTAG:COMPRESSION 5))) (assert (eq? #f (tagdict-tagval-get-by-num tiff-standard-tagdict 'TIFFTAG:COMPRESSION 65500))) (let ((ext-dict (tagdict-add-all tiff-standard-tagdict (make-tagdict '((WAupper_left_lat 33004) (WAhemisphere 33003 (North . 1) (South . 2))))))) (assert (= 33004 (tagdict-get-by-name ext-dict 'WAupper_left_lat))) (assert (eq? 'WAupper_left_lat (tagdict-get-by-num ext-dict 33004))) (assert (eq? 'TIFFTAG:PHOTOMETRIC (tagdict-get-by-num ext-dict 262))) (assert (eq? #f (tagdict-tagval-get-by-num ext-dict 'WAupper_left_lat 0))) (assert (= 1 (tagdict-tagval-get-by-name ext-dict 'WAhemisphere 'North))) (assert (eq? 'South (tagdict-tagval-get-by-num ext-dict 'WAhemisphere 2)))) ) (define (test-dictionary-consistency tiff-dict) (cerr nl "Verifying the consistency of dictionary operations ..." nl) (assert (tiff-directory? tiff-dict)) (assert (positive? (tiff-directory-size tiff-dict)) (not (tiff-directory-empty? tiff-dict))) (assert (= (tiff-directory-get tiff-dict 'TIFFTAG:IMAGEWIDTH) (tiff-directory-get tiff-dict 256))) (assert (eq? #f (tiff-directory-get tiff-dict 65500))) (let ((not-given (list 'not-given))) (assert (eq? not-given (tiff-directory-get tiff-dict 65500 (lambda () not-given))))) (let ((size (tiff-directory-size tiff-dict))) (call-with-values (lambda () (tiff-directory-fold-left tiff-dict (lambda (el count) (values #t (+ 1 count))) 0)) (lambda (size-via-fold) (assert (= size size-via-fold))))) (let*-values (((len) (tiff-directory-get tiff-dict 'TIFFTAG:IMAGELENGTH)) ((len-via-fold prev-count) (tiff-directory-fold-left tiff-dict (lambda (dir-entry found prev-count) (if (= (tiff-dir-entry-tag dir-entry) 257) (values #f (force (tiff-dir-entry-value dir-entry)) prev-count) ; and terminate now (values #t #f (+ 1 prev-count)))) #f 0))) (assert (= len len-via-fold) (< 0 prev-count (tiff-directory-size tiff-dict)))) ) (define (test-known-values-from-dict tiff-dict) (cerr nl "Getting sample data from the dictionary ") (let ((known-values '((TIFFTAG:IMAGEWIDTH . 129) (TIFFTAG:IMAGELENGTH . 122) (TIFFTAG:BITSPERSAMPLE . 8) (TIFFTAG:IMAGEDESCRIPTION . "JPEG:gnu-head-sm.jpg 129x122") (TIFFTAG:COMPRESSION . 1) (TIFFTAG:SAMPLESPERPIXEL . 1) (TIFFTAG:STRIPBYTECOUNTS . 15738) ; the product of width and length (TIFFTAG:XRESOLUTION . 72) (TIFFTAG:CLEANFAXDATA . #f)))) (for-each (lambda (tag-val) (cerr "Tag " (car tag-val) "...") (let ((real (tiff-directory-get tiff-dict (car tag-val)))) (cerr real nl) (assert (equal? real (cdr tag-val))))) known-values )) (assert (eq? 'NONE (tiff-directory-get-as-symbol tiff-dict 'TIFFTAG:COMPRESSION))) ) (define (test-reading-pixel-matrix tiff-dict eport) (cerr nl "Reading the pixel matrix and spot-checking it ...") ; Make sure we can handle this particular TIFF image ; No compression (assert (eq? 'NONE (tiff-directory-get-as-symbol tiff-dict 'TIFFTAG:COMPRESSION))) (assert (= 1 (tiff-directory-get tiff-dict 'TIFFTAG:SAMPLESPERPIXEL))) (assert (= 8 (tiff-directory-get tiff-dict 'TIFFTAG:BITSPERSAMPLE))) (let* ((ncols (tiff-directory-get tiff-dict 'TIFFTAG:IMAGEWIDTH)) (_ (assert (number? ncols) (positive? ncols))) (nrows (tiff-directory-get tiff-dict 'TIFFTAG:IMAGELENGTH)) (_ (assert (number? nrows) (positive? nrows))) (rows-per-strip (tiff-directory-get tiff-dict 'TIFFTAG:ROWSPERSTRIP (lambda () nrows))) (_ (assert (positive? rows-per-strip))) (strip-offsets (tiff-directory-get tiff-dict 'TIFFTAG:STRIPOFFSETS (lambda () (error "STRIPOFFSETS must be present!")))) ; make it a u32vector (strip-offsets (cond ((u32vector? strip-offsets) strip-offsets) ((u16vector? strip-offsets) (list->u32vector (u16vector->list strip-offsets))) (else (u32vector strip-offsets)))) (image-size (* nrows ncols)) (strip-size (* rows-per-strip ncols)) (image (make-u8vector image-size 0)) ) (cerr nl "Loading the image matrix of the size " image-size " bytes...") (let outer ((strip 0) (i 0)) (if (>= strip (u32vector-length strip-offsets)) #f (let ((i-end (min (+ i strip-size) image-size))) (endian-port-setpos eport (u32vector-ref strip-offsets strip)) (let inner ((i i)) (if (>= i i-end) (outer (++ strip) i) (begin (u8vector-set! image i (endian-port-read-int1 eport)) (inner (++ i)))))))) (assert (= 255 (u8vector-ref image 0)) (= 248 (u8vector-ref image 17))) ;(display image) )) (cerr nl "Reading the sample TIFF file " sample-tiff-file "..." nl) (let* ((eport (make-endian-port (open-input-file sample-tiff-file) #t)) (tiff-dict (read-tiff-file eport))) (print-tiff-directory tiff-dict (current-output-port)) (test-known-values-from-dict tiff-dict) (test-dictionary-consistency tiff-dict) (test-reading-pixel-matrix tiff-dict eport) ) (cerr nl "All tests passed" nl)