rgl: 3D visualization device system (OpenGL)

##
## R source file
## This file is part of rgl
##
## $Id$
##

##
## ===[ SECTION: scene management ]===========================================
##


##
## clear scene
##
##

rgl.clear <- function( type = "shapes", subscene = 0 )
{
  if (is.na(subscene)) 
    subscene <- currentSubscene3d()

  typeid <- rgl.enum.nodetype(type)
  
  userviewpoint <- 4 %in% typeid
  material  <- 5 %in% typeid
  modelviewpoint <- 8 %in% typeid

  drop <- typeid %in% c(4:6, 8)
  typeid <- typeid[!drop]
  type <- names(typeid)
  
  if (subscene == 0) {
    idata <- as.integer(c(length(typeid), typeid))    	
    ret <- .C( rgl_clear, 
      success = FALSE,
      idata
    )$success
  } else {
    sceneids <- rgl.ids(type=type, subscene = 0)$id
    thisids <- rgl.ids(type=type, subscene = subscene)$id
    if (length(thisids)) {
      delFromSubscene3d(ids = thisids, subscene = subscene)
      gc3d(protect = setdiff(sceneids, thisids))
    }
    ret <- 1
  }
  
  if ( userviewpoint || modelviewpoint) 
    rgl.viewpoint(type = c("userviewpoint", "modelviewpoint")[c(userviewpoint, modelviewpoint)])
    
  if ( material ) 
    rgl.material()

  if (! ret)
    stop("rgl_clear failed")
}


##
## pop node
##
##

rgl.pop <- function( type = "shapes", id = 0)
{
  type <- rgl.enum.nodetype(type)
  save <- par3d(skipRedraw = TRUE)
  on.exit(par3d(save))
  for (i in id) {
    idata <- as.integer(c(type, i))

    ret <- .C( rgl_pop,
      success = FALSE,
      idata
    )

    if (! ret$success)
      stop("pop failed for id ", i)
  }
}

rgl.ids <- function( type = "shapes", subscene = NA )
{
  type <- c(rgl.enum.nodetype(type), 0)
  if (is.na(subscene)) 
      subscene <- currentSubscene3d()
  
  count <- .C( rgl_id_count, as.integer(type), count = integer(1), subscene = as.integer(subscene))$count
  
  as.data.frame( .C( rgl_ids, as.integer(type), id=integer(count), 
                                type=rep("",count), subscene = as.integer(subscene) )[2:3] )
}

rgl.attrib.count <- function( id, attrib )
{
  stopifnot(length(attrib) == 1)
  if (is.character(attrib))
    attrib <- rgl.enum.attribtype(attrib)
  
  result <- integer(length(id))
  for (i in seq_along(id))
    result[i] <- .C( rgl_attrib_count, as.integer(id[i]), as.integer(attrib), 
                     count = integer(1))$count
  names(result) <- names(id)
  result
}

rgl.attrib <- function( id, attrib, first=1, 
                        last=rgl.attrib.count(id, attrib) )
{
  stopifnot(length(attrib) == 1 && length(id) == 1 && length(first) == 1)
  if (is.character(attrib))
    attrib <- rgl.enum.attribtype(attrib)
  ncol <- c(vertices=3, normals=3, colors=4, texcoords=2, dim=2, 
            texts=1, cex=1, adj=2, radii=1, centers=3, ids=1,
            usermatrix=4, types=1, flags=1, offsets=1)[attrib]
  count <- max(last - first + 1, 0)
  if (attrib %in% c(6, 13)) { # texts and types
    if (count)
      result <- .C (rgl_text_attrib, as.integer(id), as.integer(attrib), 
                    as.integer(first-1), as.integer(count), 
                result = character(count*ncol))$result
    else
      result <- character(0)
  } else {
    if (count)
      result <- .C (rgl_attrib, as.integer(id), as.integer(attrib), 
                  as.integer(first-1), as.integer(count), 
                  result = numeric(count*ncol))$result
    else
      result <- numeric(0)
  }
  if (attrib == 14) 
    result <- as.logical(result)
  result <- matrix(result, ncol=ncol, byrow=TRUE)
  colnames(result) <- list(c("x", "y", "z"), # vertices
                           c("x", "y", "z"), # normals
                           c("r", "g", "b", "a"), # colors
                           c("s", "t"),	     # texcoords
                           c("r", "c"),      # dim
                           c("text"),	     # texts
                           c("cex"), 	     # cex
                           c("x", "y"),	     # adj
                           "r",		     # radii
                           c("x", "y", "z"), # centers
                           "id",	     # ids
                           c("x", "y", "z", "w"), # usermatrix
                           "type",	     # types
                           "flag",	     # flags
			   "offset"          # offsets
                           )[[attrib]]
  if (attrib == 14 && count)
    if (id %in% rgl.ids("lights", subscene = 0)$id)
      rownames(result) <- c("viewpoint", "finite")[first:last]
    else if (id %in% rgl.ids("background", subscene = 0)$id)
      rownames(result) <- c("sphere", "linear_fog", "exp_fog", "exp2_fog")[first:last]
    else if (id %in% rgl.ids("bboxdeco", subscene = 0)$id)
      rownames(result) <- "draw_front"[first:last]
    else if (id %in% rgl.ids("shapes", subscene = 0)$id)
      rownames(result) <- "ignoreExtent"[first:last]
 
  result
}

