# This file is a Tcl script to test out SUN reading and writing. # It is organized in the standard fasion for Tcl tests. # puts "img::sun [package require img::sun]" set sundata \ {WaZqlQAAABAAAAAMAAAAIAAAAwAAAAACAAAAAAAAAAD/gALZ/4AC2f+AAtn/gAIA/4ACAP+A AgD/gAIA/4AC2f+AAtn/gALZ/4AC2f+AAtn/gALZ/4AC2f+AAtn/gALZ/4AC2f+AAtn/gAIA /4AA//D/gAD/8P+AAP/w/4AA//D/gAIA/4AC2f+AAtn/gALZ/4AC2f+AAtn/gALZ/4AC2f+A Atn/gALZ/4ACAP+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAgD/gALZ/4AC2f+A Atn/gALZ/4AC2f+AAtn/gALZ/4ACAP+AAgD/gAIA/4ACAP+AAgD/gAIA/4ACAP+AAgD/gAIA /4ACAP+AAgD/gAIA/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/8P+AAP/w/4AA//D/gAD/8P+A AP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4ACAP+AAtn/gALZ/4AC2f+AAgD/ gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w /4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/ 8P+AAP/w/4AA//D/gAD/8P+AAP/w/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/8P+AAP/w/4AA //D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4ACAP+AAtn/gALZ /4AC2f+AAgD/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/ gAD/8P+AAP/w/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w /4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/ 8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AC AP+AAtn/gALZ/4AC2f+AAgD/gAIA/4ACAP+AAgD/gAIA/4ACAP+AAgD/gAIA/4ACAP+AAgD/ gAIA/4ACAP+AAgD/gALZ/4AC2f+AAtk=} test sun-1.1 {} { catch {image delete i} image create photo i -file [file join $tcltest::testsDirectory folder.ras] i data -format sun } $sundata test sun-1.2 {} { catch {image delete i} image create photo i -data $sundata set data [i data -format sun] } $sundata test sun-1.3 {} { i blank i put $data set data [i data -format sun] } $sundata test sun-1.4 {} { i blank i put $data -format sun set data [i data -format sun] } $sundata if {[info tclversion] < 8.0} { return } test sun-2.0 {Binary I/O with SUN images} { i blank set f [open [file join $tcltest::testsDirectory folder.ras] r] fconfigure $f -translation binary set return [catch {i put [read $f]} msg] close $f lappend return $msg } {0 {}}