add.constraint<-function(tri.obj,cstx,csty,reverse=F)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  nt<-summary(tri.obj)$nt;
  lcst<-length(cstx)
  if(reverse)
    {
      cstx<-cstx[lcst:1]
      csty<-csty[lcst:1]
    }
  if(length(csty)!=lcst)
    stop("length of cstx and csty differ")
  # don't modify tri.obj
  tri.obj1<-tri.obj
  if(tri.obj1$nc==0)
    {
      tri.obj1$nc<-tri.obj1$nc+1
      tri.obj1$lc[1]<-tri.obj1$n+1
      tri.obj1$lc[2]<-tri.obj1$n+lcst+1
    }
  else
    {
      tri.obj1$nc<-tri.obj1$nc+1
      tri.obj1$lc[tri.obj1$nc]<-tri.obj1$n+1
      tri.obj1$lc[tri.obj1$nc+1]<-tri.obj1$n+lcst+1
    }
  n1<-tri.obj1$n+1
  n2<-tri.obj1$n+lcst
  tri.obj1$x[n1:n2]<-cstx
  tri.obj1$y[n1:n2]<-csty
  tri.obj1$n<-tri.obj1$n+lcst
  # generate a triangulation with the additional nodes:
  # (we need an updated tlist,tlptr and tlend)
  tri.obj2<-tri.mesh(tri.obj1$x,tri.obj1$y)
  ans<-.Fortran("addcst",
                 as.integer(tri.obj1$nc),
                 as.integer(tri.obj1$lc),
                 as.integer(tri.obj1$n),
                 as.double(tri.obj1$x),
                 as.double(tri.obj1$y),
                 as.integer(2*(tri.obj1$n-3)),
                 integer(2*(tri.obj1$n-3)),
                 tlist=as.integer(tri.obj2$tlist),
                 tlptr=as.integer(tri.obj2$tlptr),
                 tlend=as.integer(tri.obj2$tlend),
                 ier=as.integer(0),
                 PACKAGE = "tripack")
  if(ans$ier==0)
    {
      ret<-list(n=tri.obj1$n,x=tri.obj1$x,y=tri.obj1$y,
                tlist=ans$tlist,tlptr=ans$tlptr,
                tlend=ans$tlend,tlnew=tri.obj2$tlnew,
                nc=tri.obj1$nc,lc=tri.obj1$lc,call=match.call())
    }
  else
    {
      switch(ans$ier,
             stop("nc, n or lc[i] out of range"),
             stop("working array to small"),
             stop("invalid triangulation or collinear nodes on convex hull"),
             stop("intersecting constraint arcs"),
             stop("constraint region contains a node\nmay be you should try \"reverse=T\" to invert the orientation \nof the constraint boundary"),
             )
      stop(paste("error",ans$ier,"in addcst"))
    }
                  
  class(ret)<-"tri"
  invisible(ret)
}
convex.hull<-function(tri.obj,plot.it=F, add=F,...)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  tborder<-c(rep(-1,tri.obj$n))
  storage.mode(tborder)<-"integer"
  ans<-.Fortran("bnodes",
                 as.integer(tri.obj$n),
                 as.integer(tri.obj$tlist),
                 as.integer(tri.obj$tlptr),
                 as.integer(tri.obj$tlend),
                 tborder=as.integer(tborder),
                 nb=as.integer(0),
                 na=as.integer(0),
                 nt=as.integer(0),
                 PACKAGE = "tripack")
  ret<-list(x=tri.obj$x[ans$tborder[ans$tborder>0]],
            y=tri.obj$y[ans$tborder[ans$tborder>0]],
            i=seq(1,tri.obj$n)[ans$tborder[ans$tborder>0]])
  if(plot.it)
    {
      if (!add)
        {
          plot.new()
          plot.window(range(ret$x), range(ret$y), "")
        }
      lines(cbind(ret$x,ret$x[1]),cbind(ret$y,ret$y[1]), ...)
      invisible(ret)
    }
  else
    ret
}
identify.tri<-function(tri.obj)
  {
    if(!inherits(tri.obj,"tri"))
      stop("tri.obj must be of class \"tri\"")
    labels<-paste("(",tri.obj$x,",",tri.obj$y,")", sep ="")
    identify(tri.obj$x,tri.obj$y,labels=labels)
  }
