# This file is a Tcl script to test out BMP reading and writing. # It is organized in the standard fashion for Tcl tests. package require Tk package require tcltest tcltest::configure {*}$argv source [file join [file dirname [info script]] constraints.tcl] package require Img imageInit namespace eval ::bmp::test { namespace import ::tcltest::* set fmt "bmp" set ext "bmp" set file "testimgs/img.$ext" set out "testimgs/img_out.$ext" # Encoded image content. source $file.base64 test bmp-1.1 {} -setup { catch {image delete i} } -body { image create photo i -file $file i data -format $fmt } -cleanup { image delete i } -result $imgdata test bmp-1.2 {} -setup { catch {image delete i} } -body { image create photo i -data $imgdata i data -format $fmt } -cleanup { image delete i } -result $imgdata test bmp-1.3 {} -setup { catch {image delete i} } -body { image create photo i i put $imgdata i data -format $fmt } -cleanup { image delete i } -result $imgdata test bmp-1.4 {} -setup { catch {image delete i} } -body { image create photo i i put $imgdata -format $fmt i data -format $fmt } -cleanup { image delete i } -result $imgdata test bmp-2.0 {Binary I/O with BMP images} -setup { catch {image delete i} } -body { image create photo i set f [open $file r] fconfigure $f -translation binary set return [catch {i put [read $f]} msg] close $f lappend return $msg } -cleanup { image delete i } -result {0 {}} test bmp-2.1 {Save with given aspect ratio} -setup { catch {image delete i} } -body { image create photo i i put $imgdata -format $fmt i write $out -format [list $fmt -resolution {300 100}] set f [open $out r] fconfigure $f -translation binary binary scan [read $f] x38i2 xyres set return [read $f] close $f catch {file delete $out} set xyres } -cleanup { image delete i } -result {2925 975} test bmp-2.2 {Save with constant resolution of 300 dpi} -setup { catch {image delete i} } -body { image create photo i i put $imgdata -format $fmt i write $out -format [list $fmt -resolution {300 i}] set f [open $out r] fconfigure $f -translation binary binary scan [read $f] x38i2 xyres set return [read $f] close $f catch {file delete $out} set xyres } -cleanup { image delete i } -result {11811 11811} test bmp-2.3 {Save with given resolution of x 100dpi and y 50dpi} -setup { catch {image delete i} } -body { image create photo i i put $imgdata -format $fmt i write $out -format [list $fmt -resolution {100 50 i}] set f [open $out r] fconfigure $f -translation binary binary scan [read $f] x38i2 xyres set return [read $f] close $f catch {file delete $out} set xyres } -cleanup { image delete i } -result {3937 1969} } imageFinish namespace delete ::bmp::test