## R-POVRAY
require(grDevices)
# Scene class
Scene=function(background=Colour(1,1,1)){
self=list(
contents=c(paste("background{",background$format(light=T),"}\n",sep="")),
filepath=tempfile(pattern="rd",tmpdir=tempdir(),fileext=".pov"),
add=function(text){
self$contents=c(self$contents,text)
},
save=function(path=self$filepath){
self$filepath = path
f=file(path,"w")
for(line in self$contents){
cat(line,file=f,sep="\n")
}
close(f)
},
push=function(object){
self$contents=c(self$contents,object$format())
},
render=function(w=640,h=400,aa=F){
self$save()
if(aa){
aa=" +A0.1 "
}else{
aa=" "
}
if(Sys.info()['sysname'] %in% c("Darwin","Linux") ){
POVLOC = Sys.which("povray")
command=paste(" +I",self$filepath,aa," +W",w," +H",h," +P -V",sep="")
}else{
POVLOC="C:\\Program Files\\POV-Ray\\v3.7 RC7\\bin\\pvengine.exe"
command=paste(" +I",self$filepath,aa," +W",w," +H",h," +P -V /EXIT",sep="")
}
out=system2(POVLOC,args=command)
out
}
)
self <- list2env(self)
class(self) <- "Scene"
return(self)
}
# Light class
Light=function(location=c(x,y,z),col=NA){
self=list(
location=location,
col=col,
format=function(){
x=self$location[1]
y=self$location[2]
z=self$location[3]
text=paste("light_source { <",x,",",y,",",z,">",sep="")
if(is.environment(col)){
text=paste(text,col$format(light=T))
}
text=paste(text,"}")
text
}
)
self <- list2env(self)
class(self) <- "Light"
return(self)
}
# Camera class
Camera=function(location=c(x,y,z),looking=c(x2,y2,z2)){
self=list(
location=location,
looking=looking,
format=function(){
x=self$location[1]
y=self$location[2]
z=self$location[3]
x2=self$looking[1]
y2=self$looking[2]
z2=self$looking[3]
text=paste("camera { location <",x,",",y,",",z,"> look_at <",x2,",",y2,",",z2,"> right x*image_width/image_height}",sep="")
text
}
)
self <- list2env(self)
class(self) <- "Camera"
return(self)
}
Colour=Color=function(r=1,g=1,b=1,t=NA,f=NA){
self=list(
r=r,
g=g,
b=b,
t=t,
f=f,
format=function(light=F){
output=""
if(light==F){
output="texture{pigment{"
}
if((is.na(self$t) & is.na(self$f)) | (!is.na(self$t) & !is.na(self$f))){
output = paste(output,"color rgb<",self$r,",",self$g,",",self$b,">",sep="")
}
if(!is.na(t) & is.na(f)){
output = paste(output,"color rgbt<",self$r,",",self$g,",",self$b,",",self$t,">",sep="")
}
if(is.na(t) & !is.na(f)){
output = paste(output,"color rgbf<",self$r,",",self$g,",",self$b,",",self$f,">",sep="")
}
if(light==F){
output=paste(output,"}}")
}
output
}
)
self <- list2env(self)
class(self) <- "Colour"
return(self)
}
Texture=function(tex){
self=list(
tex=tex,
format=function(){
self$tex
}
)
self <- list2env(self)
class(self) <- "Texture"
return(self)
}
Interior=function(interior){
self=list(
interior=interior,
format=function(){
paste("interior{",self$interior,"}")
}
)
self <- list2env(self)
class(self) <- "Interior"
return(self)
}
gen_texture=function(col,tex,interior){
text=""
if(is.environment(col) & !is.environment(tex)){
text=paste(text,col$format(light=F))
}
if(is.environment(tex) & !is.environment(col)){
text=paste(text,"texture{",tex$format(),"}")
}
if(is.environment(tex) & is.environment(col)){
text=paste(text,"texture{",tex$format()," pigment{",col$format(light=T),"}}")
}
if(is.environment(interior)){
text=paste(text,interior$format())
}
text
}
Cylinder=function(start=c(x1,y1,z1),end=c(x2,y2,z2),radius=1,col=NA,tex=NA,interior=NA){
self=list(
start=start,
end=end,
col=col,
tex=tex,
interior=interior,
radius=radius,
transform=c(),
translate=function(translate=c(x,y,z)){
self$transform=c(self$transform,paste("translate{<",translate[1],",",translate[2],",",translate[3],">}"))
},
rotate=function(rotate=c(x,y,z)){
self$transform=c(self$transform,paste("rotate{<",rotate[1],",",rotate[2],",",rotate[3],">}"))
},
scale=function(scale=c(x,y,z)){
if(length(scale)==3){
self$transform=c(self$transform,paste("scale{<",scale[1],",",scale[2],",",scale[3],">}"))
}else{
self$transform=c(self$transform,paste("scale{",scale[1],"}"))
}
},
format=function(){
x1=self$start[1]
y1=self$start[2]
z1=self$start[3]
x2=self$end[1]
y2=self$end[2]
z2=self$end[3]
text=""
text=paste(text,"cylinder{",sep="")
text=paste(text,"<",x1,",",y1,",",z1,">,<",x2,",",y2,",",z2,">,",self$radius,sep="")
text=paste(text,gen_texture(self$col,self$tex,self$interior),sep=" ")
tl=paste(self$transform,sep=" ",collapse=" ")
text=paste(text,tl,sep=" ")
text=paste(text,"} ",sep=" ")
text
}
)
self <- list2env(self)
class(self) <- "Cylinder"
return(self)
}
Cone=function(start=c(x1,y1,z1),end=c(x2,y2,z2),radius=1,radius2=1,col=NA,tex=NA,interior=NA){
self=list(
start=start,
end=end,
col=col,
tex=tex,
interior=interior,
radius=radius,
radius2=radius2,
transform=c(),
translate=function(translate=c(x,y,z)){
self$transform=c(self$transform,paste("translate{<",translate[1],",",translate[2],",",translate[3],">}"))
},
rotate=function(rotate=c(x,y,z)){
self$transform=c(self$transform,paste("rotate{<",rotate[1],",",rotate[2],",",rotate[3],">}"))
},
scale=function(scale=c(x,y,z)){
if(length(scale)==3){
self$transform=c(self$transform,paste("scale{<",scale[1],",",scale[2],",",scale[3],">}"))
}else{
self$transform=c(self$transform,paste("scale{",scale[1],"}"))
}
},
format=function(){
x1=self$start[1]
y1=self$start[2]
z1=self$start[3]
x2=self$end[1]
y2=self$end[2]
z2=self$end[3]
text=""
text=paste(text,"cone{",sep="")
text=paste(text,"<",x1,",",y1,",",z1,">,",self$radius,",<",x2,",",y2,",",z2,">,",self$radius2,sep="")
text=paste(text,gen_texture(self$col,self$tex,self$interior),sep=" ")
tl=paste(self$transform,sep=" ",collapse=" ")
text=paste(text,tl,sep=" ")
text=paste(text,"}",sep=" ")
text
}
)
self <- list2env(self)
class(self) <- "Cylinder"
return(self)
}
Box=function(start=c(x1,y1,z1),end=c(x2,y2,z2),col=NA,tex=NA,interior=NA){
self=list(
start=start,
end=end,
col=col,
tex=tex,
interior=interior,
transform=c(),
translate=function(translate=c(x,y,z)){
self$transform=c(self$transform,paste("translate{<",translate[1],",",translate[2],",",translate[3],">}"))
},
rotate=function(rotate=c(x,y,z)){
self$transform=c(self$transform,paste("rotate{<",rotate[1],",",rotate[2],",",rotate[3],">}"))
},
scale=function(scale=c(x,y,z)){
if(length(scale)==3){
self$transform=c(self$transform,paste("scale{<",scale[1],",",scale[2],",",scale[3],">}"))
}else{
self$transform=c(self$transform,paste("scale{",scale[1],"}"))
}
},
format=function(){
x1=self$start[1]
y1=self$start[2]
z1=self$start[3]
x2=self$end[1]
y2=self$end[2]
z2=self$end[3]
text=""
text=paste(text,"box{",sep="")
text=paste(text,"<",x1,",",y1,",",z1,">,<",x2,",",y2,",",z2,"> ",sep="")
text=paste(text,gen_texture(self$col,self$tex,self$interior),sep=" ")
tl=paste(self$transform,sep=" ",collapse=" ")
text=paste(text,tl,sep=" ")
text=paste(text,"}",sep=" ")
text
}
)
self <- list2env(self)
class(self) <- "Box"
return(self)
}
Sphere=function(centre=c(x1,y1,z1),radius=1,col=NA,tex=NA,interior=NA){
self=list(
centre=centre,
col=col,
tex=tex,
radius=radius,
interior=interior,
transform=c(),
translate=function(translate=c(x,y,z)){
self$transform=c(self$transform,paste("translate{<",translate[1],",",translate[2],",",translate[3],">}"))
},
rotate=function(rotate=c(x,y,z)){
self$transform=c(self$transform,paste("rotate{<",rotate[1],",",rotate[2],",",rotate[3],">}"))
},
scale=function(scale=c(x,y,z)){
if(length(scale)==3){
self$transform=c(self$transform,paste("scale{<",scale[1],",",scale[2],",",scale[3],">}"))
}else{
self$transform=c(self$transform,paste("scale{",scale[1],"}"))
}
},
format=function(){
x1=self$centre[1]
y1=self$centre[2]
z1=self$centre[3]
text=""
text=paste(text,"sphere{",sep="")
text=paste(text,"<",x1,",",y1,",",z1,">,",self$radius,sep="")
text=paste(text,gen_texture(self$col,self$tex,self$interior),sep=" ")
tl=paste(self$transform,sep=" ",collapse=" ")
text=paste(text,tl,sep=" ")
text=paste(text,"}",sep=" ")
text
}
)
self <- list2env(self)
class(self) <- "Sphere"
return(self)
}
norm = function(x){
mn = min(x)
mx = max(x)
x=x-mn
x=x/(mx-mn)
x
}
povplot=function(x,y,z,obj="Sphere",col=Colour(c(1,0,0)),f=NA,t=NA,tex=NA,size=0.1){
require(grDevices)
if(is.environment(col)){
envcol=T
}else{
envcol=F
if(length(col) == length(x)){
varcol=T
}else{
varcol=F
}
colmat=grDevices::col2rgb(col)
}
outlist=list()
x=norm(x)
y=norm(y)
z=norm(z)
for(idx in seq_along(x)){
if(envcol==T){
thiscol=col
}else{
if(varcol==T){
place=idx
}else{
place=1
}
r=as.numeric(colmat[1,place])
g=as.numeric(colmat[2,place])
b=as.numeric(colmat[3,place])
print(c(r,g,b))
thiscol=Colour(r,g,b,f,t)
}
if(obj == "Sphere"){
print(thiscol$r)
print(tex)
os = Sphere(c(x[idx],y[idx],z[idx]),size,col=thiscol,tex=tex)
outlist=c(outlist,os)
}
}
outlist
}
source("R/textures.r")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.