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
)
}