##
## ===[ SECTION: environment ]================================================
##



##
## set viewpoint
##
##

rgl.viewpoint <- function( theta = 0.0, phi = 15.0, fov = 60.0, zoom = 1.0, scale = par3d("scale"),
                           interactive = TRUE, userMatrix, type = c("userviewpoint", "modelviewpoint") )
{
  zoom <- rgl.clamp(zoom,0,Inf)
  phi  <- rgl.clamp(phi,-90,90)
  fov  <- rgl.clamp(fov,0,179)
  
  type <- match.arg(type, several.ok = TRUE)

  polar <- missing(userMatrix)
  if (polar) userMatrix <- diag(4)
  
  idata <- as.integer(c(interactive,polar, "userviewpoint" %in% type, "modelviewpoint" %in% type))
  ddata <- as.numeric(c(theta,phi,fov,zoom,scale,userMatrix[1:16]))

  ret <- .C( rgl_viewpoint,
    success = FALSE,
    idata,
    ddata
  )

  if (! ret$success)
    stop("rgl_viewpoint")
}

##
## set background
##
##

rgl.bg <- function(sphere=FALSE, fogtype="none", color=c("black","white"), back="lines", ... )
{
  rgl.material( color=color, back=back, ... )

  fogtype <- rgl.enum.fogtype(fogtype)

  idata   <- as.integer(c(sphere,fogtype))

  ret <- .C( rgl_bg, 
    success = as.integer(FALSE),
    idata
  )

  if (! ret$success)
    stop("rgl_bg")
    
  invisible(ret$success)
}


##
## bbox
##
##

rgl.bbox <- function( 
  xat=NULL, xlab=NULL, xunit=0, xlen=5,
  yat=NULL, ylab=NULL, yunit=0, ylen=5,
  zat=NULL, zlab=NULL, zunit=0, zlen=5,
  marklen=15.0, marklen.rel=TRUE, expand=1, draw_front=FALSE,
  ...) {

  rgl.material( ... )

  if (is.null(xat)) {
    xticks = 0; xlab = NULL;
  } else if (is.null(xlab)) {
    xlab = format(xat)
  } else xlab=rep(xlab,length.out=length(xat))
  if (is.null(yat)) {
    yticks = 0; ylab = NULL;
  } else if (is.null(ylab)) {
    ylab = format(yat)
  } else ylab=rep(ylab,length.out=length(yat))
  if (is.null(zat)) {
    zticks = 0; zlab = NULL;
  } else if (is.null(zlab)) {
    zlab = format(zat)
  }  else zlab=rep(zlab,length.out=length(zat))
  
  xticks <- length(xat)
  yticks <- length(yat)
  zticks <- length(zat)

  if (identical(xunit, "pretty")) xunit = -1;
  if (identical(yunit, "pretty")) yunit = -1;
  if (identical(zunit, "pretty")) zunit = -1;

  length(xticks)      <- 1
  length(yticks)      <- 1
  length(zticks)      <- 1
  length(xlen)        <- 1
  length(ylen)        <- 1
  length(zlen)        <- 1
  length(marklen.rel) <- 1
  length(draw_front)  <- 1
  length(xunit)       <- 1
  length(yunit)       <- 1
  length(zunit)       <- 1
  length(marklen)     <- 1
  length(expand)      <- 1

  idata <- as.integer(c(xticks,yticks,zticks, xlen, ylen, zlen, marklen.rel, draw_front))
  ddata <- as.numeric(c(xunit, yunit, zunit, marklen, expand))

  ret <- .C( rgl_bbox,
    success = FALSE,
    idata,
    ddata,
    as.numeric(xat),
    as.character(xlab),
    as.numeric(yat),
    as.character(ylab),
    as.numeric(zat),
    as.character(zlab)
  )

  if (! ret$success)
    stop("rgl_bbox")
    
  invisible(1)

}

