.packageName <- "HTMLapplets"
# +++++++++++++++++++++++++++++++++++++++++++
# name:        HTMLapplets.R
# date:        2004/11/29
# author:      Gregoire Thomas
# email:       gregoire.thomas@ugent.be
# description: Derive PlotML files for ptplot
#              http://ptolemy.eecs.berkeley.edu/
# copyright (c) VIB and Ghent University 2004
# +++++++++++++++++++++++++++++++++++++++++++

#============================================
# Generic method
#============================================
HTMLapplets <- function(x, ...){
  x <- as.data.frame(x)
  UseMethod("HTMLapplets");
}

#============================================
# Insert a java applet in a HTML document generated by the package R2HTML.
# Requires the tablesortcsv.jar archive.
#============================================
HTMLapplets.data.frame <- function(x, 
                                   file = .HTML.file, append = TRUE,
                                   id = "csvtab", data.link = TRUE, center=TRUE,
                                   save.csv = TRUE,
                                   width = 500, height = 400,
                                   codebase = ".",
                                   archive = "tablesortcsv.jar", 
                                   copy.jar = TRUE, overwrite.jar = TRUE,
                                   ...) {
  target <- paste(gsub(".html*$","",file), "-", id, ".csv", sep="")
  if(save.csv) write.table(x, file=target, sep=",", row.names=FALSE)
  cat("<p",ifelse(center," align=\"center\"",""),">\n",
      "<applet name=\"tableapplet\" \n",
      "  code=\"TableSortCSVApplet\" \n",
      "  width=",width," height=",height," \n",
      "  codebase=\"",codebase,"\" \n",
      "  archive=\"",archive,"\" \n",
      "  alt=\"If you had a java-enabled browser, \n",
      "    you would see an applet here.\" \n",
      "> \n",
      "  <param name=\"cache_option\" value=\"no\">\n",
      "  <param name=\"dataurl\" value=\"./",basename(target),"\">\n",
      "<hr>If your browser recognized the applet tag, \n",
      "  you would see an applet here.<hr>\n",
      "</applet>\n",
      ifelse(data.link,
             paste("<br><a href=\"./",basename(target),"\" target=\"xml\">",
                   basename(target),"</a>",sep=""),
             ""),
      "</p>\n",
      file = file, append = append, sep = "")
  path <- system.file("exec", package = "HTMLapplets")
  if(!file.exists(paste(dirname(file),"/tablesortcsv.jar", sep="")))
    v <- file.copy(paste(path,"/tablesortcsv.jar", sep=""),
                   paste(dirname(file),"/tablesortcsv.jar", sep=""),
                   overwrite=overwrite.jar)
  
}

#============================================
# Insert a java applet in a HTML document generated by the package R2HTML.
# Requires the plotmlapplet.jar archive.
# For more info on PtPlot see http://ptolemy.eecs.berkeley.edu/
#============================================
HTMLapplets.plot <- function(x, y = NULL,
                        file = .HTML.file, append = TRUE,
                        id = "plotml",
                        plot = TRUE, data.link = TRUE, center=TRUE, help=FALSE,
                        width = 500, height = 400, background ="ffffff", 
                        codebase = ".",
                        archive = "plotmlapplethb8.jar",
                        copy.jar = TRUE, overwrite.jar=TRUE,
                        ...) {
  target <- paste(gsub(".html*$","",file), "-", id, ".xml", sep="")
  if(plot) plotML(x=x, y=y, file=target, ...)
  cat("<p",ifelse(center," align=\"center\"",""),">\n",
      "<applet name=\"plotmlapplet\" \n",
      "  code=\"ptolemy.plot.plotml.PlotMLApplet\" \n",
      "  width=",width," height=",height," \n",
      "  codebase=\"",codebase,"\" \n",
      "  archive=\"",archive,"\" \n",
      "  alt=\"If you had a java-enabled browser, \n",
      "    you would see an applet here.\" \n",
      "> \n",
      "  <param name=\"cache_option\" value=\"no\">\n",
      "  <param name=\"dataurl\" value=\"./",basename(target),"\">\n",
      "  <param name=\"background\" value=\"",background,"\">\n",
      "<hr>If your browser recognized the applet tag, \n",
      "  you would see an applet here.<hr>\n",
      "</applet>\n",
      ifelse(data.link,
             paste("<br><a href=\"./",basename(target),"\" target=\"xml\">",
                   basename(target),"</a>",sep=""),
             ""),
      ifelse(help,"<br><b>Zoom in:</b> select an area from its top left to its bottom right corner.<br><b>Zoom out:</b> select an area from its bottom right to its top left corner.",""),
      "</p>\n",
      file = file, append = append, sep = "")
  path <- system.file("exec", package = "HTMLapplets")
  if(!file.exists(paste(dirname(file),"/",archive, sep="")))
    v <- file.copy(paste(path,"/",archive, sep=""),
                   paste(dirname(file),"/",archive, sep=""),
                   overwrite=overwrite.jar)
  
}

