This is working code written in Microsoft Visual FoxPro 5.0, an object oriented version of xBase.
Return to Quadrays and the Concentric Hierarchy


*
*  Shaper is a custom class which includes an Edger
*  defined in procedure file 4DLOGO.PRG
*
* Tables:
*
*  allpoints -- the vertices needed, expressed in 4-tuples
*               (quadray coordinates)
*
*  shapes    -- lists of edges expressed as point pairs
*               (a unique ID relates points to their 4-tuple
*               locations in allpoints)
*
*  triangles -- lists triangles associated with a shape (e.g. icosa)
*
*  Coded in VFP 5.0 xBase
*  by Kirby Urner, Oct 31, 1997
*  Last upgrade:  Nov 8, 1997

set procedure to 4dlogo

oshaper = createobject("shaper")
oshaper.outputfile="test.pov"
oshaper.startpov()
* oshaper.makeshape("T1","Orange")
* oshaper.makeshape("T2","Black")
* oshaper.makeshape("C1","Green")
* oshaper.makeshape("O1","Red")
oshaper.makeshape("R1","Blue")
* oshaper.glassoid=.t.
* oshaper.makeshape("V1","Yellow")
* oshaper.makeshape("VS","Cyan")
* oshaper.makeshape("D1","Brown")
* oshaper.makeshape("I1","Cyan")
* oshaper.scale=.T.
* oshaper.scalefactor=(1+5^.5)/2
* oshaper.makeshape("RT1","Magenta")
* edge=1.0459017287*(5^.5-1)
* oshaper.scalefactor=2 * 1/edge
* oshaper.makeshape("I1","Cyan")
* oshaper.makeshape("IS","Cyan")

oshaper.endpov()

set procedure to
release oshaper
return

define class shaper as custom

    * include a Turtle object as part of class definition
    add object oedger as edger

    * class variables
    visited1 = .f.
    visited2 = .f.
    outputfile=""
    hnd=0
    shapecolor=""
    scale = .f.
    scalefactor = 1
    glassoid = .f.

    * when an object is defined
    procedure init
        close tables
        * open Shapes and Points relational lookup tables
        select select(1)
        use allpoints order pointid
        select select(1)
        use shapes order shapeid
    endproc

    procedure makeshape(shapename, shapecolor)
        this.shapecolor = shapecolor
        * reinitialize visited (tracking which vertices have been visited)
        select allpoints
        replace all visited with .f.
        select shapes
        * scan all point pairs for a shape, loading up
        * vert1 and vert2 and writing out a nibbed cylinder
        * to the POV file
        if seek(shapename)
            mshapeid = shapeid
            scan while mshapeid == shapeid
                this.visited1=.f.
                this.visited2=.f.
                select allpoints
                seek shapes.id1
                this.visited1=allpoints.visited
                replace allpoints.visited with .t.
                if this.scale
                    this.oedger.setpos1(acoord/this.scalefactor,;
                        bcoord/this.scalefactor,;
                        ccoord/this.scalefactor,;
                        dcoord/this.scalefactor)
                    seek shapes.id2
                    this.oedger.setpos2(acoord/this.scalefactor,;
                        bcoord/this.scalefactor,;
                        ccoord/this.scalefactor,;
                        dcoord/this.scalefactor)
                else
                    this.oedger.setpos1(acoord,bcoord,ccoord,dcoord)
                    seek shapes.id2
                    this.visited2=allpoints.visited
                    replace allpoints.visited with .t.
                    this.oedger.setpos2(acoord,bcoord,ccoord,dcoord)
                endif
                this.writecylinder()
                select shapes
            endscan
        endif
    endproc

    procedure writecylinder
        * write a line in the POV file defining a cylinder w/ spherical nibs
        local vert1(3), vert2(3)
        with this
            for i = 1 to 3
                vert1(i)=.oedger.vertex1.xyzpos(i)
                vert2(i)=.oedger.vertex2.xyzpos(i)
            endfor

            if not .visited1
                =fputs(.hnd, "sphere{<";
                    +str(vert1(1),10,7)+",";
                    +str(vert1(2),10,7)+",";
                    +str(vert1(3),10,7)+">,0.04 ";
                    +" pigment {color "+this.shapecolor+"} no_shadow}")

                if .glassoid
                    =fputs(.hnd, "sphere{<";
                        +str(vert1(1),10,7)+",";
                        +str(vert1(2),10,7)+",";
                        +str(vert1(3),10,7)+">,1.0 ";
                        +" texture{Glass} no_shadow}")
                endif

            endif

            =fputs(.hnd, "cylinder{<";
                +str(vert1(1),10,7)+",";
                +str(vert1(2),10,7)+",";
                +str(vert1(3),10,7)+">,<";
                +str(vert2(1),10,7)+",";
                +str(vert2(2),10,7)+",";
                +str(vert2(3),10,7)+">,0.04 ";
                +" pigment {color "+this.shapecolor+"} no_shadow}")

            if not .visited2
                =fputs(.hnd, "sphere{<";
                    +str(vert2(1),10,7)+",";
                    +str(vert2(2),10,7)+",";
                    +str(vert2(3),10,7)+">,0.04 ";
                    +" pigment {color "+this.shapecolor+"} no_shadow}")

                if .glassoid
                    =fputs(.hnd, "sphere{<";
                        +str(vert2(1),10,7)+",";
                        +str(vert2(2),10,7)+",";
                        +str(vert2(3),10,7)+">,1.0 ";
                        +" texture{Glass} no_shadow}")
                endif

            endif

        endwith
    endproc

    procedure startpov(filename)
        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, '#include "colors.inc"')
            =fputs(.hnd, '#include "textures.inc"')
            =fputs(.hnd, "")
            =fputs(.hnd, "#declare Cam_factor = 10")
            =fputs(.hnd, "#declare Camera_X = 1 * Cam_factor")
            =fputs(.hnd, "#declare Camera_Y = 0.3 * Cam_factor")
            =fputs(.hnd, "#declare Camera_Z = -0.7 * Cam_factor")
            =fputs(.hnd, "camera { location  <Camera_X, Camera_Y, Camera_Z>")
            =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}")
        endwith
    endproc

    procedure endpov
        =fclose(this.hnd)
    endproc

enddefine


Synergetics on the Web
maintained by Kirby Urner