# prspread is based on prmatrix
prspread <-
function(x, rowlab = character(0), collab = character(0), quote = T, right = F,
	spread.name=deparse(match.call()[["x"]]) )
{
	d <- dim(x)
	dnames <- dimnames(x)
	if(is.null(dnames))
		dnames <- list(rowlab, collab)
	else {
		if(!missing(rowlab))
			dnames[[1]] <- as.character(rowlab)
		if(!missing(collab))
			dnames[[2]] <- as.character(collab)
	}
	if(length(dnames[[1]]) == 0)
		dnames[[1]] <- paste("[", 1:d[1], ",]", sep = "")
	else if(length(dnames[[1]]) != d[1])
		stop("rowlab is wrong length")
	if(length(dnames[[2]]) == 0)
		dnames[[2]] <- paste("[,", 1:d[2], "]", sep = "")
	else if(length(dnames[[2]]) != d[2])
		stop("collab is wrong length")
	cbind(c(spread.name,dnames[[1]]), rbind(dnames[[2]], as.matrix(x)))
}



row.ch <- function(x, d=dim(x))
	array(1:d[1], d, dimnames(x))

col.ch <- function(x, d=dim(x))
	array(rep.int(1:d[2], rep.int(d[1], d[2])), d, dimnames(x))


print.text <- function(x, screen.n, cex=1,
	spread.name=deparse(match.call()[["x"]]), clear=T, ...)
{
	x.pr <- prspread(x, spread.name=spread.name)
	if (!missing(screen.n)) screen(screen.n)
	usr <- c(0, ncol(x.pr), 0, nrow(x.pr)) - .5
	par(usr=usr)
	par(plt=c(0,1,0,1))
	if (clear)
	polygon(usr[c(1,2,2,1)],usr[c(3,3,4,4)], den=-1,col=0,xaxt="s",yaxt="s")
	text(x=as.vector(col.ch(x.pr)-1),
		 y=as.vector(nrow(x.pr)-row.ch(x.pr)), x.pr, cex=cex, ...)
	box()
	invisible(x)
}

text.update.spread <- function(xij, row.i, col.j, screen.n, cex=1, x)
{
	if (!missing(screen.n)) {screen(screen.n, new=F); par(plt=c(0,1,0,1))}
	y <- nrow(x)-row.i
	clear.text(x=col.j, y=y)
	text(x=col.j, y=y, xij, cex=cex)
	box()
	invisible(x)
}


cell.rc.text <- function(nrow.x, n=1, type="n")
{
	xy <- locator(n, type)
	c(row=nrow.x-round(xy$y), col=round(xy$x))
}

clear.text <- function(x,y)
   polygon(x-.5+c(0,1,1,0), y-.5+c(0,0,1,1), den=-1, col=0, border=F,
   xaxt="s", yaxt="s")


print.update.text <- function(x, ..., x.old, screen.n, cex=1,
	spread.name=deparse(match.call()[["x"]]))
{
	if(missing(x.old)) return(invisible(print.text(x, screen=screen.n,
		cex=cex, spread.name=spread.name)))
	if (!missing(screen.n)) {screen(screen.n, new=F); par(plt=c(0,1,0,1))}
	diff.x <- as.vector(x != x.old)
	xx <- col(x)[diff.x]
	yy <- nrow(x)-row(x)[diff.x]
	for (i in seq(along=xx)) clear.text(xx[i], yy[i])
	box()
	text(x=xx, y=yy, as.vector(unlist(x))[diff.x], cex=cex)
	invisible(x)
}


control.text <- function(x, screen.n, cex=1,
	spread.name=deparse(match.call()[["x"]]))
{
	#This is a real function that does its own work
	if (!missing(screen.n)) {screen(screen.n, new=F); par(plt=c(0,1,0,1))}
	x.old <- x[,]
	rc <- cell.rc.text(nrow(x))
	command <- expr.rc(x, rc)
	cat("> ", command, "\n", sep="", file="")
	eval(parse(text=readline()))
	if (!missing(screen.n)) {screen(screen.n, new=F); par(plt=c(0,1,0,1))}
	print.update.text(x, x.old=x.old, cex=cex, spread.name=spread.name)
#	print.text(x, cex=cex, spread.name=spread.name)
	invisible(x)
}


#text usage
# device() # for example, x11(), or motif(), or win.graph()
# x <- my.spread                # copy my.spread to x
##loop
# print.text(x)                 # work with x
# x <- control.text(x, screen)  # screen is optional
##end loop
# my.spread <- x                # copy revised x back to my.spread