Posted to tcl by tomk at Mon Mar 18 22:08:05 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}