in.convex.hull<-function(tri.obj,x,y)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  if(length(x)!=length(y))
    stop("x and y must be of same length")
  n<-length(x)
  if(n==0)
    stop("length of x (resp. y) is 0")
  ans<-.Fortran("inhull",
                as.double(x),
                as.double(y),
                as.integer(n),
                as.double(tri.obj$x),
                as.double(tri.obj$y),
                as.integer(tri.obj$n),
                as.integer(tri.obj$tlist),
                as.integer(tri.obj$tlptr),
                as.integer(tri.obj$tlend),
                inhull=logical(n),
                PACKAGE = "tripack")
  ans$inhull
}
neighbours<-function(tri.obj)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  tnabor<- integer(tri.obj$tlnew)
  nnabs <- integer(tri.obj$n)
  nptr <- integer(tri.obj$n)
  nptr1 <- integer(tri.obj$n)
  nbnos <- integer(tri.obj$n)
  ans<-.Fortran("troutq",
                 as.integer(tri.obj$nc),
                 as.integer(tri.obj$lc),
                 as.integer(tri.obj$n),
                 as.double(tri.obj$x),
                 as.double(tri.obj$y),
                 as.integer(tri.obj$tlist),
                 as.integer(tri.obj$tlptr),
                 as.integer(tri.obj$tlend),
                 as.integer(6),
                 nnabs=as.integer(nnabs),
                 nptr=as.integer(nptr),
                 nptr1=as.integer(nptr1),
                 tnabor=as.integer(tnabor),
                 nbnos=as.integer(nbnos),
                 na=as.integer(0),
                 nb=as.integer(0),
                 nt=as.integer(0),
                 PACKAGE = "tripack")
  ret<-rep(NULL,tri.obj$n)
  for (i in 1:tri.obj$n)
    {
      ret[i]<-list(sort(ans$tnabor[ans$nptr[i]:ans$nptr1[i]]))
    }
  ret
}
on.convex.hull<-function(tri.obj,x,y)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  if(length(x)!=length(y))
    stop("x and y must be of same length")
  n<-length(x)
  if(n==0)
    stop("length of x (resp. y) is 0")
  ans<-.Fortran("onhull",
                as.double(x),
                as.double(y),
                as.integer(n),
                as.double(tri.obj$x),
                as.double(tri.obj$y),
                as.integer(tri.obj$n),
                as.integer(tri.obj$tlist),
                as.integer(tri.obj$tlptr),
                as.integer(tri.obj$tlend),
                onhull=logical(n),
                PACKAGE = "tripack")
  ans$onhull
}
outer.convhull<-function(cx,cy,px,py,FUN,duplicate="remove",...)
  {
    nx<-length(cx)
    ny<-length(cy)
    np<-length(px)
    if(length(py)!=np)
      stop("length of cx and cy differ")
    if (is.character(FUN)) 
      FUN <- get(FUN, mode = "function", inherits = TRUE)
    p.tr<-tri.mesh(px,py,duplicate)

    ans<-matrix(FUN(matrix(cx, nx, ny),
                    matrix(cy, nx, ny, byrow = TRUE), 
                    ...), nx, ny)
    ans[!in.convex.hull(p.tr,matrix(cx, nx, ny),
                        matrix(cy, nx, ny, byrow = TRUE))]<-NA
    ans
  }
