rafetextbox <- function (x, y, textlist ,fontscale = 1, leading = 0.5 ,mat = FALSE, matcolor="#C0C0C0" ,box = FALSE, cushion = c(0.15, 0.50) ) {

########################################################## # set up some parameters, left-justified text and a # # pretty typeface # ##########################################################

par(adj = 0 ,family="serif" )

########################################################## # Put all the words together, separated by spaces. Then # # pull them apart and make a big list (vector?) of the # # individual words. # ##########################################################

textstr <- paste(textlist, collapse = " ") words <- strsplit(textstr, " ")1

########################################################## # Compute how tall 'h' is and how low 'y' under the # # current conditions, since these are tallest and lowest.# ##########################################################

line.height.no.leading <- strheight("hy", cex = fontscale) line.height <- line.height.no.leading * (1 + leading)

########################################################## # x.len is the width of the desired box. y.pos is the # # starting y.pos and x.pos is the starting x position # ##########################################################

x.len <- diff(x) y.pos <- y x.pos <- x[1]

if (mat) { ########################################################## # Upon starting, the current working line of text is # # empty --- we will add to it. And we set the # # new.paragraph flag to FALSE. # ##########################################################

current.line <- "" new.paragraph <- FALSE

########################################################## # Step through the words vector one by one and check to # # to see what action to take. # ##########################################################

for (i in 1:length(words)) {

########################################################## # If the current word is the new paragraph keyword then # # set the new.paragraph flag to TRUE. This will be used # # later when we write the current line. # ##########################################################

if ((words[i]) == "**newparagraph**") { new.paragraph <- TRUE }

########################################################## # If the new paragraph flag is not set to TRUE (ie, we # # are not processing a new paragraph keyword), then need # # to do the usual procedure to add the word and check. # ##########################################################

if (new.paragraph) {

########################################################## # Define the potential current line to be the current # # line plus the next word. # ##########################################################

potential.current.line <- paste(current.line, words[i])

########################################################## # Get rid of aberrant spaces that tend to show up at the # # front of the strings. # ##########################################################

if (substr(potential.current.line ,1 ,1) == " ") {potential.current.line <- substr(potential.current.line ,2 ,nchar(potential.current.line)) }

########################################################## # Compute whether or not the potential current line will # # actually fit in the horizontal space defined by the x # # values. # ##########################################################

will.fit <- (x.pos + strwidth(potential.current.line, cex=fontscale) < x[2])

########################################################## # If the line will fit, then make the assignment... # ##########################################################

if (will.fit) { current.line <- potential.current.line }

########################################################## # ...otherwise write out the current line at the x and y # # locations, update the value of y by pushing it down the# # height of one row of text, and make the new current # # line take the value of the word of in play. # ##########################################################

else { #text(x.pos, y.pos, current.line,cex=fontscale,adj=c(0,0)) #points(x.pos,y.pos,pch=".",col="blue") y.pos <- y.pos - line.height current.line <- words[i] } }

########################################################## # If the new paragraph line WAS set, then write the # # current line, regardless of how full it is, update the # # y.pos twice, to give a separation in paragraphs, assign# # the current line an empty string, and reset the new # # paragraph flag. # ##########################################################

else { #text(x.pos, y.pos, current.line,cex=fontscale,adj=c(0,0)) #points(x.pos,y.pos,pch=".",col="blue") y.pos <- y.pos - line.height y.pos <- y.pos - line.height current.line <- "" new.paragraph <- FALSE } }

########################################################## # At the end of the last word, spit out the current line # # because we have run out of words. # ##########################################################

#text(x.pos, y.pos, current.line,cex=fontscale,adj=c(0,0)) #points(x.pos,y.pos,pch=".",col="blue")

########################################################## # Draw the mat if requested. # ##########################################################

rect(x[1]-cushion[1], y +(line.height.no.leading * (1+cushion[2])) ,x[2]+cushion[1], y.pos-(line.height.no.leading * (0+cushion[2])) ,col=matcolor ,border=FALSE ) }

########################################################## # Now do it with the actual printing. # ##########################################################

y.pos <- y current.line <- "" new.paragraph <- FALSE

for (i in 1:length(words)) { if ((words[i]) == "**newparagraph**") { new.paragraph <- TRUE } if (new.paragraph) { potential.current.line <- paste(current.line, words[i]) if (substr(potential.current.line ,1 ,1) == " ") {potential.current.line <- substr(potential.current.line ,2 ,nchar(potential.current.line)) } will.fit <- (x.pos + strwidth(potential.current.line, cex=fontscale) < x[2]) if (will.fit) { current.line <- potential.current.line } else { text(x.pos, y.pos, current.line,cex=fontscale,adj=c(0,0)) #points(x.pos,y.pos,pch=".",col="blue") y.pos <- y.pos - line.height current.line <- words[i] } } else { text(x.pos, y.pos, current.line,cex=fontscale,adj=c(0,0)) #points(x.pos,y.pos,pch=".",col="blue") y.pos <- y.pos - line.height y.pos <- y.pos - line.height current.line <- "" new.paragraph <- FALSE } } text(x.pos, y.pos, current.line,cex=fontscale,adj=c(0,0)) #points(x.pos,y.pos,pch=".",col="blue") if (box) rect(x[1]-cushion[1], y +(line.height.no.leading * (1+cushion[2])) ,x[2]+cushion[1], y.pos-(line.height.no.leading * (0+cushion[2])) ,col=NULL ,border=TRUE )

}
Topic revision: r1 - 13 Jan 2006, RafeDonahue
 

This site is powered by FoswikiCopyright © 2013-2022 by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding Vanderbilt Biostatistics Wiki? Send feedback