##
## set lights
##
##

rgl.light <- function( theta = 0, phi = 0, viewpoint.rel = TRUE, ambient = "#FFFFFF", diffuse = "#FFFFFF", specular = "#FFFFFF", x = NULL, y = NULL, z = NULL)
{
  ambient  <- rgl.color(ambient)
  diffuse  <- rgl.color(diffuse)
  specular <- rgl.color(specular)
  
  # if a complete set of x, y, z is given, the light source is assumed to be part of the scene, theta and phi are ignored
  # else the light source is infinitely far away and its direction is determined by theta, phi (default) 
  if ( !is.null(x) ) {
    if ( !missing(theta) || !missing(phi) )
      warning("theta and phi ignored when x is present")
    xyz <- xyz.coords(x,y,z)
    x <- xyz$x
    y <- xyz$y
    z <- xyz$z
    if (length(x) > 1) stop("a light can only be in one place at a time")
    finite.pos <- TRUE
  }
  else {
    
    if ( !is.null(y) || !is.null(z) ) 
      warning("y and z ignored, spherical coordinates used")
    finite.pos <- FALSE
    x <- 0
    y <- 0
    z <- 0
    
  }
    

  idata <- as.integer(c(viewpoint.rel, ambient, diffuse, specular, finite.pos))
  ddata <- as.numeric(c(theta, phi, x, y, z))

  ret <- .C( rgl_light,
    success = as.integer(FALSE),
    idata,
    ddata
  )

  if (! ret$success)
    stop("too many lights. maximum is 8 sources per scene.")
    
  invisible(ret$success)
}

##
## ===[ SECTION: shapes ]=====================================================
##

##
## add primitive
##
##

rgl.primitive <- function( type, x, y=NULL, z=NULL, normals=NULL, texcoords=NULL, ... )
{
  rgl.material( ... )

  type <- rgl.enum.primtype(type)
  
  xyz <- xyz.coords(x,y,z,recycle=TRUE)
  x <- xyz$x
  y <- xyz$y
  z <- xyz$z

  vertex  <- rgl.vertex(x,y,z)
  nvertex <- rgl.nvertex(vertex)
  if (nvertex > 0) {
    
    perelement <- c(points=1, lines=2, triangles=3, quadrangles=4, linestrips=1)[type]
    if (nvertex %% perelement) 
      stop("illegal number of vertices")
    
    idata   <- as.integer( c(type, nvertex, !is.null(normals), !is.null(texcoords) ) )
    
    if (is.null(normals)) normals <- 0
    else {
    
      normals <- xyz.coords(normals, recycle=TRUE)
      x <- rep(normals$x, len=nvertex)
      y <- rep(normals$y, len=nvertex)
      z <- rep(normals$z, len=nvertex)
      normals <- rgl.vertex(x,y,z)
    }
    
    if (is.null(texcoords)) texcoords <- 0
    else {
    
      texcoords <- xy.coords(texcoords, recycle=TRUE)
      s <- rep(texcoords$x, len=nvertex)
      t <- rep(texcoords$y, len=nvertex)
      texcoords <- rgl.texcoords(s,t)
    } 
    
    ret <- .C( rgl_primitive,
      success = as.integer(FALSE),
      idata,
      as.numeric(vertex),
      as.numeric(normals),
      as.numeric(texcoords),
      NAOK = TRUE
    );      
        
    if (! ret$success)
      stop("rgl_primitive")
      
    invisible(ret$success)
  }
}

rgl.points <- function ( x, y=NULL, z=NULL, ... )
{
  rgl.primitive( "points", x, y, z, ... )
}