plot.tri<-function(tri.obj,add=F,xlim=range(tri.obj$x),
                   ylim=range(tri.obj$y),do.points=T,...)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  tnabor<- integer(tri.obj$tlnew)
  nnabs <- integer(tri.obj$n)
  nptr <- integer(tri.obj$n)
  nptr1 <- integer(tri.obj$n)
  nbnos <- integer(tri.obj$n)
  ans<-.Fortran("troutq",
                 as.integer(tri.obj$nc),
                 as.integer(tri.obj$lc),
                 as.integer(tri.obj$n),
                 as.double(tri.obj$x),
                 as.double(tri.obj$y),
                 as.integer(tri.obj$tlist),
                 as.integer(tri.obj$tlptr),
                 as.integer(tri.obj$tlend),
                 as.integer(6),
                 nnabs=as.integer(nnabs),
                 nptr=as.integer(nptr),
                 nptr1=as.integer(nptr1),
                 tnabor=as.integer(tnabor),
                 nbnos=as.integer(nbnos),
                 na=as.integer(0),
                 nb=as.integer(0),
                 nt=as.integer(0),
                 PACKAGE = "tripack")
  if(!add)
    {
      plot.new()
      plot.window(xlim=xlim,ylim=ylim,"")
    }
  for (i in 1:tri.obj$n)
    {
      inb<-ans$tnabor[ans$nptr[i]:ans$nptr1[i]]
      for (j in inb)
        lines(c(tri.obj$x[i],tri.obj$x[j]),c(tri.obj$y[i],tri.obj$y[j]), ...)
    }
  if(do.points) points(tri.obj$x,tri.obj$y)
  if(!add) title("Delaunay triangulation",deparse(substitute(tri.obj)))
}
"plot.voronoi" <- function(v.obj,add=F,
                           xlim=c(min(v.obj$tri$x)-
                             0.1*diff(range(v.obj$tri$x)),
                             max(v.obj$tri$x)+
                             0.1*diff(range(v.obj$tri$x))),
                           ylim=c(min(v.obj$tri$y)-
                             0.1*diff(range(v.obj$tri$y)),
                             max(v.obj$tri$y)+
                             0.1*diff(range(v.obj$tri$y))),
                           all=F,
                           do.points=T,
                           main="Voronoi mosaic",
                           sub=deparse(substitute(v.obj)),
                           ...)
  {

    
    if(all)
      {
        xlim<-c(min(v.obj$x)-0.1*diff(range(v.obj$x)),
                max(v.obj$x)+0.1*diff(range(v.obj$x)))
        ylim<-c(min(v.obj$y)-0.1*diff(range(v.obj$y)),
                max(v.obj$y)+0.1*diff(range(v.obj$y)))
      }
    
    n<-length(v.obj$x)

    if(!add)
      {
        plot.new()
        plot.window(xlim=xlim,ylim=ylim,"")
      }

    if(do.points) points(v.obj$x,v.obj$y)

    for (i in 1:n)
      {
        if(v.obj$node[i])
          # Triangle i has positive area.
          # Connect circumcircle center of triangle i with neighbours:
          {
            # Find neighbour triangles
            tns<-sort(c(v.obj$n1[i],v.obj$n2[i],v.obj$n3[i]))
            for(j in 1:3)
              {
                # Connect (if triangle exists and has positive area).
                if(tns[j]>0)
                  {
                  # simple node
                    if(v.obj$node[tns[j]])
                      lines(c(v.obj$x[i],v.obj$x[tns[j]]),
                            c(v.obj$y[i],v.obj$y[tns[j]]),...)
                  }
                else if(tns[j]<0){
                  # dummy node
                  lines(c(v.obj$x[i],v.obj$dummy.x[-tns[j]]),
                        c(v.obj$y[i],v.obj$dummy.y[-tns[j]]),
                        lty="dashed",...) }
              }
          }
      }
    if(!add)
      title(main = main, sub =sub)
  }
print.summary.tri<-function(summ.tri.obj)
  {
    cat("triangulation:\n")
    cat("Call:", deparse(summ.tri.obj$call),"\n")
    cat("number of nodes:",summ.tri.obj$n,"\n")
    cat("number of arcs:",summ.tri.obj$na,"\n")
    cat("number of boundary nodes:",summ.tri.obj$nb,"\n")
    cat("number of triangles:",summ.tri.obj$nt,"\n")
    cat("number of constraints:",summ.tri.obj$nc,"\n")
  }
print.summary.voronoi<-function(summ.vo.obj)
  {
    cat("voronoi mosaic\n")
    cat("Call:", deparse(summ.vo.obj$call),"\n")
    cat(summ.vo.obj$nn, "nodes\n")
    cat(summ.vo.obj$nd, "dummy nodes\n")
  }