#==============================================
# Generate a plotml file from numerical series.
# Does not support labels, characters.
# y can be a list of series.
# x and y series MUST be of same length.
#==============================================
plotML <- function(x, y = NULL,
                   low.error=NULL, high.error=NULL,
                   col=NULL, diameter=NULL,
                   file,
                   type = "p", pch = 1,
                   xlim = NULL, ylim = NULL,
                   log = "",
                   main = NULL, xlab = "x", ylab = "y",
                   bg = "ffffff") {
  cat0 <- function(...)eval({
    cat(...,"\n", sep="", append=FALSE, file=file);})
  cat1 <- function(...)eval({
    cat(...,"\n", sep="", append=TRUE, file=file);})
  cat2 <- function(...)eval({
    cat("  ",...,"\n", sep="", append=TRUE, file=file);})
  cat0("<?xml version=\"1.0\" standalone=\"yes\"?>")
  cat1("<!DOCTYPE plot PUBLIC \"-//UC Berkeley//DTD PlotML 1//EN\" ",
       #"\"http://ptolemy.eecs.berkeley.edu/archive/plotml.dtd\">")
       "\"http://penyfan.ugent.be/HTMLapplets/plotml.dtd\">")
  cat1("<!-- Ptolemy plot, version 3.1, PlotML format. -->")
  cat1("<plot>\n")
  
  if(type=="h") {
    cat2("<barGraph ",
        #"width=\"0.3\" offset=\"0.1\"",
        ">")
  }
  
  cat2("<title>",main,"</title>")
  if(!is.null(xlab))
    cat2("<xLabel>",xlab,"</xLabel>")
  if(!is.null(ylab))
    cat2("<yLabel>",ylab,"</yLabel>")
  if(!is.null(xlim))
    cat2("<xRange min=\"",xlim[1],"\" max=\"",xlim[2],"\"/>")
  if(!is.null(ylim))
    cat2("<yRange min=\"",ylim[1],"\" max=\"",ylim[2],"\"/>")
  if((!is.null(log)) && (length(grep("x",tolower(log)))>0))
    cat2("<xLog/>")
  if((!is.null(log)) && (length(grep("y",tolower(log)))>0))
    cat2("<yLog/>")
  if(FALSE)
    cat2("<noGrid>")
  if(FALSE)
    cat2("<noColor/>")

  #<xTicks>
  #<tick label=\"A\" position=\"1\"/>
  #</xTicks>

  marks <- c("none", "dots", "points", "various", "pixels")[pch+1]
  
  # several y series
  ys <- NULL
  if(typeof(y)=="list") 
    ys <- y
  else if(is.null(y))
    ys <- list(x=x)
  else 
    ys <- list(y=y)
  cnt <- 0
  for(n in names(ys)) {
    cnt <- cnt + 1
    cat2("<dataset name=\"",n,"\" ",
         "marks=\"",marks[ifelse(length(marks)<cnt,1,cnt)],"\" ",
         "connected=\"",
           ifelse(type[ifelse(length(type)<cnt,1,cnt)]=="l","yes","no"),"\" ",
         "stems=\"",
           ifelse(type[ifelse(length(type)<cnt,1,cnt)]=="s","yes","no"),"\">")

    myx <- ""
    if(!is.null(y)) {
      vs <- NULL;tag <- "x";v <- x
      if(is.null(v))
        vs <- ""
      else if(is.list(v)&&is.list(v[[n]]))
        vs <- paste(" ",tag,"=\"",v[[n]],"\"",sep="")
      else
        vs <- paste(" ",tag,"=\"",v,"\"",sep="")
      if(length(vs)==1) vs <- rep(vs,length(ys[[n]]))
      if(length(vs)!=length(ys[[n]])) stop("unconsistant data");
      myx <- vs
    }
    
    vs <- NULL;tag <- "color";v <- col
    if(is.null(v))
      vs <- ""
    else if(is.list(v)&&is.list(v[[n]]))
      vs <- paste(" ",tag,"=\"",v[[n]],"\"",sep="")
    else
      vs <- paste(" ",tag,"=\"",v,"\"",sep="")
    if(length(vs)==1) vs <- rep(vs,length(ys[[n]]))
    if(length(vs)!=length(ys[[n]])) stop("unconsistant data");
    cols <- vs

    vs <- NULL;tag <- "diameter";v <- diameter
    if(is.null(v))
      vs <- ""
    else if(is.list(v)&&is.list(v[[n]]))
      vs <- paste(" ",tag,"=\"",v[[n]],"\"",sep="")
    else
      vs <- paste(" ",tag,"=\"",v,"\"",sep="")
    if(length(vs)==1) vs <- rep(vs,length(ys[[n]]))
    if(length(vs)!=length(ys[[n]])) stop("unconsistant data");
    diameters <- vs

    vs <- NULL;tag <- "lowErrorBar";v <- low.error
    if(is.null(v))
      vs <- ""
    else if(is.list(v)&&is.list(v[[n]]))
      vs <- paste(" ",tag,"=\"",v[[n]],"\"",sep="")
    else
      vs <- paste(" ",tag,"=\"",v,"\"",sep="")
    if(length(vs)==1) vs <- rep(vs,length(ys[[n]]))
    if(length(vs)!=length(ys[[n]])) stop("unconsistant data");
    low.errors <- vs
    
    vs <- NULL;tag <- "highErrorBar";v <- high.error
    if(is.null(v))
      vs <- ""
    else if(is.list(v)&&is.list(v[[n]]))
      vs <- paste(" ",tag,"=\"",v[[n]],"\"",sep="")
    else
      vs <- paste(" ",tag,"=\"",v,"\"",sep="")
    if(length(vs)==1) vs <- rep(vs,length(ys[[n]]))
    if(length(vs)!=length(ys[[n]])) stop("unconsistant data");
    high.errors <- vs

    w <- !is.na(ys[[n]])
    cat1(paste("    <p ",myx[w]," y=\"",ys[[n]][w],"\" ",
               cols[w], diameters[w], low.errors[w], high.errors[w],
               "/>", sep="", colapse="\n"))
    cat2("</dataset>")
  }
  
  cat1("</plot>")
}
# +++++++++++++++++++++++++++++++++++++++++++
# name:        zzz.R
# date:        2004/11/18
# author:      Gregoire Thomas
# email:       gregoire.thomas@ugent.be
# description: 
# copyright (c) VIB and Ghent University 2004
# +++++++++++++++++++++++++++++++++++++++++++

# ++++++ .First.lib +++++++++++++++++++++++++++++++++++++++++++
.First.lib<-function(lib, pkg) {
  require(R2HTML)
}
# -------------------------------------------------------------