rgl.lines <- function (x, y=NULL, z=NULL, ... )
{
  rgl.primitive( "lines", x, y, z, ... )
}

rgl.triangles <- function (x, y=NULL, z=NULL, normals=NULL, texcoords=NULL, ... )
{
  rgl.primitive( "triangles", x, y, z, normals, texcoords, ... )
}

rgl.quads <- function ( x, y=NULL, z=NULL, normals=NULL, texcoords=NULL, ... )
{
  rgl.primitive( "quadrangles", x, y, z, normals, texcoords, ... )
}

rgl.linestrips<- function ( x, y=NULL, z=NULL, ... )
{
  rgl.primitive( "linestrips", x, y, z, ... )
}

##
## add surface
##
##

# Utility function:
# calculates the parity of a permutation of integers

perm_parity <- function(p) {  
  x <- seq_along(p)
  result <- 0
  for (i in x) {
    if (x[i] != p[i]) {
      x[x==p[i]] <- x[i]
      result <- result+1
    }
  }
  return(result %% 2)
}

rgl.surface <- function( x, z, y, coords=1:3,  ..., normal_x=NULL, normal_y=NULL, normal_z=NULL,
                         texture_s=NULL, texture_t=NULL)
{
  rgl.material(...)
  
  flags <- rep(FALSE, 4)
  
  if (is.matrix(x)) {
    nx <- nrow(x)
    flags[1] <- TRUE
    if ( !identical( dim(x), dim(y) ) ) stop( "bad dimension for rows") 
  } else nx <- length(x)
  
  if (is.matrix(z)) {
    nz <- ncol(z)
    flags[2] <- TRUE
    if ( !identical( dim(z), dim(y) ) ) stop( "bad dimension for cols")     
  } else nz <- length(z)
  
  ny <- length(y)

  if ( nx*nz != ny)
    stop("y length != x rows * z cols")

  if ( nx < 2 )
    stop("rows < 2")
  
  if ( nz < 2 )   
    stop("cols < 2")
    
  if ( length(coords) != 3 || !identical(all.equal(sort(coords), 1:3), TRUE) )
    stop("coords must be a permutation of 1:3")
  
  nulls <- c(is.null(normal_x), is.null(normal_y), is.null(normal_z))
  if (!all( nulls ) ) {
    if (any( nulls )) stop("All normals must be supplied")
    if ( !identical(dim(y), dim(normal_x)) 
      || !identical(dim(y), dim(normal_y))
      || !identical(dim(y), dim(normal_z)) ) stop("bad dimension for normals")
    flags[3] <- TRUE
  }
  
  nulls <- c(is.null(texture_s), is.null(texture_t))
  if (!all( nulls ) ) {
    if (any( nulls )) stop("Both texture coordinates must be supplied")
    if ( !identical(dim(y), dim(texture_s))
      || !identical(dim(y), dim(texture_t)) ) stop("bad dimensions for textures")
    flags[4] <- TRUE
  }

  idata <- as.integer( c( nx, nz ) )

  parity <- (perm_parity(coords) + (x[2] < x[1]) + (z[2] < z[1]) ) %% 2
  
  ret <- .C( rgl_surface,
    success = as.integer(FALSE),
    idata,
    as.numeric(x),
    as.numeric(z),
    as.numeric(y),
    as.numeric(normal_x),
    as.numeric(normal_z),
    as.numeric(normal_y),
    as.numeric(texture_s),
    as.numeric(texture_t),
    as.integer(coords),
    as.integer(parity),
    as.integer(flags),
    NAOK=TRUE
  );

  if (! ret$success)
    stop("rgl_surface failed")
    
  invisible(ret$success)
}

##
## add spheres
##

rgl.spheres <- function( x, y=NULL, z=NULL, radius=1.0,...)
{
  rgl.material(...)

  vertex  <- rgl.vertex(x,y,z)
  nvertex <- rgl.nvertex(vertex)
  radius  <- rgl.attr(radius, nvertex)
  nradius <- length(radius)
  if (!nradius) stop("no radius specified")
  
  idata <- as.integer( c( nvertex, nradius ) )
   
  ret <- .C( rgl_spheres,
    success = as.integer(FALSE),
    idata,
    as.numeric(vertex),    
    as.numeric(radius),
    NAOK=TRUE
  )

  if (! ret$success)
    print("rgl_spheres failed")
    
  invisible(ret$success)

}

