'''3d model generators using rectangular, cylindrical and spherical
'''coordinate systems
'''Cube by SCM
'''Torus by Biskbart
'''All others by Relsoft
'''SetvideoSeg by Plasma357

'''Relsoft 2004
'''Rel.betterwebber.com

DECLARE SUB SaveModel (File$, Model() AS ANY)
DECLARE SUB LoadCubeSolid (Model() AS ANY, xmax%, ymax%, zMax%, Scale!)
DECLARE SUB DrawModel (Model() AS ANY, clr%)
DECLARE SUB SetVideoSeg (Segment%)
DECLARE SUB RotateAndProject (Model() AS ANY, AngleX%, AngleY%, AngleZ%)
DECLARE SUB LoadCylinder (Model() AS ANY, radius%, Slices%, Bands%, zdist%)
DECLARE SUB LoadCube (Model() AS ANY, radius%)
DECLARE SUB LoadHelix (Model() AS ANY, radius%, NumPoints%, Cycles%, zdist%)
DECLARE SUB LoadSphere (Model() AS ANY, radius%, Slices%, Bands%)
DECLARE SUB LoadTorus (Rings%, Bands%, RINGRADIUS%, BandRadius%, Model() AS ANY)
DECLARE SUB LoadPlane (Model() AS ANY, radius%)
DECLARE SUB LoadPlaneSolid (Model() AS ANY, xmax%, ymax%, Scale!)
DEFINT A-Z
REM $DYNAMIC



TYPE Point3d
        x       AS SINGLE                   'Normal 3d coords
        y       AS SINGLE
        z       AS SINGLE
        xr      AS SINGLE                   'Rotated  3d coords
        yr      AS SINGLE
        zr      AS SINGLE
        scrx    AS INTEGER                  'Translated and projected
        scry    AS INTEGER                  '2d Coords
        cull    AS INTEGER                   'visibility check
END TYPE

CONST FALSE = 0, TRUE = NOT FALSE

CONST LENS = 256                            'Z
CONST XCENTER = 160                         '??
CONST YCENTER = 100                         '??

CONST TORNUMRINGS = 20          'Number of Rings outside TORUS
CONST TORNUMBANDS = 10          'Number of PIXEL per RING
CONST TORRINGRADIUS = 65       'Radius of the Ring
CONST TORBANDRADIUS = 20        'Radius of the BAND

CONST PI = 3.14151693#

REDIM SHARED Vpage(32009)  AS INTEGER
DIM SHARED Lcos(359) AS SINGLE
DIM SHARED Lsin(359) AS SINGLE

'Polyhedra stuff
REDIM SHARED Model(1) AS Point3d               '3d  Coords
DIM SHARED Thetax, Thetay, Thetaz
DIM SHARED zcenter, camx%, camy%, camz%


'PreCalc sin and cos lookuptable

FOR i = 0 TO 359
    a! = i * PI / 180
    Lcos(i) = COS(a!)
    Lsin(i) = SIN(a!)
NEXT i



'Initialize 3d stuff
CLS
SCREEN 0
WIDTH 80

LOCATE 1, 1
PRINT "Choose Model:"
PRINT "1. Cube"
PRINT "2. Solid Cube"
PRINT "3. Sphere [Default]"
PRINT "4. Helix"
PRINT "5. Cylinder"
PRINT "6. Torus"
PRINT "7. Plane"
PRINT "8. PlaneSolid"
DO
    K$ = INKEY$
LOOP UNTIL K$ <> ""

SELECT CASE ASC(K$)
        CASE 49
            LoadCube Model(), 50
        CASE 50
            LoadCubeSolid Model(), 6, 8, 6, 14          'cyrix 686 pr233 woot!
        CASE 51
            LoadSphere Model(), 50, 10, 10
        CASE 52
            LoadHelix Model(), 50, 200, 8, 1
        CASE 53
            LoadCylinder Model(), 40, 15, 15, 15
        CASE 54
            LoadTorus TORNUMRINGS, TORNUMBANDS, TORRINGRADIUS, TORBANDRADIUS, Model()
        CASE 55
            LoadPlane Model(), 50
        CASE 56
            LoadPlaneSolid Model(), 16, 16, 7
        CASE ELSE
            LoadSphere Model(), 50, 10, 20
