R/arctext.R

Defines functions arctext

Documented in arctext

arctext<-function(x,center=c(0,0),radius=1,start=NULL,middle=pi/2,end=NULL,
 stretch=1,clockwise=TRUE,cex=NULL, ...) {

 oldcex <- par("cex")
 # have to do this to get strwidth to work
 if(is.null(cex)) cex <- oldcex
 par(cex = cex)
 xvec <- strsplit(x, "")[[1]]
 lenx <- length(xvec)
 xwidths <- stretch * strwidth(xvec)
 charangles <- xwidths/radius
 # make really narrow characters wider
 changrang <- range(charangles)
 charangles[charangles < changrang[2]/2] <- changrang[2]/2
 if(!is.null(end)) {
  if(clockwise) start <- end + sum(charangles)
  else start <- end - sum(charangles)
 }
 if(is.null(start)) {
  if (clockwise) start <- middle + sum(charangles)/2
  else start <- middle - sum(charangles)/2
 }
 if(clockwise) {
  charstart <- c(start, start - cumsum(charangles)[-lenx])
  charpos <- charstart - charangles/2
 }
 else {
  charstart <- c(start, start + cumsum(charangles)[-lenx])
  charpos <- charstart + charangles/2
 }
 xylim <- par("usr")
 plotdim <- par("pin")
 ymult <- (xylim[4] - xylim[3])/(xylim[2] - xylim[1]) * plotdim[1]/plotdim[2]
 for(xchar in 1:lenx) {
  srt <- 180 * charpos[xchar]/pi - 90
  text(center[1] + radius * cos(charpos[xchar]), center[2] + 
  radius * sin(charpos[xchar]) * ymult, xvec[xchar], 
   adj = c(0.5, 0.5), srt = srt + 180 * (!clockwise),...)
 }
 par(cex = oldcex)
}

Try the plotrix package in your browser

Any scripts or data that you put into this service are public.

plotrix documentation built on Nov. 10, 2023, 5:07 p.m.