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