print.tri<-function(tri.obj)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  tnabor<- integer(tri.obj$tlnew)
  nnabs <- integer(tri.obj$n)
  nptr <- integer(tri.obj$n)
  nptr1 <- integer(tri.obj$n)
  nbnos <- integer(tri.obj$n)
  ans<-.Fortran("troutq",
                 as.integer(tri.obj$nc),
                 as.integer(tri.obj$lc),
                 as.integer(tri.obj$n),
                 as.double(tri.obj$x),
                 as.double(tri.obj$y),
                 as.integer(tri.obj$tlist),
                 as.integer(tri.obj$tlptr),
                 as.integer(tri.obj$tlend),
                 as.integer(6),
                 nnabs=as.integer(nnabs),
                 nptr=as.integer(nptr),
                 nptr1=as.integer(nptr1),
                 tnabor=as.integer(tnabor),
                 nbnos=as.integer(nbnos),
                 na=as.integer(0),
                 nb=as.integer(0),
                 nt=as.integer(0),
                 PACKAGE = "tripack")
  cat("triangulation nodes with neigbours:\n")
  cat("node: (x,y): neighbours\n")
  for (i in 1:tri.obj$n)
    {
      cat(i,": (",tri.obj$x[i],",",tri.obj$y[i],") [",ans$nnabs[i],"]",sep="")
      cat(":",sort(ans$tnabor[ans$nptr[i]:ans$nptr1[i]]),"\n",sep=" ")
    }
  cat("number of nodes:",tri.obj$n,"\n")
  cat("number of arcs:",ans$na,"\n")
  cat("number of boundary nodes:",ans$nb,"\n")
  cat("boundary nodes: ",ans$nbnos[1:ans$nb], "\n", sep=" ")
  cat("number of triangles:",ans$nt,"\n")
  cat("number of constraints:",tri.obj$nc,"\n")
}
print.voronoi<-function(voronoi.obj)
{
  if(!inherits(voronoi.obj,"voronoi"))
    stop("voronoi.obj must be of class \"voronoi\"")
  cat("voronoi mosaic:\n")
  cat("nodes: (x,y): neighbours (<0: dummy node)\n")
  for (i in 1:length(voronoi.obj$x))
    {
      if(voronoi.obj$node[i]){
        cat(i,": (",voronoi.obj$x[i],",",voronoi.obj$y[i],")",sep="")
        cat(":",voronoi.obj$n1[i],voronoi.obj$n2[i],voronoi.obj$n3[i],"\n",sep=" ")
      }
    }
  cat("dummy nodes: (x,y)\n")
  for (i in 1:length(voronoi.obj$dummy.x))
    {
      cat(i,": (",voronoi.obj$dummy.x[i],",",voronoi.obj$dummy.y[i],")\n",sep="")
    }

}
summary.tri<-function(tri.obj, print=F)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  tnabor<- integer(tri.obj$tlnew)
  nnabs <- integer(tri.obj$n)
  nptr <- integer(tri.obj$n)
  nptr1 <- integer(tri.obj$n)
  nbnos <- integer(tri.obj$n)
  ans<-.Fortran("troutq",
                 as.integer(tri.obj$nc),
                 as.integer(tri.obj$lc),
                 as.integer(tri.obj$n),
                 as.double(tri.obj$x),
                 as.double(tri.obj$y),
                 as.integer(tri.obj$tlist),
                 as.integer(tri.obj$tlptr),
                 as.integer(tri.obj$tlend),
                 as.integer(6),
                 nnabs=as.integer(nnabs),
                 nptr=as.integer(nptr),
                 nptr1=as.integer(nptr1),
                 tnabor=as.integer(tnabor),
                 nbnos=as.integer(nbnos),
                 na=as.integer(0),
                 nb=as.integer(0),
                 nt=as.integer(0),
                 PACKAGE = "tripack")
  ans<-list(n=tri.obj$n,
            na=ans$na,
            nb=ans$nb,
            nt=ans$nt,
            nc=tri.obj$nc,
            call=tri.obj$call)
  class(ans)<-"summary.tri"
  ans
}
summary.voronoi<-function(voronoi.obj)
{
  if(!inherits(voronoi.obj,"voronoi"))
    stop("voronoi.obj must be of class \"voronoi\"")
  ans<-list(nn=length(voronoi.obj$x),
            nd=length(voronoi.obj$dummy.x),
            call=voronoi.obj$call)
  class(ans)<-"summary.voronoi"
  ans
}
tri.dellens <- function(voronoi.obj, exceptions = NULL, inverse = FALSE) {
  ## Return a list of delaunay segment lengths.
  ## If exceptions is a list of site numbers (normally that produced by
  ## voronoi.findrejectsites), exclude the voronoi
  ## triangles associated with that site.  If the inverse flag is
  ## TRUE, just return the segment lengths associated with the
  ## sites in the exceptions list.

  ## TODO - maybe this should be under voronoi.dellens, rather than
  ## tri.dellens?

  check.exceptions <- (length(exceptions) >0)
  nsites <- voronoi.obj$tri$n
  ntri <- length(voronoi.obj$p1)
  dists <- matrix(0, nrow=nsites, ncol=nsites)

  rejtri <- logical(length = ntri) # all FALSE

  if (check.exceptions) {
    anyrej <- exceptions[cbind(voronoi.obj$p1, voronoi.obj$p2, voronoi.obj$p3)];
    dim(anyrej) <- c(ntri,3);
    ## rejtri[i] is true if the ith triangle should be rejected.
    rejtri <- apply(anyrej, 1, any)
    if (inverse) rejtri <- !rejtri
  } else {
    ## accept all delauanay triangles.
  }

  ## ps is an Nx3 array - each row is one Delaunay triangle, giving
  ## the three sites in that triangle.
  ps <- cbind(voronoi.obj$p1, voronoi.obj$p2, voronoi.obj$p3)
  ps <- ps[which(!rejtri),] #throw away those triangles (row) not required.

  ## Find the distances between all sites 1,2 in each valid triangle.
  ## Then store those distances in the dists matrix.
  d <- tri.vordist(voronoi.obj, ps[,1], ps[,2])
  dists[ t(apply(ps[,1:2],1,sort))] <- d;

  d <- tri.vordist(voronoi.obj, ps[,2], ps[,3])
  dists[ t(apply(ps[,2:3],1,sort))] <- d;

  d <- tri.vordist(voronoi.obj, ps[,3], ps[,1])
  dists[ t(apply(cbind(ps[,3],ps[,1]),1,sort))] <- d;

  dists[which(dists>0)]
  
    
}