END SELECT
SaveModel "C:\Qbasic\3dTute\Cube.Dat", Model()
CLS
SCREEN 13
RANDOMIZE TIMER

camx% = 0
camy% = 0
camz% = 0

Thetax = INT(RND * 360)
Thetay = INT(RND * 360)
Thetaz = INT(RND * 360)

Vpage(6) = 2560
Vpage(7) = 200
Layer = VARSEG(Vpage(0)) + 1
SetVideoSeg Layer
Finished = 0

DO

     K$ = INKEY$
     SELECT CASE UCASE$(K$)
        CASE "A"
            camz% = camz% + 1
        CASE "Z"
            camz% = camz% - 1
        CASE "S"
            camy% = camy% + 1
        CASE "X"
            camy% = camy% - 1
        CASE "D"
            camx% = camx% + 1
        CASE "C"
            camx% = camx% - 1
        CASE CHR$(0) + "H"
            Thetay = (Thetay + 1) MOD 360
        CASE CHR$(0) + "P"
            Thetay = (Thetay - 1)
                   IF Thetay < 0 THEN Thetay = 359
        CASE CHR$(0) + "K"
            Thetax = (Thetax - 1)
                   IF Thetax < 0 THEN Thetax = 359
        CASE CHR$(0) + "M"
            Thetax = (Thetax + 1) MOD 360
        CASE CHR$(0) + CHR$(&H53)
            Thetaz = (Thetaz - 1)
                   IF Thetaz < 0 THEN Thetaz = 359
        CASE CHR$(0) + CHR$(&H52)
            Thetaz = (Thetaz + 1) MOD 360
        CASE ELSE
    END SELECT
            

     Thetax = (Thetax + 1) MOD 360
     Thetay = (Thetay + 1) MOD 360
     Thetaz = (Thetaz + 1) MOD 360
     RotateAndProject Model(), Thetax, Thetay, Thetaz
     SetVideoSeg Layer
     LINE (0, 0)-(319, 199), 0, BF
     DrawModel Model(), 12
     SetVideoSeg &HA000
     WAIT &H3DA, 8
     PUT (0, 0), Vpage(6), PSET

LOOP UNTIL K$ = CHR$(27)


CLS
SCREEN 0
WIDTH 80

END

REM $STATIC
SUB DrawModel (Model() AS Point3d, clr%) STATIC

FOR i = 0 TO UBOUND(Model)
    x% = INT(Model(i).scrx)
    y% = INT(Model(i).scry)
    IF NOT Model(i).cull THEN
        PSET (x%, y%), clr%
    END IF
NEXT i

END SUB

SUB LoadCube (Model() AS Point3d, radius)
'Generation code by:
'by Steve McCarthy(SCM)

REDIM Model(7) AS Point3d
Theta! = PI / 4
dTheta! = PI / 2

FOR P = 0 TO 7
  Model(P).x = radius * SGN(COS(Theta!))          ' x
  Model(P).y = radius * SGN(SIN(Theta!))          ' y
  Model(P).z = radius - (radius * 2) * (P \ 4)    ' z
  Theta! = Theta! + dTheta!
NEXT P


END SUB

SUB LoadCubeSolid (Model() AS Point3d, xmax, ymax, zMax, Scale!)
'Generation code by:
'by Relsoft=me .;*)
                   
xm = xmax \ 2
ym = ymax \ 2
zm = zMax \ 2
REDIM Model((xmax * ymax * zMax) - 1) AS Point3d
FOR x = -xm TO xm - 1
    FOR y = -ym TO ym - 1
        FOR z = -zm TO zm - 1
            Model(i).x = x * Scale!
            Model(i).y = y * Scale!
            Model(i).z = -z * Scale!
            i = i + 1
        NEXT z
    NEXT y
NEXT x

END SUB

SUB LoadCylinder (Model() AS Point3d, radius, Slices, Bands, zdist)
'Generation code by:
'by Relsoft=me .;*)

'I. Cylindrical to cartesian
'///  x = COS(theta)
'///  y = SIN(theta)
'///  z = z

