#define root2 (2^.5)
* Main sequence -- instantiates objects, sets properties,
* triggers methods.
close tables
clear
oIcosa = createobject("icosahedron")
oTetra1 = createobject("tetrahedron")
oTetra2 = createobject("tetrahedron")
oIcosa.shapecolor="Cyan"
oTetra1.shapecolor="Orange"
oTetra2.shapecolor="Black"
oTetra2.rotate("X",90)
oWritePOV = createobject("WritePOV")
oWritePOV.axcolor = "Blue"
oWritePOV.makeaxes()
oWritepov.writeoutput(oIcosa)
oWritepov.writeoutput(oTetra1)
oWritepov.writeoutput(oTetra2)
release all
return
* The class definitions below are what define the properties
* and behaviors of the instantiated objects.
define class tetrahedron as polyhedron
shapeid = "T1"
snapshot = "T1points"
shapevolume = 1
enddefine
define class icosahedron as polyhedron
shapeid = "I1"
snapshot = "I1points"
shapevolume = 18.51
enddefine
define class polyhedron as custom
add object oMatrixOps as MatrixOps
add object oQuadrays as Quadrays
shapecolor = ""
degrees = 0 && default rotation angle
axis = "X" && default axis of rotation
pointarch = "allpoints.dbf"
edgearch = "shapes.dbf"
baseformat = "quadrays"
shapeid = "T1"
objedges = ""
objpoints = ""
snapshot = "T1points"
procedure init(shape_selector)
if parameters()>0
this.shapeid = shape_selector
endif
* create local Edges table (alias edges)
this.objedges = sys(3) && unique filename
select * from (this.edgearch) ed ;
where this.shapeid = ed.shapeid ;
into dbf (this.objedges)
* create local (writable) Points table (alias points)
this.objpoints = sys(3) && unique filename
if this.baseformat = "xyz"
select distinct lib.pointid, xcoord, ycoord, zcoord ;
from (this.pointarch) lib, (this.objedges) ed ;
where (ed.id1=lib.pointid or ed.id2=lib.pointid) ;
into dbf (this.objpoints)
endif
if this.baseformat = "quadrays"
this.quad2xyz()
endif
close tables
use (this.objpoints)
index on pointid tag pointid
use
endproc
procedure quad2xyz
local temp(1,5), norecs
select distinct lib.pointid, acoord, bcoord, ccoord, dcoord ;
from (this.pointarch) lib, (this.objedges) ed ;
where (ed.id1=lib.pointid or ed.id2=lib.pointid) ;
into array temp
create table (this.objpoints) ;
(pointid c(5), xcoord n(10,7), ycoord n(10,7), zcoord n(10,7))
use (this.objpoints)
norecs = alen(temp,1)
for i = 1 to norecs
this.oQuadrays.quad2xyz(temp(i,2),temp(i,3),temp(i,4),temp(i,5))
append blank
replace pointid with temp(i,1), ;
xcoord with this.oQuadrays.xyzout(1), ;
ycoord with this.oQuadrays.xyzout(2), ;
zcoord with this.oQuadrays.xyzout(3)
endfor
return
endproc
procedure setcolor(cname)
this.povserver.shapecolor = cname
endproc
procedure setrotate(axis,deg)
this.degrees = deg * pi()/180
this.omatrixops.setdegrees(this.degrees)
this.axis = axis
this.omatrixops.axis = this.axis
endproc
procedure writetable
select select(1)
use (this.objpoints) alias points
copy to (this.snapshot)
use
endproc
procedure rotate(degrees, axis)
if parameters()>0
this.setrotate(degrees, axis)
endif
select select(1)
use (this.objpoints) alias points
do case
case this.axis="X"
this.omatrixops.xrotate()
case this.axis="Y"
this.omatrixops.yrotate()
case this.axis="Z"
this.omatrixops.zrotate()
endcase
select points
use
return
endproc
procedure destroy
close tables
set safety off
erase (this.objedges+".dbf")
erase (this.objpoints+".dbf")
erase (this.objpoints+".cdx")
set safety on
return
endproc
enddefine
define class writepov as custom
cyldiam = "0.04"
drawaxes = .T.
axlength = 2.5
axdiam = "0.02"
shapecolor = "Blue"
axcolor = "Green"
hnd = 0
outputfile = "myfile.pov"
procedure init()
this.startpov()
endproc
procedure writeoutput(obj)
local x1,y1,z1,x2,y2,z2
this.shapecolor = obj.shapecolor
select select(1)
use (obj.objedges) alias edges
select select(1)
use (obj.objpoints) order pointid alias points
select edges && select the Edges table
go top
scan while not eof() && scan to the end
=seek(id1,"points") && get first vertex
x1=points.xcoord
y1=points.ycoord
z1=points.zcoord
=seek(id2,"points") && get second vertex
x2=points.xcoord
y2=points.ycoord
z2=points.zcoord
this.writepoint(x1,y1,z1) && nub
this.writecylinder(x1,y1,z1,x2,y2,z2) && edge
this.writepoint(x2,y2,z2) && nub
endscan
select edges
use
select points
use
return
endproc
procedure startpov()
with this
local filename
filename=this.outputfile
if file(filename)
erase (filename)
endif
.hnd=fcreate(filename)
if .hnd>0
=fopen(filename)
endif
=fputs(.hnd, "//POV-Ray script")
=fputs(.hnd, '#version 3.1')
=fputs(.hnd, 'global_settings { assumed_gamma 2.2 }')
=fputs(.hnd, '#include "colors.inc"')
=fputs(.hnd, '#include "shapes.inc"')
=fputs(.hnd, '#include "glass.inc"')
=fputs(.hnd, '#include "woods.inc"')
=fputs(.hnd, '#include "metals.inc"')
=fputs(.hnd, '#include "textures.inc"')
=fputs(.hnd, '#default {texture{pigment{color White}'+;
'finish{phong 0.01 ambient 0.2 diffuse 0.6}}}')
=fputs(.hnd, '#declare T1 = texture{Gold_Metal}')
=fputs(.hnd, '#declare T2 = texture{T_Wood1} // Oak ')
=fputs(.hnd, '#declare T3 = texture{T_Copper_3A}')
=fputs(.hnd, "")
=fputs(.hnd, "#declare Cam_factor = 8")
=fputs(.hnd, "#declare Camera_X = 1 * Cam_factor")
=fputs(.hnd, "#declare Camera_Y = 0.5 * Cam_factor")
=fputs(.hnd, "#declare Camera_Z = -0.9 * Cam_factor")
=fputs(.hnd, "camera { location ")
=fputs(.hnd, " up <0, 1.0, 0> right <-4/3, 0, 0>")
=fputs(.hnd, " direction <0, 0, 3> look_at <0, 0, 0> ")
=fputs(.hnd, " rotate <0,0,0>}")
=fputs(.hnd, "")
=fputs(.hnd, "light_source { color White }")
=fputs(.hnd, "light_source { color White }")
=fputs(.hnd, "")
=fputs(.hnd, "// Background:")
=fputs(.hnd, "background {color White}")
endwith
endproc
procedure makeaxes
local tempshape, tempdiam
tempshape = this.shapecolor
tempdiam = this.cyldiam
this.shapecolor = this.axcolor
this.cyldiam = this.axdiam
this.writecylinder(this.axlength,0,0,-this.axlength,0,0)
this.writecylinder(0,this.axlength,0,0,-this.axlength,0)
this.writecylinder(0,0,this.axlength,0,0,-this.axlength)
this.shapecolor = tempshape
this.cyldiam = tempdiam
return
endproc
procedure writepoint(a,b,c)
with this
=fputs(.hnd, "sphere{<";
+str(a,10,7)+",";
+str(b,10,7)+",";
+str(c,10,7)+">," + .cyldiam;
+" pigment {color "+ .shapecolor + "} no_shadow}")
endwith
endproc
procedure writecylinder(a,b,c,d,e,f)
* write a line in the POV file defining a cylinder w/ spherical nibs
with this
=fputs(.hnd, "cylinder{<";
+str(a,10,7)+",";
+str(b,10,7)+",";
+str(c,10,7)+">,<";
+str(d,10,7)+",";
+str(e,10,7)+",";
+str(f,10,7)+">," + this.cyldiam;
+" pigment {color "+this.shapecolor+"} no_shadow}")
endwith
endproc
procedure destroy()
=fclose(this.hnd)
? "Write server destroyed"
return
endproc
enddefine
define class matrixops as custom
theta=0
axis=""
cos_theta=0
sin_theta=0
procedure setdegrees(deg)
this.theta = deg
this.cos_theta = cos(this.theta)
this.sin_theta = sin(this.theta)
return
endproc
procedure xrotate
local newx, newy, newz
* / 1 0 0 \
* X AXIS | 0 cos(a) -sin(a) |
* \ 0 sin(a) cos(a) /
scan while not eof()
newx = xcoord
newy = this.cos_theta*ycoord - this.sin_theta*zcoord
newz = this.sin_theta*ycoord + this.cos_theta*zcoord
replace xcoord with newx, ycoord with newy, zcoord with newz
endscan
return
endproc
procedure yrotate
local newx, newy, newz
* / cos(a) 0 -sin(a) \
* Y AXIS | 0 1 0 |
* \ sin(a) 0 cos(a) /
scan while not eof()
newx = this.cos_theta*xcoord - this.sin_theta*zcoord
newy = ycoord
newz = this.sin_theta*xcoord + this.cos_theta*zcoord
replace xcoord with newx, ycoord with newy, zcoord with newz
endscan
return
endproc
procedure zrotate
local newx, newy, newz
* / cos(a) -sin(a) 0 \
* Z AXIS | sin(a) cos(a) 0 |
* \ 0 0 1 /
scan while not eof()
newx = this.cos_theta*xcoord - this.sin_theta*ycoord
newy = this.sin_theta*xcoord + this.cos_theta*ycoord
newz = zcoord
replace xcoord with newx, ycoord with newy, zcoord with newz
endscan
return
endproc
enddefine
define class quadrays as custom
dimension xyzout(3), quadout(4)
procedure quad2xyz(a,b,c,d) && parameters passed from poly object
with this
.xyzout(1) = 1/root2 * (a - b - c + d)
.xyzout(2) = 1/root2 * (a - b + c - d)
.xyzout(3) = 1/root2 * (a + b - c - d)
endwith
endproc
procedure xyz2quad(x,y,z)
with this
.quadout(1) = 1/root2 * (iif(x>=0,x, 0)+iif(y>=0,y, 0)+iif(z>=0,z, 0))
.quadout(2) = 1/root2 * (iif(x>=0,0,-x)+iif(y>=0,0,-y)+iif(z>=0,z, 0))
.quadout(3) = 1/root2 * (iif(x>=0,0,-x)+iif(y>=0,y, 0)+iif(z>=0,0,-z))
.quadout(4) = 1/root2 * (iif(x>=0,x, 0)+iif(y>=0,0,-y)+iif(z>=0,0,-z))
.simplify()
endwith
endproc
* keep quadray coordinates in simplest form
procedure simplify
with this
local i
minval=.quadout(1)
for i=1 to 4
minval = min(minval,.quadout(i))
endfor
for i=1 to 4
.quadout(i)=.quadout(i)-minval
endfor
endwith
endproc
enddefine