##
## add planes
##

rgl.planes <- function( a, b=NULL, c=NULL, d=0,...)
{
  rgl.material(...)

  normals  <- rgl.vertex(a, b, c)
  nnormals <- rgl.nvertex(normals)
  noffsets <- length(d)
  
  idata <- as.integer( c( nnormals, noffsets ) )
   
  ret <- .C( rgl_planes,
    success = as.integer(FALSE),
    idata,
    as.numeric(normals),    
    as.numeric(d),
    NAOK=TRUE
  )

  if (! ret$success)
    print("rgl_planes failed")
    
  invisible(ret$success)

}

##
## add clip planes
##

rgl.clipplanes <- function( a, b=NULL, c=NULL, d=0)
{
  normals  <- rgl.vertex(a, b, c)
  nnormals <- rgl.nvertex(normals)
  noffsets <- length(d)
  
  idata <- as.integer( c( nnormals, noffsets ) )
   
  ret <- .C( rgl_clipplanes,
    success = as.integer(FALSE),
    idata,
    as.numeric(normals),    
    as.numeric(d),
    NAOK=TRUE
  )

  if (! ret$success)
    print("rgl_planes failed")
    
  invisible(ret$success)

}


##
## add abclines
##

rgl.abclines <- function(x, y=NULL, z=NULL, a, b=NULL, c=NULL, ...)
{
  rgl.material(...)

  bases  <- rgl.vertex(x, y, z)
  nbases <- rgl.nvertex(bases)
  directions <- rgl.vertex(a, b, c)
  ndirs <-  rgl.nvertex(directions)
  
  idata <- as.integer( c( nbases, ndirs ) )
   
  ret <- .C( rgl_abclines,
    success = as.integer(FALSE),
    idata,
    as.numeric(bases),    
    as.numeric(directions),
    NAOK=TRUE
  )

  if (! ret$success)
    print("rgl_abclines failed")
    
  invisible(ret$success)

}


##
## add texts
##

rgl.texts <- function(x, y=NULL, z=NULL, text, adj = 0.5, justify, family=par3d("family"), 
                      font=par3d("font"), cex=par3d("cex"), useFreeType=par3d("useFreeType"), ... )
{
  rgl.material( ... )

  if (!missing(justify)) {
     warning("justify is deprecated: please use adj instead")
     if (!missing(adj)) {
        warning("adj and justify both specified: justify ignored")
     } else adj <- switch(justify,left=0,center=0.5,right=1)
  }
  if (length(adj) == 0) adj = c(0.5, 0.5)
  if (length(adj) == 1) adj = c(adj, 0.5)
  if (length(adj) > 2) warning("Only the first two entries of adj are used")
  
  vertex  <- rgl.vertex(x,y,z)
  nvertex <- rgl.nvertex(vertex)
  if (!length(text)) {
    if (nvertex)
      warning("No text to plot")
    return(invisible(integer(0)))
  }
    
  text    <- rep(text, length.out=nvertex)
  
  idata <- as.integer(nvertex)
  
  nfonts <- max(length(family), length(font), length(cex)) 
  family <- rep(family, len=nfonts)
  font <- rep(font, len=nfonts)
  cex <- rep(cex, len=nfonts)  
  
  family[font == 5] <- "symbol"
  font <- ifelse( font < 0 | font > 4, 1, font)  
  
  ret <- .C( rgl_texts,
    success = as.integer(FALSE),
    idata,
    as.double(adj),
    as.character(text),
    as.numeric(vertex),
    as.integer(nfonts),
    as.character(family), 
    as.integer(font),
    as.numeric(cex),
    as.integer(useFreeType),
    NAOK=TRUE
  )
  
  if (! ret$success)
    stop("rgl_texts failed")

  invisible(ret$success)
}

##
## add sprites
##

rgl.sprites <- function( x, y=NULL, z=NULL, radius=1.0, shapes=NULL, 
                         userMatrix=diag(4), ... )
{
  rgl.material(...)

  center  <- rgl.vertex(x,y,z)
  ncenter <- rgl.nvertex(center)
  radius  <- rgl.attr(radius, ncenter)
  nradius <- length(radius)
  if (!nradius) stop("no radius specified")
  if (length(shapes) && length(userMatrix) != 16) stop("invalid userMatrix")
  
  idata   <- as.integer( c(ncenter,nradius,length(shapes)) )
  
  ret <- .C( rgl_sprites,
    success = as.integer(FALSE),
    idata,
    as.numeric(center),
    as.numeric(radius),
    as.integer(shapes),
    as.numeric(userMatrix),
    NAOK=TRUE
  )

  if (! ret$success)
    stop("rgl_sprites failed")

  invisible(ret$success)
}