REDIM Model((Slices * Bands) - 1) AS Point3d
i = 0
z! = zdist * Slices / 2
FOR Slice = 0 TO Slices - 1
FOR Band = 0 TO Bands - 1
    Theta! = (2 * PI / Bands) * Band
    Model(i).x = radius * COS(Theta!)
    Model(i).y = radius * SIN(Theta!)
    Model(i).z = -z!
    i = i + 1
NEXT Band
    z! = z! - zdist
NEXT Slice

END SUB

SUB LoadHelix (Model() AS Point3d, radius, NumPoints, Cycles, zdist)
'Generation code by:
'by Relsoft=me .;*)

'I. Cylindrical to cartesian
'///  x = COS(theta)
'///  y = SIN(theta)
'///  z = z

REDIM Model(NumPoints)  AS Point3d

ADelta! = Cycles * NumPoints / 180
FOR i = 0 TO NumPoints
    angle! = angle! + ADelta!
    Model(i).x = radius * COS(angle! * PI / 180)
    Model(i).y = radius * SIN(angle! * PI / 180)
    Model(i).z = i * zdist - ((zdist * NumPoints) / 2)
NEXT i

END SUB

SUB LoadPlane (Model() AS Point3d, radius)
'Generation code by:
'by Relsoft = me ;*)

REDIM Model(3) AS Point3d
Theta! = 0
FOR i = 0 TO 3
  Model(i).x = radius * (COS(Theta!))
  Model(i).y = radius * (SIN(Theta!))
  Model(i).z = 0
  Theta! = Theta! + PI / 2
NEXT i

END SUB

SUB LoadPlaneSolid (Model() AS Point3d, xmax, ymax, Scale!)
'Generation code by:
'by Relsoft=me .;*)
                 
REDIM Model((xmax * ymax))  AS Point3d

xm = xmax \ 2
ym = ymax \ 2
i = 0
FOR x = -xm TO xm - 1
    FOR y = -ym TO ym - 1
        Model(i).x = x * Scale!
        Model(i).y = y * Scale!
        Model(i).z = 0
        i = i + 1
    NEXT y
NEXT x

END SUB

SUB LoadSpace (Model() AS Point3d, radius, Numstars)
'////Initialize the starting values of our stars
REDIM Model(Numstars) AS Point3d
FOR i = 0 TO UBOUND(Model)
    ax = RND * 360
    ay = RND * 360
    az = RND * 360
    Model(i).x = radius * SIN(ay * PI / 180)
    Model(i).y = radius * COS(ax * PI / 180)
    Model(i).z = radius * SIN(az * PI / 180)
NEXT i

END SUB

SUB LoadSphere (Model() AS Point3d, radius, Slices, Bands)
'Generation code by:
'by Relsoft=me .;*)

'///    x =  p SIN(Phi) COS(theta)
'///    y =  p SIN(Phi) SIN(theta)
'///    z =  p COS(Phi)

REDIM Model((Slices * Bands) - 1) AS Point3d

i = 0
FOR SliceLoop = 0 TO Slices - 1
    Phi! = PI / Slices * SliceLoop
    FOR BandLoop = 0 TO Bands - 1
        Theta! = 2 * -PI / Bands * BandLoop
        Model(i).x = -INT(radius * SIN(Phi!) * COS(Theta!))
        Model(i).y = -INT(radius * SIN(Phi!) * SIN(Theta!))
        Model(i).z = -INT(radius * COS(Phi!))
        i = i + 1
    NEXT BandLoop
NEXT SliceLoop


END SUB

SUB LoadTorus (Rings, Bands, RINGRADIUS, BandRadius, Model() AS Point3d)

'Generation code by:
'by BiskBart

MaxPoint% = Rings * Bands
REDIM Model((MaxPoint%) - 1) AS Point3d

A1! = 2 * PI / Rings: A2! = 2 * PI / Bands
i% = 0
FOR S2% = 0 TO Bands - 1
    FOR S1% = 0 TO Rings - 1
        X1! = COS(S1% * A1!) * RINGRADIUS
        Y1! = SIN(S1% * A1!) * RINGRADIUS
        Model(i%).x = X1! + COS(S1% * A1!) * COS(S2% * A2!) * BandRadius
        Model(i%).y = Y1! + SIN(S1% * A1!) * COS(S2% * A2!) * BandRadius
        Model(i%).z = SIN(S2% * A2!) * BandRadius
        i% = i% + 1
    NEXT S1%
