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