tri.vordist <- function (vor, p1, p2) {
  ## Return the Euclidean distance between site p1 and p2.
  ## Helper function for tri.dellens.
  ##
  ## Testing tri.vordist
  ## can be called fine with multiple arguments
  ## e.g. return distance between pts 1,3 and between pts 2,5
  ## tri.vordist(vor, c(1,2), c(3,5)) 
  ## Can also calculate output by hand, e.g. for pts (2,5)
  ## sqrt((vor$tri$x[2] - vor$tri$x[5])^2 + (vor$tri$y[2] - vor$tri$y[5])^2)

  dx <- vor$tri$x[p1] - vor$tri$x[p2]
  dy <- vor$tri$y[p1] - vor$tri$y[p2]
  sqrt( (dx*dx) + (dy*dy))
}
tri.find<-function(tri.obj,x,y)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  ans<-.Fortran("trfind",
                 as.integer(1),
                 as.double(x),
                 as.double(y),
                 as.integer(tri.obj$n),
                 as.double(tri.obj$x),
                 as.double(tri.obj$y),
                 as.integer(tri.obj$tlist),
                 as.integer(tri.obj$tlptr),
                 as.integer(tri.obj$tlend),
                 i1=as.integer(0),
                 i2=as.integer(0),
                 i3=as.integer(0),
                 PACKAGE = "tripack")
  list(i1=ans$i1,i2=ans$i2,i3=ans$i3)
}
tri.mesh <- function(x,y=NULL,duplicate="error")
{
  if(is.null(x))
     stop("argument x missing.")
  if(is.null(y)){
    x1<-x$x
    y1<-x$y
    if (is.null(x1) || is.null(y1))
      stop("argument y missing and x contains no $x or $y component.")
  }
  else{
    x1<-x
    y1<-y
  }

  n <- length(x1)
  if(length(y1)!=n)
    stop("length of x and y differ.")
  # handle duplicate points:
  xy <- paste(x1, y1, sep =",")
  i <- match(xy, xy)
  if(duplicate!="error")
    {
      if(duplicate!="remove" & duplicate!="error" & duplicate!="strip"){
        stop("possible values for \'duplicate\' are \"error\", \"strip\" and \"remove\"") 
      }
      else{
        if(duplicate=="remove")
          ord <- !duplicated(xy)
        if(duplicate=="strip")
          ord <- (hist(i,plot=F,freq=T,breaks=seq(0.5,max(i)+0.5,1))$counts==1)
        x1 <- x1[ord]
        y1 <- y1[ord]
        n <- length(x1)
      }
    }
  else
    if(any(duplicated(xy)))
      stop("duplicate data points")

  ans<-.Fortran("trmesh",
                as.integer(n),
                x=as.double(x1),
                y=as.double(y1),
                tlist=integer(6*n-12),
                tlptr=integer(6*n-12),
                tlend=integer(n),
                tlnew=as.integer(0),
                tnear=integer(n),
                tnext=integer(n),
                tdist=double(n),
                ier=as.integer(0),
                PACKAGE = "tripack")
  if(ans$ier==0)
    {
      tri.obj<-list(n=n,x=x1,y=y1,tlist=ans$tlist,tlptr=ans$tlptr,
                    tlend=ans$tlend,tlnew=ans$tlnew,
                    nc=0,lc=0,call=match.call())
  }
  else
    stop("error in trmesh")
                  
  class(tri.obj)<-"tri"
  invisible(tri.obj)
}
triangles<-function(tri.obj)
{
  if(!inherits(tri.obj,"tri"))
    stop("tri.obj must be of class \"tri\"")
  nt<-summary(tri.obj)$nt;
  ans<-.Fortran("trlist",
                 as.integer(tri.obj$nc),
                 as.integer(tri.obj$lc),
                 as.integer(tri.obj$n),
                 as.integer(tri.obj$tlist),
                 as.integer(tri.obj$tlptr),
                 as.integer(tri.obj$tlend),
                 as.integer(9),
                 as.integer(nt),
                 tltri=integer(9*nt),
                 lct=integer(tri.obj$nc),
                 ier=as.integer(0),
                 PACKAGE = "tripack")
  ret<-matrix(ans$tltri,nt,9,byrow=T)
  colnames(ret)<-c("node1","node2","node3","tr1","tr2","tr3","arc1","arc2","arc3")
  ret
}
voronoi.area <- function(voronoi.obj)
{
  ## Compute the area of each Voronoi polygon.
  ## If the area of a polygon cannot be computed, NA is returned.
  ##
  ## TODO: currently, the list of Voronoi vertices (vs) of each site
  ## is found, but then discarded.  They could be reused for other
  ## calls?
  
  nsites <- length(voronoi.obj$tri$x)
  areas <- double(nsites)
  for (i in 1:nsites) {
    vs <- voronoi.findvertices(i, voronoi.obj)
    if (length(vs) > 0) {
      areas[i] <- voronoi.polyarea( voronoi.obj$x[vs], voronoi.obj$y[vs])
    } else {
      areas[i] <- NA
    }
  }
  areas
}


