Posted to tcl by tomk at Mon Mar 18 22:07:58 GMT 2013view pretty
package require Tcl 8.6 package require Tk 8.6 lappend auto_path \ . \ [file normalize [file join ~ local tbox lib]] \ [file normalize [file join ~ local tbox lib win32]] \ [file normalize [file join ~ local tbox lib critcl_3 critcl3.vfs lib]] \ [file normalize [file join ~ local tbox Plotchart]] \ [pwd]/imageviewer \ [pwd]/CRIMP puts [info patchlevel] set debug 1 foreach p { crimp::core crimp crimp::tk crimp::ppm crimp::pgm crimp::pfm crimp::bmp } { set ver [package require $p] if { ${debug} == 1 } { puts "$p: ${ver}" } } wm geometry . 600x600 set c [canvas .p -background beige] grid ${c} -column 1 -row 1 -sticky news set b [button .b -text "NEXT" -command {}] grid ${b} -column 1 -row 2 grid columnconfigure . 1 -weight 1 grid rowconfigure . 1 -weight 1 # create blank image proc blankImage { w h {color red} } { set clist [winfo rgb . ${color}] set img [crimp blank rgba ${w} ${h} {*}${clist} 255] set img [crimp meta set ${img} -xpos 0] set img [crimp meta set ${img} -ypos 0] # uncommenting the following causes image corruption #set img [crimp meta set ${img} -name 0] return ${img} } proc renderImage { c x y img } { set photo [image create photo] crimp write 2tk ${photo} ${img} ${c} delete img update ${c} create image ${x} ${y} \ -anchor nw \ -image ${photo} \ -tags img } set bg [blankImage 100 100 black] #set img [compositeImage 300 300 ${image2}] renderImage ${c} 0 0 ${bg}