NEXT S2%



END SUB

SUB RotateAndProject (Model() AS Point3d, AngleX, AngleY, AngleZ) STATIC
''Right handed system
''when camera components increase:
''x=goes left
''y=goes down
''z goes into the screen

'''rotation: counter-clockwise of each axis
''ei.  make yourself perpenicular to the axis
''wave your hand from the center of your body to the left.
''That's how it rotates. ;*)


'Precalculate the SIN and COS of each angle
cx! = Lcos(AngleX)
sx! = Lsin(AngleX)
cy! = Lcos(AngleY)
sy! = Lsin(AngleY)
cz! = Lcos(AngleZ)
sz! = Lsin(AngleZ)

'''After2 hours of work, I was able to weed out the constants from
'''Rotate and project N to reduce my muls to 9 instead of 12. woot!!!!

xx! = cy! * cz!
xy! = sx! * sy! * cz! - cx! * sz!
xz! = cx! * sy! * cz! + sx! * sz!

yx! = cy! * sz!
yy! = cx! * cz! + sx! * sy! * sz!
yz! = -sx! * cz! + cx! * sy! * sz!

zx! = -sy!
zy! = sx! * cy!
zz! = cx! * cy!

FOR i = 0 TO UBOUND(Model)

        x! = Model(i).x
        y! = Model(i).y
        z! = Model(i).z

        RotX! = (x! * xx! + y! * xy! + z! * xz!) - camx%
        RotY! = (x! * yx! + y! * yy! + z! * yz!) - camy%
        RotZ! = (x! * zx! + y! * zy! + z! * zz!) - camz%

        Model(i).xr = RotX!
        Model(i).yr = RotY!
        Model(i).zr = RotZ!
        Model(i).cull = FALSE

        'Project
        Distance% = (LENS - RotZ!)
        IF Distance% > 0 THEN
            Model(i).scrx = XCENTER + (LENS * RotX! / Distance%)
            Model(i).scry = YCENTER - (LENS * RotY! / Distance%)
        ELSE
            Model(i).cull = TRUE
        END IF
NEXT i

END SUB

SUB SaveModel (File$, Model() AS Point3d)

F = FREEFILE
OPEN File$ FOR OUTPUT AS #F
FOR i = 0 TO UBOUND(Model)
    a% = Model(i).x
    b% = Model(i).y
    c% = Model(i).z
    PRINT #F, "DATA " + LTRIM$(STR$(a%)) + "," + LTRIM$(STR$(b%)) + "," + LTRIM$(STR$(c%))
NEXT i

CLOSE #F

END SUB

SUB SetVideoSeg (Segment) STATIC
'By Plasma 357 (Jon Petrosky)

DEF SEG

IF VideoAddrOff& = 0 THEN ' First time the sub is called

' We need to find the location of b$AddrC, which holds the graphics
' offset (b$OffC) and segment (b$SegC). Since b$AddrC is in the default
' segment, we can find it by setting it to a certain value, and then
' searching for that value.

SCREEN 13 ' Set b$SegC to A000 (00A0 in memory)
PSET (160, 100), 0 ' Set b$OffC to 7DA0 (not needed in the IDE)

FOR Offset& = 0 TO 32764 ' Search for b$AddrC, which is
IF PEEK(Offset&) = &HA0 THEN ' in the default segment and
IF PEEK(Offset& + 1) = &H7D THEN ' should have a value of
IF PEEK(Offset& + 2) = &H0 THEN ' A0 7D 00 A0.
IF PEEK(Offset& + 3) = &HA0 THEN
VideoAddrOff& = Offset& + 2 ' If we found it, record the
EXIT FOR ' offset of b$SegC and quit
END IF ' looking. (Oddly, changing
END IF ' the b$OffC doesn't seem to
END IF ' do anything, so this is why
END IF ' this sub only changes b$SegC)
NEXT

END IF

' Change b$SegC to the specified Segment

POKE VideoAddrOff&, Segment AND &HFF
POKE VideoAddrOff& + 1, (Segment AND &HFF00&) \ &H100



END SUB