1# This file is a Tcl script to test out RAW reading and writing.
2# It is organized in the standard fashion for Tcl tests.
3
4package require Tk
5
6package require tcltest
7tcltest::configure {*}$argv
8source [file join [file dirname [info script]] constraints.tcl]
9
10package require Img
11package require img::raw
12
13imageInit
14
15namespace eval ::raw::test {
16    namespace import ::tcltest::*
17
18    set fmt  "raw -useheader true -nomap true -nchan 3"
19    set ext  "raw"
20    set file "testimgs/img.$ext"
21
22    # Encoded image content.
23    source $file.base64
24
25    test raw-1.1 {} -setup {
26        catch {image delete i}
27    } -body {
28        image create photo i -file $file
29        i data -format $fmt
30    } -cleanup {
31        image delete i
32    } -result $imgdata
33
34    test raw-1.2 {} -setup {
35        catch {image delete i}
36    } -body {
37        image create photo i -data $imgdata
38        i data -format $fmt
39    } -cleanup {
40        image delete i
41    } -result $imgdata
42
43    test raw-1.3 {} -setup {
44        catch {image delete i}
45    } -body {
46        image create photo i
47        i put $imgdata
48        i data -format $fmt
49    } -cleanup {
50        image delete i
51    } -result $imgdata
52
53    test raw-1.4 {} -setup {
54        catch {image delete i}
55    } -body {
56        image create photo i
57        i put $imgdata -format $fmt
58        i data -format $fmt
59    } -cleanup {
60        image delete i
61    } -result $imgdata
62
63
64    test raw-2.0 {Binary I/O with RAW images} -setup {
65        catch {image delete i}
66    } -body {
67        image create photo i
68        set f [open $file r]
69        fconfigure $f -translation binary
70        set return [catch {i put [read $f]} msg]
71        close $f
72        lappend return $msg
73    } -cleanup {
74        image delete i
75    } -result {0 {}}
76}
77
78imageFinish
79namespace delete ::raw::test
80