voronoi.findvertices <- function(site, vor) {
  ## Helper function.
  ## Return the ordered list of Voronoi vertices for site number SITE
  ## in the Voronoi tesselation.
  
  p <- cbind(vor$p1, vor$p2, vor$p3)
  a <- which(p == site, arr.ind=T)
  vertices <- a[,1]                     #list of the vertice indexes.
  triples <- p[a[,1],]
  triples
  ## Now remove the entries that are not site.

  ## Need to take transpose, as `which' runs down by column, rather
  ## than by row, and we want to keep rows together.
  triples <- t(triples)
  pairs <- triples[ which (triples!= site)]
  m <- matrix(pairs, ncol=2, byrow=T)

  ## Now go through the list of sites and order the vertices.  We
  ## build up the list of vertices in the vector `orderedvs'.  This
  ## vector is truncated to the exact size at the end of the function.


  ## To order the vertices of the Voronoi polygon associated with a
  ## site, we first find all vertices that are associated with a site.
  ## These will come in threes, from the array `triples'.  We then
  ## remove the site number itself from the triples to come up with a
  ## list of pairs.  e.g. trying to find the vertices for site 6:
  
  ## sites     v number
  ## 3 9 6     6
  ## 6 4 3     2
  ## 9 6 7     3
  ## 6 7 4     9
  ##
  ## remove the `6':
  ## sites   v number
  ## 3 9     6
  ## 4 3     2
  ## 9 7     3
  ## 7 4     9
  
  ## and then starting with site 3, we find each subsequent site.
  ## i.e. 3 then 9 (output v 6), then 7 (output v 3), then 4 (output v
  ## 9) then 3 (output v 2).  We are now back to the starting site so
  ## the ordered list of vertices is 6, 3, 9, 2.
  
  orderedvs <- integer(30); vnum <- 1
  orderedvs[vnum] <- vertices[1]; vnum <- 1 + vnum
  firstv <- m[1,1];   nextv <- m[1,2]; m[1,] <- -1; #blank 1st row out.
  looking <- T
  while (looking) {
    ##cat(paste("looking for ", nextv, "\n"))
    t <- which(m == nextv, arr.ind=T)
    if (length(t) == 0) {               #could check length(t) != 1
      ## cannot compute area...
      vnum <- 1; looking <- FALSE
    } else {
      t.row <- t[1,1]
      t.col <- t[1,2]
      orderedvs[vnum] <- vertices[t.row]; vnum <- 1 + vnum
      othercol <- (3 - t.col)            #switch 1 to 2 and vice-versa.
      nextv <- m[ t.row, othercol]
      m[t.row,] <- -1                    #blank this row out.
      if (nextv == firstv) looking <- F
    }
  }

  orderedvs[1:vnum-1]                   #truncate vector to exact length.
}

  
voronoi.polyarea <- function (x, y)
{
  ## Return the area of the polygon given by the points (x[i], y[i]).
  ## Absolute value taken in case coordinates are clockwise.
  ## Taken from the Octave implementation.
  ## Helper function.
  r <- length(x)
  p <- matrix(c(x, y), ncol=2, nrow=r)
  p2 <- matrix( c(y[2:r], y[1],  -x[2:r], -x[1]), ncol=2, nrow=r)
  a <- abs(sum (p * p2 ) / 2)
}
voronoi.findrejectsites <- function(voronoi.obj, xmin, xmax, ymin, ymax)
{
  ## Given a voronoi object, find the reject sites, i.e. those sites
  ## with one of their vertices outside the bounded rectangle given by
  ## (xmin,ymin) and (xm ax,ymax).
  ## Return a vector `rejects': site N is a reject iff rejects[i] is T.
  nsites <- length(voronoi.obj$tri$x)
  rejects <- logical(nsites)
  outsiders <- ((voronoi.obj$x > xmax) | (voronoi.obj$x < xmin) |
                (voronoi.obj$y > ymax) | (voronoi.obj$y < ymin))


  ## In the list below, each site could be rejected more than once.
  rejects[c(voronoi.obj$p1[outsiders], voronoi.obj$p2[outsiders], voronoi.obj$p3[outsiders])] <- T;

  rejects
}
"voronoi.mosaic" <- function(x,y=NULL,duplicate="error")
  {
    
    dummy.node<-function(x0,y0,x1,y1,x2,y2,d)
      {
        # determine a direction orthogonal to p1--p2
        #
        #              p_1
        #               |
        #               |d
        #    p_0 ------>+ - - - - -> dummy_node
        #          r    |
        #               V
        #              p_2------->
        #                    n
        # two versions, r and n
        #

        dx<-  x2-x1
        dy<-  y2-y1
        nx<- -dy
        ny<-  dx
        
        rx<-(x1+x2)/2-x0
        ry<-(y1+y2)/2-y0
        
        lr<-sqrt(rx^2+ry^2)
        ln<-sqrt(nx^2+ny^2)
        # choose the numerically better version
        if(lr > ln)
          {
            vx<-rx/lr
            vy<-ry/lr
            
            if(in.convex.hull(ret$tri,x0,y0))
              d <- d
            else
              d <- -d
          }
        else
          {
            vx<-nx/ln
            vy<-ny/ln
            eps<-1e-7
            if(in.convex.hull(ret$tri,(x1+x2)/2+eps*vx,(y1+y2)/2+eps*vy))
              d <- - d
            else
              d <- d            
          }
        list(x=x0+d*vx,y=y0+d*vy)
      }
    
    tri.obj<-tri.mesh(x=x,y=y,duplicate=duplicate)
    nt<-summary(tri.obj)$nt
    tmptri<-matrix(0,9,2*nt)
    lccc<-matrix(0,4,nt)
    storage.mode(lccc)<-"double"
    iccc<-matrix(0,6,nt)
    storage.mode(iccc)<-"integer"
    ans<-.Fortran("voronoi",
                  as.integer(tri.obj$nc),
                  as.integer(tri.obj$lc),
                  as.integer(tri.obj$n),
                  as.double(tri.obj$x),
                  as.double(tri.obj$y),
                  as.integer(tri.obj$tlist),
                  as.integer(tri.obj$tlptr),
                  as.integer(tri.obj$tlend),
                  as.integer(nt),
                  lccc=as.double(lccc),
                  iccc=as.integer(iccc),
                  lct=integer(tri.obj$nc),
                  as.integer(tmptri),
                  ier=as.integer(0),
                 PACKAGE = "tripack")
    lccc<-matrix(ans$lccc,nt,4,byrow=T)
    iccc<-matrix(ans$iccc,nt,6,byrow=T)
    ret<-list(x=lccc[,1],
              y=lccc[,2],
              node=(lccc[,3]>0),
              area=lccc[,3],
              ratio=lccc[,4],
              n1=iccc[,1],
              n2=iccc[,2],
              n3=iccc[,3],
              p1=iccc[,4],
              p2=iccc[,5],
              p3=iccc[,6],
              tri=tri.obj)

    ret$dummy.x<-integer(0)
    ret$dummy.y<-integer(0)
    dummy.cnt<-0
    dmax<-max(diff(range(ret$x)),diff(range(ret$y)))
    n<-length(ret$x)
    # add dummy nodes on the border of the triangulation
    for (i in 1:n)
      {
        if(ret$node[i])
          # Triangle i has positive area.
          {
            # Find neighbour triangles
            tns<-sort(c(ret$n1[i],ret$n2[i],ret$n3[i]))
            tn1<-tns[1]
            tn2<-tns[2]
            tn3<-tns[3]
            # Handle special cases on the border:
            # (This should better be done in the FORTRAN code!)
            if(any(tns==0))
              {
                if(tns[2]!=0)
                  {
                    # Only one edge of i coincides with border.
                    # Determine nodes of triangle i
                    tr<-c(ret$p1[i],ret$p2[i],ret$p3[i])
                    # Which of these nodes are border nodes (2)?
                    ns<-tr[on.convex.hull(ret$tri,
                                          ret$tri$x[tr],
                                          ret$tri$y[tr])]
                    if(length(ns)==2) 
                      {
                        # 2 points on hull
                        i1<-ns[1]
                        i2<-ns[2]
                        # Find a dummy node 
                        pn<-dummy.node(ret$x[i],ret$y[i],
                                       ret$tri$x[i1],ret$tri$y[i1],
                                       ret$tri$x[i2],ret$tri$y[i2],
                                       dmax)
                        dummy.cnt<- dummy.cnt+1
                        ret$dummy.x[dummy.cnt]<-pn$x
                        ret$dummy.y[dummy.cnt]<-pn$y
                        # update neighbour relation
                        # (negative index indicates dummy node)
                        if(ret$n1[i]==0) ret$n1[i]<- -dummy.cnt
                        if(ret$n2[i]==0) ret$n2[i]<- -dummy.cnt
                        if(ret$n3[i]==0) ret$n3[i]<- -dummy.cnt
                      }
                    # Other cases:
                    #   1 point on hull -- should not happen at all
                    #   3 points on hull -- should not happen here
                    #     see "else" tree
                  }
                else
                  {
                    # Two edges of i coincide with border.
                    # (= 3 points on hull )
                    # that means this triangle forms one corner of
                    # the convex hull
                    # Find out which edge of triangle i is not
                    # on the border: (check if midpoints of edges lay
                    # on hull)
                    tr<-c(ret$p1[i],ret$p2[i],ret$p3[i])
                    edge<-list(from=tr[c(1,2,3)],to=tr[c(2,3,1)])
                    mx <- ret$tri$x[edge$from]-ret$tri$x[edge$to]/2
                    my <- ret$tri$y[edge$from]-ret$tri$y[edge$to]/2
                    eonb <- on.convex.hull(ret$tri,mx,my)
                    # Find two dummy nodes
                    for (id in 1:3){
                      if (eonb[id]){
                        pn<-dummy.node(ret$x[i],ret$y[i],
                                       ret$tri$x[edge$from[id]],
                                       ret$tri$y[edge$from[id]],
                                       ret$tri$x[edge$to[id]],
                                       ret$tri$y[edge$to[id]],
                                       dmax)
                        dummy.cnt<- dummy.cnt+1
                        ret$dummy.x[dummy.cnt]<-pn$x
                        ret$dummy.y[dummy.cnt]<-pn$y
                        # update neighbour relation
                        # (negative index indicates dummy node)
                        if(ret$n1[i]==0) ret$n1[i]<- -dummy.cnt
                        if(ret$n2[i]==0) ret$n2[i]<- -dummy.cnt
                        if(ret$n3[i]==0) ret$n3[i]<- -dummy.cnt
                      }
                    }
                  }
              }
          }
        else
          {
            # A triangle i with area 0:
            # This can't be on the border (already removed in FORTRAN code!).
            # Do nothing.
            tmp<-0
          }
      }    
    ret$call <- match.call()    
    class(ret) <- "voronoi"
    ret
  }
.First.lib <- function(lib, pkg) {
  if(version$major==0 && version$minor < 62)
    stop("This version for R 0.62 or later")
  library.dynam("tripack", pkg, lib)
}

