#define root2 (2^.5) * 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 shapecolor = "Orange" enddefine define class cube as polyhedron shapeid = "C1" snapshot = "C1points" shapevolume = 3 shapecolor = "Green" enddefine define class octahedron as polyhedron shapeid = "O1" snapshot = "O1points" shapevolume = 4 shapecolor = "Red" enddefine define class rhdodeca as polyhedron shapeid = "R1" snapshot = "R1points" shapevolume = 6 shapecolor = "Blue" enddefine define class icosahedron as polyhedron shapeid = "I1" snapshot = "I1points" shapevolume = 18.51229586821915 shapecolor = "Cyan" enddefine define class cubocta as polyhedron shapeid = "V1" snapshot = "V1points" shapevolume = 20 shapecolor = "Yellow" enddefine define class rhtriac as polyhedron shapeid = "RT1" snapshot = "RT1points" shapevolume = 20 * (9/8)^0.5 && 20 * (synergetics constant)^3 emodfactor = 2/(1+5^.5) && 1/phi tmodfactor = ((2^.5 * (2 + 5^.5))/6)^(1/3) && E-mod -> T-mod Rh Triac shapecolor = "Magenta" enddefine define class polyhedron as custom add object oMatrixOps as MatrixOps add object oQuadrays as Quadrays dimension pivot(3) pivot = 0 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 writetable select select(1) use (this.objpoints) alias points copy to (this.snapshot) use endproc procedure translate(p1, p2, p3, p4) local x,y,z if parameters()=4 this.oQuadrays.quad2xyz(p1,p2,p3,p4) x = this.oQuadrays.xyzout(1) y = this.oQuadrays.xyzout(2) z = this.oQuadrays.xyzout(3) else x = p1 y = p2 z = p3 endif select select(1) use (this.objpoints) alias points this.oMatrixOps.translate(x,y,z) this.pivot(1) = this.pivot(1) + x this.pivot(2) = this.pivot(2) + y this.pivot(3) = this.pivot(3) + z select points use return endproc procedure gohome() this.translate(-this.pivot(1),-this.pivot(2),-this.pivot(3)) endproc procedure scale(factor) select select(1) use (this.objpoints) alias points this.oMatrixOps.scale(factor) this.shapevolume = this.shapevolume * factor^3 select points use return 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 rotate(degrees, axis) local posx, posy, posz if parameters()>0 this.setrotate(degrees, axis) endif posx = this.pivot(1) posy = this.pivot(2) posz = this.pivot(3) this.gohome() 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 this.translate(posx,posy,posz) 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 sphere as custom add object oQuadrays as Quadrays dimension pivot(3) pivot = 0 radius = 1 shapecolor = "" shapeid = "SPH" procedure translate(p1, p2, p3, p4) local x,y,z if parameters()=4 this.oQuadrays.quad2xyz(p1,p2,p3,p4) x = this.oQuadrays.xyzout(1) y = this.oQuadrays.xyzout(2) z = this.oQuadrays.xyzout(3) else x = p1 y = p2 z = p3 endif this.pivot(1) = this.pivot(1) + x this.pivot(2) = this.pivot(2) + y this.pivot(3) = this.pivot(3) + z return endproc procedure gohome() this.translate(-this.pivot(1),-this.pivot(2),-this.pivot(3)) endproc procedure scale(factor) this.radius = this.radius * factor this.shapevolume = this.shapevolume * factor^3 return endproc enddefine define class writepoly as custom dimension aedges(1) cyldiam = "0.04" drawaxes = .T. axlength = 2.5 axdiam = "0.02" shapecolor = "Blue" axcolor = "Green" hnd = 0 outputfile = "myfile.txt" edgeindex = 1 procedure init(filename) if parameters()>0 this.outputfile = filename endif this.startoutput() endproc procedure opendata(obj) select select(1) use (obj.objedges) alias edges dimension this.aedges(reccount()) select select(1) use (obj.objpoints) order pointid alias points select edges && select the Edges table go top endproc procedure closedata select edges use select points use return endproc procedure startoutput() this.openfile() endproc procedure writeoutput(obj) local x1,y1,z1,x2,y2,z2 this.shapecolor = obj.shapecolor if obj.shapeid="SPH" this.writesphere(obj) else this.opendata(obj) this.startdata() && not used by all subclasses select edges 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 recno1 = recno("points") =seek(id2,"points") && get second vertex x2=points.xcoord y2=points.ycoord z2=points.zcoord recno2 = recno("points") this.writepoint(x1,y1,z1) && nub this.writeEdge(x1,y1,z1,x2,y2,z2,recno1,recno2) && edge this.writepoint(x2,y2,z2) && nub endscan this.wrapdata() && not used by all subclasses this.closedata() endif return endproc procedure writesphere() endproc procedure openfile() local filename filename=this.outputfile if file(filename) erase (filename) endif this.hnd=fcreate(filename) if this.hnd>0 =fopen(filename) endif return endproc procedure makeaxes local tempshape, tempdiam tempshape = this.shapecolor tempdiam = this.cyldiam this.shapecolor = this.axcolor this.cyldiam = this.axdiam this.writeaxes() this.shapecolor = tempshape this.cyldiam = tempdiam return endproc procedure writeaxes endproc procedure writepoint(a,b,c) =fputs(this.hnd, "Vertex: x="+str(a,10,7)+" y="+str(b,10,7)+" z="+str(c,10,7)) endproc procedure writeEdge(a,b,c,d,e,f,r1,r2) =fputs(this.hnd, "Edge from ("+ ; str(a,10,7)+","+str(b,10,7)+","+str(c,10,7)+") to ("+ ; str(c,10,7)+","+str(d,10,7)+","+str(e,10,7)+") ") endproc procedure startdata endproc procedure wrapdata endproc procedure destroy() =fclose(this.hnd) return endproc enddefine define class writepov as writepoly outputfile = "myfile.pov" procedure startoutput() this.openfile() with this =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_X, Camera_Y, Camera_Z>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, "<Camera_X - 2, Camera_Y + 5 , Camera_Z + 5>light_source { color White }") =fputs(.hnd, "<Camera_X - 2, Camera_Y + 5 , Camera_Z - 3>light_source { color White }") =fputs(.hnd, "") =fputs(.hnd, "// Background:") =fputs(.hnd, "background {color White}") endwith endproc procedure writeaxes this.writeEdge(this.axlength,0,0,-this.axlength,0,0) this.writeEdge(0,this.axlength,0,0,-this.axlength,0) this.writeEdge(0,0,this.axlength,0,0,-this.axlength) 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 writeEdge(a,b,c,d,e,f,r1,r2) * 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)+">," + .cyldiam; +" pigment {color "+.shapecolor+"} no_shadow}") endwith endproc procedure writesphere(obj) with this =fputs(.hnd, "sphere { <" + str(obj.pivot(1),10,7)+", "+ ; str(obj.pivot(2),10,7)+", "+ ; str(obj.pivot(3),10,7)+">, " + str(obj.radius,10,7)) =fputs(.hnd, " texture {") =fputs(.hnd, " pigment {") =fputs(.hnd, " wood") =fputs(.hnd, " color_map {") =fputs(.hnd, " [0.0 color DarkTan]") =fputs(.hnd, " [0.9 color DarkBrown]") =fputs(.hnd, " [1.0 color VeryDarkBrown]") =fputs(.hnd, " }") =fputs(.hnd, " turbulence 0.08") =fputs(.hnd, " }") =fputs(.hnd, " finish { phong .5 }") =fputs(.hnd, " }") =fputs(.hnd, " }") endwith endproc enddefine define class writeVRML as writepoly outputfile = "myfile.wrl" procedure startoutput() this.openfile() with this =fputs(.hnd, '#VRML V1.0 ascii') =fputs(.hnd, 'DEF BackgroundColor Info { string "0.0 0.0 1.0" }') =fputs(.hnd, 'Material { diffuseColor 1 0 0} #end Material set to blue') endwith endproc procedure writeaxes with this =fputs(.hnd, "") =fputs(.hnd, "Coordinate3 {") =fputs(.hnd, " point [") =fputs(.hnd, "0 0 0,") =fputs(.hnd, str(.axlength,10,7)+" 0 0,") =fputs(.hnd, str(-.axlength,10,7)+" 0 0,") =fputs(.hnd, "0 "+str(.axlength,10,7)+" 0,") =fputs(.hnd, "0 "+str(-.axlength,10,7)+" 0,") =fputs(.hnd, "0 0 "+str(.axlength,10,7)+",") =fputs(.hnd, "0 0 "+str(-.axlength,10,7)+",") =fputs(this.hnd, " ]") =fputs(this.hnd, "}") =fputs(this.hnd, "") =fputs(this.hnd, "IndexedLineSet {") =fputs(this.hnd, " coordIndex [") =fputs(this.hnd, " 0, 1, -1,") =fputs(this.hnd, " 0, 2, -1,") =fputs(this.hnd, " 0, 3, -1,") =fputs(this.hnd, " 0, 4, -1,") =fputs(this.hnd, " 0, 5, -1,") =fputs(this.hnd, " 0, 6, -1,") =fputs(this.hnd, " ]") =fputs(this.hnd, "}") endwith return endproc procedure writepoint(a,b,c) endproc procedure writeEdge(a,b,c,d,e,f,r1,r2) =fputs(this.hnd,space(10)+str(r1-1,3)+", "+str(r2-1,3)+ ", -1,") return endproc procedure startdata() =fputs(this.hnd, '') =fputs(this.hnd, 'Coordinate3 {') =fputs(this.hnd, ' point [') select points set order to go top scan while .not. eof() =fputs(this.hnd, str(xcoord,10,7)+" "+str(ycoord,10,7)+" "+str(zcoord,10,7)+",") endscan =fputs(this.hnd, " ]") =fputs(this.hnd, "}") =fputs(this.hnd, "") =fputs(this.hnd, "IndexedLineSet {") =fputs(this.hnd, " coordIndex [") set order to pointid endproc procedure writesphere(obj) with this =fputs(.hnd, "Translation {") =fputs(.hnd, " translation "+str(obj.pivot(1),10,7)+" "+; str(obj.pivot(2),10,7)+" "+; str(obj.pivot(3),10,7)) =fputs(.hnd, "}") =fputs(.hnd, "Sphere {") =fputs(.hnd, " radius "+str(obj.radius,10,7)) =fputs(.hnd, "}") =fputs(.hnd, "Translation {") =fputs(.hnd, " translation "+str(-obj.pivot(1),10,7)+" "+; str(-obj.pivot(2),10,7)+" "+; str(-obj.pivot(3),10,7)) =fputs(.hnd, "}") endwith return endproc procedure wrapdata =fputs(this.hnd, " ]") =fputs(this.hnd, "}") 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 procedure translate(x, y, z) local newx, newy, newz scan while not eof() newx = x + xcoord newy = y + ycoord newz = z + zcoord replace xcoord with newx, ycoord with newy, zcoord with newz endscan return endproc procedure scale(factor) local newx, newy, newz scan while not eof() newx = xcoord * factor newy = ycoord * factor newz = zcoord * factor 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