[R] gif, jpeg and png image files reader AND tcltk image

[Jonathan Q. Li]

Hi all,

Following my previous posting, here is a function that takes a image matrix
and paint it
into a tcltk canvas. Then one can interact with the image using mouse;
things you could do
include: return mouse position, display the graylevel (now it works only
with graylevel image),
clipping( click left mouse button-hold-drag to new position) to generate
subimage. I have finally
debugged it although there are still some problems:
1. the speed of loading a new window is fairly slow, I don't know if the
slowness comes from the fact that we are using tcltk scripting, or if it
comes from the generating and reading of temporary files;
2. there are warnings messages, they actually come from my function
tk2ascii() where I am using a less-than-smart way to convert hexidecimal
string into integers. they don't really hurt, but I will need to make them
go away.

Please try the function out and let me know what you think. It's fairly easy
to use. Note: you must have the functions tk2ascii() and as.integer.hex() I
posted earlier.

Cheers,
Jonathan

Jonathan Q. Li, PhD
Agilent Technologies
3500 Deer Creek Road
Palo Alto, CA 94041



imageviewer <- function(im){

	###############################
	# imageviewer creates a canvas to
	# hold the graylevel image represented
	# by a matrix im
	#
	#
	# im: matrix of graylevel image
	# value: no return values
	################################

	rw <- tktoplevel()
	display.frame <- tkframe(rw,"-height", "1", "-width","20")
	pixel.display1 <- tktext(display.frame, "-height","1","-width","4")
	pixel.display2 <- tktext(display.frame, "-height", "1","-width", "4")
	pixel.display3 <- tktext(display.frame, "-height", "1", "-width", "3")

	tkpack(pixel.display1, pixel.display2, pixel.display3, "-side", "left")

	if(!require(pixmap))  stop("pixmap not present")
	newfile <- tempfile()
	write.pnm( pixmap(im), file=newfile)
	xxx <- tkcmd("image","create","photo", file=newfile)
	unlink(newfile)

	can <- tkcanvas(rw, width=1024,height=800, "-scrollregion", "0 0 1920
1536")
	yscroll <- tkscrollbar(rw, command =function(...)tkcmd(can,"yview",...),
orient="vertical")
	xscroll <- tkscrollbar(rw, command= function(...)tkcmd(can,"xview",...),
"-orient", "horizontal")
	tkconfigure(can, yscrollcommand=function(...)tkcmd(yscroll, "set",...))
	tkconfigure(can, xscrollcommand=function(...)tkset(xscroll,...))

	#################################
	# arrange the grid display pattern
	#################################

	tkgrid(display.frame, sticky="news")
	tkgrid(can, yscroll, sticky="news")
	tkgrid(xscroll, sticky="ew")
	tkgrid.rowconfigure(rw$ID, "1", weight=1)
	tkgrid.columnconfigure(rw$ID, "0", weight=1)

	####################################
	# now the functionalities
	####################################

	canvas.position <- function(x,y){

		xpos <- tkcmd(can$ID, "canvasx", as.integer(x))
		ypos <- tkcmd(can$ID, "canvasy", as.integer(y))

		tkcmd(pixel.display1, "delete", "1.0","1.4")
		tkcmd(pixel.display1, "insert", "1.0", paste(xpos))
		tkcmd(pixel.display2, "delete", "1.0", "1.4")
		tkcmd(pixel.display2, "insert","1.0", paste(ypos))
	list(xpos=xpos, ypos=ypos)
	}

	tkbind(can, "<Motion>", canvas.position)

	xxxim <- tkcmd(can, "create","image", 0,0, image=xxx, anchor="nw")

	start.roi <- function(x,y){
		e1 <- parent.frame()
		eval(substitute( start.x <- x),e1)
		eval(substitute( start.y <- y), e1)
	}

	tkitembind(can, xxxim, "<Button-1>", start.roi)

	end.roi <- function(x,y){
		yyy <- tkcmd("image","create","photo")
		tkcmd(yyy, "copy", xxx, "-from", start.x,start.y,x,y)
		im.data <- tk2ascii( tkcmd(yyy,"data") )

		imageviewer(im.data)
	}

	tkitembind(can, xxxim, "<B1-ButtonRelease>", end.roi)

	graylevel <- function(x,y){
		pos <- canvas.position(x,y)
		width <- as.integer(tkcmd("image","width",xxx))
		if( pos$xpos >= width){
			pos$xpos <- width -1
		}
		height <- as.integer(tkcmd("image","height",xxx))
		if(pos$ypos >= height){
			pos$ypos <- height -1
		}

		tkcmd(pixel.display3, "delete", "1.0", "1.2")

		xpos <- unlist(strsplit(pos$xpos,"\\."))[1]#convert into string integer
		ypos <- unlist(strsplit(pos$ypos,"\\."))[1]
		tkcmd(pixel.display3, "insert", "1.0", substr(tkcmd(xxx, "get", xpos,
ypos), 1,3))
	}

	tkitembind(can, xxxim, "<Any-Enter>", graylevel)
	tkitembind(can, xxxim, "<Motion>", graylevel)

}

-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._