textplot <- function(object, halign="center", valign="center", cex, ... )
  UseMethod('textplot')


textplot.default <- function(object,
                             halign=c("center","left","right"),
                             valign=c("center","top","bottom"),
                             cex, ... )
{

  if (is.matrix(object) || (is.vector(object) && length(object)>1) )
    return(textplot.matrix(object, halign, valign, cex, ... ))

  halign <- match.arg(halign)
  valign <- match.arg(valign)

  textplot.character(object, halign,  valign, cex, ...)
}

textplot.character <- function (object,
                                halign = c("center", "left", "right"),
                                valign = c("center", "top", "bottom"),
                                cex, fixed.width=TRUE,
                                cspace=1,
                                lspace=1,
                                mar=c(0,0,3,0)+0.1,
                                ...)
  {
    object <- paste(object,collapse="\n",sep="")

    halign = match.arg(halign)
    valign = match.arg(valign)
    plot.new()

    opar <- par()[c("mar","xpd","cex","family")]
    on.exit( par(opar) )

    par(mar=mar,xpd=FALSE )
    if(fixed.width)
        par(family="mono")

    plot.window(xlim = c(0, 1), ylim = c(0, 1), log = "", asp = NA)

    slist   <- unlist(lapply(object, function(x) strsplit(x,'\n')))
    slist   <- lapply(slist, function(x) unlist(strsplit(x,'')))

    slen    <- sapply(slist, length)
    slines  <- length(slist)

    if (missing(cex))
      {
        lastloop <- FALSE
        cex <- 1
      }
    else
      lastloop <- TRUE


    for (i in 1:20)
      {
        oldcex <- cex
        #cat("cex=",cex,"\n")
        #cat("i=",i,"\n")
        #cat("calculating width...")
        cwidth  <- max(sapply(unlist(slist), strwidth,  cex=cex)) * cspace
        #cat("done.\n")
        #cat("calculating height...")
        cheight <- max(sapply(unlist(slist), strheight, cex=cex)) * ( lspace + 0.5 )
        #cat("done.\n")

        width <- strwidth(object, cex=cex)
        height <- strheight(object, cex=cex)

        if(lastloop) break

        cex <- cex  / max(width, height)

        if (abs(oldcex - cex) < 0.001)
          {
            lastloop <- TRUE
          }

      }

    if (halign == "left")
        xpos <- 0
    else if (halign == "center")
        xpos <- 0 + (1 - width)/2
    else xpos <- 0 + (1 - width)

    if (valign == "top")
        ypos <- 1
    else if (valign == "center")
        ypos <- 1 - (1 - height)/2
    else ypos <- 1 - (1 - height)

  }


binomialDemo = function(container=NULL) {
  library(lattice)
  
  theData <- c()
  
  if(is.null(container))
    container = gwindow("Binomial Demo")

  group = ggroup(container=container)
  lgroup = ggroup(horizonatal=FALSE,container = group)
  rgroup = ggroup(horizonatal=TRUE,container = group)
  add(rgroup, ggraphics(), expand=TRUE)

  NoTrials = gedit("10",coerce.with=as.numeric)
  SuccessProb = gedit("0.5",coerce.with=as.numeric)

  tbl = glayout()
  tbl[1,1] = glabel("No. of trials (n > 1)")
  tbl[1,2] = NoTrials
  tbl[2,1] = glabel("Success Probability p:")
  tbl[2,2] = SuccessProb

  addOneMore = gbutton("Add one more", handler = function(...) updateGraph(1))
  addTenMore = gbutton("Add ten more", handler = function(...) updateGraph(10))

  tbl[3,1:2] = addOneMore
  tbl[4,1:2] = addTenMore
  visible(tbl) <- TRUE
  add(lgroup, tbl)


  addhandlerchanged(NoTrials,handler = function(...) {
    clearGraph(); updateGraph(1)
  })
  addhandlerchanged(SuccessProb,handler = function(...) {
    clearGraph(); updateGraph(1)
  })

  updateGraph = function(NoToAdd) {
    n = svalue(NoTrials)
    if (n < 1) {
      svalue(NoTrials) <- 1; gmessage("Need more than 1 trial\n")
      return()
    }

    p = svalue(SuccessProb)
    if(p <=0 | p >= 1) {
      svalue(SuccessProb) <- 0.5
      gmessage("Probability is a number in (0,1)")
      return()
    }

    newSample = rbinom(n, size=1, prob=p)
    if(NoToAdd > 1) {
      theData <<- c(theData, rbinom(NoToAdd-1,n,p))
    }
    theData <<- c(theData,sum(newSample))

    ## Now plot
    layout(matrix(c(1,2,1,2),nrow=2),heights=c(3,1))
    ## do plot of theData
    plotThis = table(theData)
    cols = rep("gray",length(plotThis))
    names(cols) <- names(plotThis)
    cols[as.character(sum(newSample))] <- "blue"
    barplot(table(theData),col=cols,main="Plot of binomial numbers")
    
    ## plot the binomial
    showBinomial = function(newSample) {
      n = length(newSample)
      old.par <- par(no.readonly = TRUE) # all par settings which
                                           # could be changed.
      on.exit(par(old.par))
    
      par(mai=c(0,0,0,0))
      plot.new()
      plot.window(xlim=c(1,n),ylim=c(0,1))
      
      metsCols = c("orange","blue")
      
      points(1:n,rep(.5,n),pch=16,cex=2,col=metsCols[1 + newSample])
    }
    showBinomial(newSample)
    
  }

  clearGraph = function() theData <<- c()
}