##
## convert user coordinate to window coordinate
## 

rgl.user2window <- function( x, y=NULL, z=NULL, projection = rgl.projection())
{
  xyz <- xyz.coords(x,y,z,recycle=TRUE)
  points <- rbind(xyz$x,xyz$y,xyz$z)
  
  idata  <- as.integer(ncol(points))
  
  ret <- .C( rgl_user2window,
  	success = FALSE,
	idata,
	as.double(points),
	window=double(length(points)),
	model=as.double(projection$model),
	proj=as.double(projection$proj),
	view=as.integer(projection$view)
  )

  if (! ret$success)
    stop("rgl_user2window failed")
  return(matrix(ret$window, ncol(points), 3, byrow = TRUE))
}

##
## convert window coordinate to user coordiante
## 

rgl.window2user <- function( x, y = NULL, z = 0, projection = rgl.projection())
{
  xyz <- xyz.coords(x,y,z,recycle=TRUE)
  window <- rbind(xyz$x,xyz$y,xyz$z)
  idata  <- as.integer(ncol(window))
  
  ret <- .C( rgl_window2user,
  	success = FALSE,
	idata,
	point=double(length(window)),
	window,
	model=as.double(projection$model),
	proj=as.double(projection$proj),
	view=as.integer(projection$view)
  )

  if (! ret$success)
    stop("rgl_window2user failed")
  return(matrix(ret$point, ncol(window), 3, byrow = TRUE))
}

# Selectstate values
msNONE     <- 1
msCHANGING <- 2
msDONE     <- 3
msABORT    <- 4

rgl.selectstate <- function()
{
	ret <- .C( rgl_selectstate,
    	success = FALSE,
    	state = as.integer(0),
    	mouseposition = double(4)
  	)

  	if (! ret$success)
    	stop("rgl_selectstate")
    return(ret)
}


rgl.select <- function(button = c("left", "middle", "right"))
{
	button <- match.arg(button)
	
	newhandler <- par3d("mouseMode")
	newhandler[button] <- "selecting"
	oldhandler <- par3d(mouseMode = newhandler)
	on.exit(par3d(mouseMode = oldhandler))
	
	while ((result <- rgl.selectstate())$state < msDONE)
		Sys.sleep(0.1)
	
	rgl.setselectstate("none")
	
	if (result$state == msDONE)
	    return(result$mouseposition)
	else
	    return(NULL)
}

rgl.setselectstate <- function(state = "current")
{
	state = rgl.enum(state, current=0, none = 1, middle = 2, done = 3, abort = 4)
	idata <- as.integer(c(state))
	
	  ret <- .C( rgl_setselectstate, 
	    success = FALSE,
	    state = idata
	  )
	
	  if (! ret$success)
	    stop("rgl_setselectstate")

	c("none", "middle", "done", "abort")[ret$state]
}

rgl.projection <- function()
{
    list(model = par3d("modelMatrix"),
    	 proj = par3d("projMatrix"),
    	 view = par3d("viewport"))
}   
     
rgl.select3d <- function(button = c("left", "middle", "right")) {
  rect <- rgl.select(button = button)
  if (is.null(rect)) return(NULL)
  
  llx <- rect[1]
  lly <- rect[2]
  urx <- rect[3]
  ury <- rect[4]
  
  if ( llx > urx ){
  	temp <- llx
  	llx <- urx
  	urx <- temp
  }
  if ( lly > ury ){
  	temp <- lly
  	lly <- ury
  	ury <- temp
  }
  proj <- rgl.projection()
  function(x,y=NULL,z=NULL) {
    pixel <- rgl.user2window(x,y,z,projection=proj)
    x <- pixel[,1]
    y <- pixel[,2]
    z <- pixel[,3]
    (llx <= x) & (x <= urx) & (lly <= y) & (y <= ury) & 
    (0 <= z) & (z <= 1)
  }
}