This is working code written in Visual FoxPro, and object oriented version of xBase. Return to Color Coordinated Quadrays ```* * cymkTurtle is a subclass of Turtle, previously * defined in procedure file 4DLOGO.PRG * * Calculate positions of color spheres on a quadray * sweepout spherical tetrahedron, and output these * to a PovRay (POV) file. * By Kirby Urner, Oct 17, 1997 * Last upgrade: set procedure to 4dlogo && make sure Turtle class is accessible ocymk = createobject("cymkTurtle") ocymk.calcarcs() ocymk.writepovray() release objects set procedure to return define class cymkturtle as turtle procedure init use datapoints set safety off zap set safety on turtle::init() endproc procedure destroy use endproc procedure calcarcs local a,b1,b2 * ranging from 1 to root(9/8) by 0.0005 * grabbing 2 data points a=1.0 do while a<=(9/8)^.5 b1 = (1/3)*a + (1/3)*(-8*a^2 + 9)^.5 b2 = (1/3)*a - (1/3)*(-8*a^2 + 9)^.5 this.runturtle(a,b1) if b1<>b2 this.runturtle(a,b2) endif a=a+0.0005 enddo a = (9/8)^.5 b1 = (1/3)*a + (1/3)*(-8*a^2 + 9)^.5 this.runturtle(a,b1) * ranging from .999 to 0 by 0.005 * grabbing 1 data point a=0.999 do while a>=0 b1 = (1/3)*a + (1/3)*(-8*a^2 + 9)^.5 this.runturtle(a,b1) a=a-0.005 enddo endproc procedure runturtle(v1, v2) this.makepoint('ab',v1,v2,0,0) this.makepoint('ac',v1,0,v2,0) this.makepoint('ad',v1,0,0,v2) this.makepoint('bc',0,v1,v2,0) this.makepoint('bd',0,v1,0,v2) this.makepoint('cd',0,0,v1,v2) endproc procedure makepoint(edge,a,b,c,d) this.quadmov(a,b,c,d) this.storepos() this.storecolor(edge,a,b,c,d) this.reset() endproc procedure storepos insert into datapoints ; (acoord, bcoord, ccoord, dcoord, ; xcoord, ycoord, zcoord) ; values (this.quadpos(1), this.quadpos(2), ; this.quadpos(3), this.quadpos(4),; this.xyzpos(1), this.xyzpos(2), this.xyzpos(3)) endproc procedure storecolor(edge,c,y,m,k) do case case edge='ab' && cy replace rcolor with 0.0 + y replace gcolor with 1.0 replace bcolor with 1.0 - y case edge='ac' && cm replace rcolor with 0.0 + m replace gcolor with 1.0 - m replace bcolor with 1.0 case edge='ad' && ck replace rcolor with 0.0 replace gcolor with 1.0 - k replace bcolor with 1.0 - k case edge='bc' && ym replace rcolor with 1.0 replace gcolor with 1.0 - m replace bcolor with 0.0 + m case edge='bd' && yk replace rcolor with 1.0 - k replace gcolor with 1.0 - k replace bcolor with 0.0 case edge='cd' && mk replace rcolor with 1.0 - k replace gcolor with 0.0 replace bcolor with 1.0 - k endcase endproc procedure writepovray local hnd if file("quadtet.pov") erase quadtet.pov endif hnd=fcreate("quadtet.pov") if hnd>0 =fopen("quadtet.pov") endif =fputs(hnd, "//POV-Ray script") =fputs(hnd, '#include"colors.inc"') =fputs(hnd, "") =fputs(hnd, "#declare Cam_factor = 6") =fputs(hnd, "#declare Camera_X = 1 * Cam_factor") =fputs(hnd, "#declare Camera_Y = 0.5 * Cam_factor") =fputs(hnd, "#declare Camera_Z = -0.7 * Cam_factor") =fputs(hnd, "camera { location ") =fputs(hnd, " up <0, 1.0, 0> right <-1.33, 0, 0>") =fputs(hnd, " direction <0, 0, 3> look_at <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}") =fputs(hnd, "#declare QuadTet=") =fputs(hnd, "union {") go top nocolorize = .f. scan while not eof() if nocolorize =fputs(hnd, "sphere{<"+str(xcoord,10,7)+","; +str(ycoord,10,7)+","; +str(zcoord,10,7)+">,0.04"; +" pigment {color Blue } no_shadow}") else =fputs(hnd, "sphere{<"+str(xcoord,10,7)+","; +str(ycoord,10,7)+","; +str(zcoord,10,7)+">,0.04"; +" pigment {color rgb<"; +str(rcolor,4,2)+","; +str(gcolor,4,2)+","; +str(bcolor,4,2)+">} no_shadow}") endif endscan =fputs(hnd, "rotate <0, 0, 0> }") =fputs(hnd, "object{QuadTet}") =fclose(hnd) endproc enddefine ``` Synergetics on the Web maintained by Kirby Urner