'LightWave 3d Object files loader by Relsoft
'Supports Quads and tris in object.
'Supports Textures
'Loades with or without texture

'All Lightwave 3d models made by DR. DAVIDSTIEN (Thanks!!!)
'SetVideoSeg by PLASMA
'Orig Poly algo by CGI JOE

'I don't have that much of an experience with 3d OBJ files but
'my friend DR. DAVIDSTIEN says this will work with all OBJ files
'made by any 3d modeller as long as they import OBJ files.
'I only tested this with all the models packaged with this article
'as I don't have a 3d card.
'I only made this loader because of one post by the good doctor at
'Qbasicnews.com.
'Bug:  Quad textures are sometimes screwed. :*(  If you can fix that, it
'would be great and I would be happy to hear from you.
'BTW: I RENAMED ALL .OBJ FILES TO .L3D SO AS NOT TO CONFUSE WITH OBJ FILES
'GENERATED BY QB.
'BE SURE TO SET the PATH$ variable

'Relsoft 2004
'Rel.Betterwebber.com

DECLARE SUB Rel.LoadBMP (File$, SwitchPal%)
DECLARE SUB TextureTri (ox1%, oy1%, ou1%, ov1%, ox2%, oy2%, ou2%, ov2%, ox3%, oy3%, ou3%, ov3%, TSEG%, TOFF%)
DECLARE SUB FindCentroid (Model() AS ANY)
DECLARE SUB ScaleModel (M() AS ANY, Scale!)
DECLARE SUB LoadLightWaveQ (M() AS ANY, P() AS ANY, File$, TSIZE%)
DECLARE SUB DrawModelG (Model() AS ANY, Poly() AS ANY)
DECLARE SUB DrawModelT (Model() AS ANY, Poly() AS ANY)
DECLARE SUB SortPolys (Model() AS ANY, Poly() AS ANY)
DECLARE SUB ShellSort (Poly() AS ANY, Min%, Max%)
DECLARE SUB SetPolyBaseColor (Poly() AS ANY)
DECLARE SUB GouraudTri (ox1%, oy1%, oc1%, ox2%, oy2%, oc2%, ox3%, oy3%, oc3%)
DECLARE SUB GradColor (Col1%, r1%, g1%, b1%, Col2%, r2%, g2%, b2%)
DECLARE SUB CalcNormals (Model() AS ANY, Poly() AS ANY, v() AS ANY, v2() AS ANY)
DECLARE SUB SetVideoSeg (Segment%)
DECLARE SUB RotateAndProject (Model() AS ANY, AngleX%, AngleY%, AngleZ%)
DECLARE SUB RotNormals (v() AS ANY, v2() AS ANY, AngleX%, AngleY%, AngleZ%)
DEFINT A-Z
REM $DYNAMIC

TYPE BMPHeaderType                              'All values are for 320*200*256 bmp
        ID              AS STRING * 2           '"BM"
        size            AS LONG                 'width*heigth+1078= 65078
        RSV1            AS INTEGER              '0 Reserved
        RSV2            AS INTEGER              '0 Reserved
        offset          AS LONG                 '1078  First Pixel(Scanline order)
        HORZ            AS LONG                 '40
        WID             AS LONG                 '320
        HEI             AS LONG                 '200
        PLANES          AS INTEGER              '1   num of Planes
        BPP             AS INTEGER              '8   Bits per Plane
        COMPRESSION     AS LONG                 '0
        IMAGESIZE       AS LONG                 '64000  Width *Height
        XRES            AS LONG                 '3790  X pels
        YRES            AS LONG                 '3780  Y pels
        CLRUSED         AS LONG                 '0 Colors used
        CLRIMPORT       AS LONG                 '0 Colors Important
        Pal             AS STRING * 1024        'Order=Blue*4, Green*4, Red*4, 0 * 4
END TYPE

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

TYPE PolyType
        p1      AS INTEGER              'vertex
        p2      AS INTEGER
        p3      AS INTEGER
        u1      AS INTEGER
        v1      AS INTEGER
        u2      AS INTEGER
        v2      AS INTEGER
        u3      AS INTEGER
        v3      AS INTEGER
        clr     AS INTEGER              'Basecolor for translucency
        idx     AS INTEGER
        zcenter AS INTEGER
END TYPE

TYPE VectorType                         'Normals are vectors
        x      AS SINGLE
        y      AS SINGLE
        z      AS SINGLE
END TYPE


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


CONST TSIZE% = 128                          'TextureSize
                                            'Needed by the Loader!!!
CONST PI = 3.14151693#
CONST FALSE = 0, TRUE = NOT FALSE

REDIM SHARED Vpage(32009)  AS INTEGER       'Virtual page
DIM SHARED Lcos(359) AS SINGLE              'Lookup tables for speed
DIM SHARED Lsin(359) AS SINGLE

REDIM SHARED Model(1) AS Point3d
REDIM SHARED Poly(1) AS PolyType
REDIM SHARED FaceNormal(1) AS VectorType          'Orig Face normal
REDIM SHARED VTXNormal(1) AS VectorType       'Orig Vertex normal
REDIM SHARED VTXNormal2(1) AS VectorType      'Rotated Vertex normal
DIM SHARED ThetaX, ThetaY, ThetaZ           'angle of rotation
DIM SHARED LightNormal AS VectorType        'our light normal
DIM SHARED camx%, camy%, camz%              'camera offset
DIM SHARED Path$

size% = ((TSIZE% * TSIZE%) + 4) \ 2         'Calc array big enough for 64*64 texture
DIM SHARED Texture%(size%)
DIM SHARED TSEG%, TOFF%             'Segment:offset of textures(needed by
                                    'TextureTri sub


'PreCalc sin and cos lookuptable

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

LightNormal.x = 0               'Light normal
LightNormal.y = 0
LightNormal.z = -.6

Path$ = "C:\Qbasic\3dTute\3dObj\"
CLS
SCREEN 0
WIDTH 80

'/============Loader parameters=======================================
'Setup model including normals
Scale! = 20             'Scaling
Textured% = FALSE       'If the model has textures

    FILES Path$ + "*.L3d"
    INPUT "Type in the name of the file to load(default=Ship.L3d):", File$
    IF File$ = "" THEN File$ = "Ship.L3d"
    IF INSTR(File$, ".") = 0 THEN File$ = File$ + ".L3d"
PRINT
PRINT
PRINT "1. Textured"
PRINT "2. Non-Textured(Default)"
K$ = INPUT$(1)
SELECT CASE ASC(K$)
        CASE 49
            Textured% = TRUE
        CASE 50
            Textured% = FALSE
        CASE ELSE
            Textured% = FALSE
END SELECT

j1:
'Load
LoadLightWaveQ Model(), Poly(), Path$ + File$, TSIZE%
ScaleModel Model(), Scale!          'scale
FindCentroid Model()                'center model
'===============end loader==================================================

CLS
SCREEN 13
RANDOMIZE TIMER


'If not textured then calculate normals for gouraud shading
IF NOT Textured% THEN
    'Face normals
    REDIM FaceNormal(1 TO UBOUND(Poly)) AS VectorType
    'Vertex normals
    REDIM VTXNormal(1 TO UBOUND(Model)) AS VectorType
    REDIM VTXNormal2(1 TO UBOUND(Model)) AS VectorType
    RotateAndProject Model(), 0, 0, 0           'may not be  needed
    CalcNormals Model(), Poly(), FaceNormal(), VTXNormal()

    'Set basecolor for each poly
    SetPolyBaseColor Poly()

    'Read ending grad colors and set gradient pal
    RESTORE RGB
    FOR i = 0 TO 15
        READ R%, g%, B%
        GradColor i * 16, 0, 0, 0, (i * 16) + 15, R%, g%, B%
    NEXT i


ELSE        'Generate texture

    'Load bmp as Texture
    Rel.LoadBMP Path$ + "Anya256.bmp", TRUE
    C$ = INPUT$(1)
    'Get our texture
    GET (0, 0)-(TSIZE% - 1, TSIZE% - 1), Texture%


    'Set up texture variables for easy referencing
    TSEG% = VARSEG(Texture%(0))
    TOFF% = VARPTR(Texture%(0))

END IF



ThetaX = INT(RND * 360)
ThetaY = INT(RND * 360)
ThetaZ = INT(RND * 360)

camx% = 0                   'camera
camy% = 0
camz% = 128


Vpage(6) = 2560                    'set up buffer
Vpage(7) = 200
Layer = VARSEG(Vpage(0)) + 1
SetVideoSeg Layer

DO

     'Increment angles
     ThetaX = (ThetaX + 1) MOD 360
     ThetaY = (ThetaY + 1) MOD 360
     ThetaZ = (ThetaZ + 1) MOD 360

     'Rotate model
     RotateAndProject Model(), ThetaX, ThetaY, ThetaZ
     SortPolys Model(), Poly()

     'Set draw to buffer
     SetVideoSeg Layer
     LINE (0, 0)-(319, 199), 0, BF          'cls

     'Draw
     IF NOT Textured% THEN          'Gouraud
        RotNormals VTXNormal(), VTXNormal2(), ThetaX, ThetaY, ThetaZ
        DrawModelG Model(), Poly()
     ELSE                           'Texture
        DrawModelT Model(), Poly()
     END IF

     'Set draw to screen
     SetVideoSeg &HA000
     PUT (0, 0), Vpage(6), PSET     'Pcopy

LOOP UNTIL INKEY$ <> ""


CLS
SCREEN 0
WIDTH 80


END

'RGB colors for our Grad
RGB:
DATA 63,63,63               : 'WHITE
DATA 63,0,0                 : 'RED
DATA 0,63,0                 : 'GREEN
DATA 0,0,63                 : 'BLUE
DATA 0,63,63                : 'BLUE/GREEN
DATA 63,63,0                : 'RED/GREEN
DATA 63,0,63                : 'RED/BLUE
DATA 32,25,63               : '
DATA 63,0,45                : '
DATA 16,63,20               : '
DATA 45,45,63               : '
DATA 63,45,20               : '
DATA 25,63,45               : '
DATA 56,63,34               : '
DATA 45,25,50               : '
DATA 63,25,11               : '

REM $STATIC
SUB CalcNormals (Model() AS Point3d, Poly() AS PolyType, v() AS VectorType, v2() AS VectorType)
'Calculates the face and vertex normals of all the polygons of our model

'Face normals
FOR i = 1 TO UBOUND(v)

    p1 = Poly(i).p1             'vertex
    p2 = Poly(i).p2
    p3 = Poly(i).p3
    x1 = Model(p1).x            'coords
    x2 = Model(p2).x
    x3 = Model(p3).x
    y1 = Model(p1).y
    y2 = Model(p2).y
    y3 = Model(p3).y
    Z1 = Model(p1).z
    Z2 = Model(p2).z
    Z3 = Model(p3).z

    ax! = x2 - x1               'vectors
    bx! = x3 - x2
    ay! = y2 - y1
    by! = y3 - y2
    az! = Z2 - Z1
    bz! = Z3 - Z2

    'Cross product
    xnormal! = ay! * bz! - az! * by!
    ynormal! = az! * bx! - ax! * bz!
    znormal! = ax! * by! - ay! * bx!

    'Normalize
    Mag! = SQR(xnormal! ^ 2 + ynormal! ^ 2 + znormal! ^ 2)
    IF Mag! <> 0 THEN
        xnormal! = xnormal! / Mag!
        ynormal! = ynormal! / Mag!
        znormal! = znormal! / Mag!
    END IF

    v(i).x = xnormal!                  'final face normal
    v(i).y = ynormal!
    v(i).z = znormal!

NEXT i


'VertexNormals
'Algo: since we cannot find a normal to a point(doh?!!!) we find adjacent
        'planes(faces) of the polyhedra that a vertex is located then adding
        'all the facenormals of all the faces that a particular vertex is
        'located.
FOR i = 1 TO UBOUND(Model)
    xnormal! = 0
    ynormal! = 0
    znormal! = 0
    FaceFound = 0
    FOR j = 1 TO UBOUND(Poly)
        IF Poly(j).p1 = i OR Poly(j).p2 = i OR Poly(j).p3 = i THEN
            xnormal! = xnormal! + v(j).x
            ynormal! = ynormal! + v(j).y
            znormal! = znormal! + v(j).z
            FaceFound = FaceFound + 1
        END IF
    NEXT j
    xnormal! = xnormal! / FaceFound
    ynormal! = ynormal! / FaceFound
    znormal! = znormal! / FaceFound

    'Normalize
    Mag! = SQR(xnormal! ^ 2 + ynormal! ^ 2 + znormal! ^ 2)
    IF Mag! <> 0 THEN
        xnormal! = xnormal! / Mag!
        ynormal! = ynormal! / Mag!
        znormal! = znormal! / Mag!
    END IF

    v2(i).x = xnormal!              'Vertex normals
    v2(i).y = ynormal!
    v2(i).z = znormal!
NEXT i

END SUB

SUB DrawModelG (Model() AS Point3d, Poly() AS PolyType) STATIC

FOR i = 1 TO UBOUND(Poly)
    j = Poly(i).idx
    x1 = Model(Poly(j).p1).scrx       'Get triangles from "projected"
    x2 = Model(Poly(j).p2).scrx       'X and Y coords since Znormal
    x3 = Model(Poly(j).p3).scrx       'Does not require a Z coord
    y1 = Model(Poly(j).p1).scry       'V1= Point1 connected to V2 then
    y2 = Model(Poly(j).p2).scry       'V2 to V3 and so on...
    y3 = Model(Poly(j).p3).scry

    znormal = (x2 - x1) * (y1 - y3) - (y2 - y1) * (x1 - x3)
    IF znormal < 0 THEN
        nx1! = VTXNormal2(Poly(j).p1).x         'Vertex1
        ny1! = VTXNormal2(Poly(j).p1).y
        nz1! = VTXNormal2(Poly(j).p1).z
        nx2! = VTXNormal2(Poly(j).p2).x         'Vertex2
        ny2! = VTXNormal2(Poly(j).p2).y
        nz2! = VTXNormal2(Poly(j).p2).z
        nx3! = VTXNormal2(Poly(j).p3).x         'Vertex3
        ny3! = VTXNormal2(Poly(j).p3).y
        nz3! = VTXNormal2(Poly(j).p3).z

        Lx! = LightNormal.x
        ly! = LightNormal.y
        lz! = LightNormal.z

        'Calculate dot-products of vertex normals
        Dot1! = (nx1! * Lx!) + (ny1! * ly!) + (nz1! * lz!)
        IF Dot1! < 0 THEN           'Limit
            Dot1! = 0
        ELSEIF Dot1! > 1 THEN
            Dot1! = 1
        END IF
        Dot2! = (nx2! * Lx!) + (ny2! * ly!) + (nz2! * lz!)
        IF Dot2! < 0 THEN
            Dot2! = 0
        ELSEIF Dot2! > 1 THEN
            Dot2! = 1
        END IF
        Dot3! = (nx3! * Lx!) + (ny3! * ly!) + (nz3! * lz!)
        IF Dot3! < 0 THEN
            Dot3! = 0
        ELSEIF Dot3! > 1 THEN
            Dot3! = 1
        END IF

        'multiply by color range
        Clr1 = (Dot1! * 16) + Poly(j).clr       '16 color grad
        Clr2 = (Dot2! * 16) + Poly(j).clr
        Clr3 = (Dot3! * 16) + Poly(j).clr
        GouraudTri x1, y1, Clr1, x2, y2, Clr2, x3, y3, Clr3
    END IF

NEXT i

END SUB

SUB DrawModelT (Model() AS Point3d, Poly() AS PolyType) STATIC

FOR i = 1 TO UBOUND(Poly)
    j = Poly(i).idx
    x1 = Model(Poly(j).p1).scrx       'Get triangles from "projected"
    x2 = Model(Poly(j).p2).scrx       'X and Y coords since Znormal
    x3 = Model(Poly(j).p3).scrx       'Does not require a Z coord
    y1 = Model(Poly(j).p1).scry       'V1= Point1 connected to V2 then
    y2 = Model(Poly(j).p2).scry       'V2 to V3 and so on...
    y3 = Model(Poly(j).p3).scry

    znormal = (x2 - x1) * (y1 - y3) - (y2 - y1) * (x1 - x3)
    IF znormal < 0 THEN
        u1 = Poly(j).u1         'Texture Coords
        v1 = Poly(j).v1
        u2 = Poly(j).u2
        v2 = Poly(j).v2
        u3 = Poly(j).u3
        v3 = Poly(j).v3
        TextureTri x1, y1, u1, v1, x2, y2, u2, v2, x3, y3, u3, v3, TSEG%, TOFF%
    END IF

NEXT i

END SUB

SUB FindCentroid (Model() AS Point3d)
'Centers the model at (0,0,0)

NP = UBOUND(Model)
x! = 0
y! = 0
z! = 0
FOR i = 1 TO NP
    x! = x! + Model(i).x
    y! = y! + Model(i).y
    z! = z! + Model(i).z
NEXT i
xc! = x! / NP
yc! = y! / NP
zc! = z! / NP

FOR i = 1 TO NP
    Model(i).x = Model(i).x - xc!
    Model(i).y = Model(i).y - yc!
    Model(i).z = Model(i).z - zc!
NEXT i

END SUB

SUB GouraudTri (ox1%, oy1%, oc1%, ox2%, oy2%, oc2%, ox3%, oy3%, oc3%)
'
'
'             /
'        d1 /  |
'         /    |
'         \    |
'          \   |d3
'        d2 \  |
'            \ |
'             \|

'This implementation of the Gouraud triangle routine is
'the the fast FIXPOINT point version.
'Almost the same as a Flat Triangle routine with an added interpolation
'of the color gradients.  Note the comments with '***. It means
'Addition from the Flat filler code to make it a gouraud filler code.

CONST FIXPOINT = 65536

DIM x1 AS INTEGER, y1 AS INTEGER
DIM x2 AS INTEGER, y2 AS INTEGER
DIM x3 AS INTEGER, y3 AS INTEGER

DIM c1 AS INTEGER               '***colors
DIM c2 AS INTEGER
DIM c3 AS INTEGER


DIM dx1 AS INTEGER, dy1 AS INTEGER, dc1 AS INTEGER      '***
DIM dx2 AS INTEGER, dy2 AS INTEGER, dc2 AS INTEGER      '***
DIM dx3 AS INTEGER, dy3 AS INTEGER, dc3 AS INTEGER      '***


DIM delta1&, delta2&, delta3&
DIM CDelta1&, CDelta2&, CDelta3&        '***

DIM Lx&, Rx&
DIM Lc&, Rc&                            '***

x1 = ox1%
y1 = oy1%
c1 = oc1%                               '***

x2 = ox2%
y2 = oy2%
c2 = oc2%                               '***

x3 = ox3%
y3 = oy3%
c3 = oc3%                               '***

IF y2 < y1 THEN
    SWAP y1, y2
    SWAP x1, x2
    SWAP c1, c2                         '***
END IF
IF y3 < y1 THEN
    SWAP y3, y1
    SWAP x3, x1
    SWAP c3, c1                         '***
END IF

IF y3 < y2 THEN
    SWAP y3, y2
    SWAP x3, x2
    SWAP c3, c2                         '***
END IF

dx1 = x2 - x1
dy1 = y2 - y1
dc1 = c2 - c1                           '***
IF dy1 <> 0 THEN
    delta1& = dx1 * FIXPOINT \ dy1
    CDelta1& = dc1 * FIXPOINT \ dy1     '***
ELSE
    delta1& = 0
    CDelta1& = 0                        '***
END IF

dx2 = x3 - x2
dy2 = y3 - y2
dc2 = c3 - c2                           '***
IF dy2 <> 0 THEN
    delta2& = dx2 * FIXPOINT \ dy2
    CDelta2& = dc2 * FIXPOINT \ dy2     '***
ELSE
    delta2& = 0
    CDelta2& = 0                        '***
END IF


dx3 = x1 - x3
dy3 = y1 - y3
dc3 = c1 - c3                          '***
IF dy3 <> 0 THEN
    delta3& = dx3 * FIXPOINT \ dy3
    CDelta3& = dc3 * FIXPOINT \ dy3     '***
ELSE
    delta3& = 0
    CDelta3& = 0                        '***
END IF


'Flat bottom
'Tup part of triangle

Lx& = x1 * FIXPOINT
Rx& = Lx&

Lc& = c1 * FIXPOINT                     '***Left color
Rc& = Lc&                               '***Right Color

FOR y% = y1 TO y2 - 1
    Tx1% = Lx& \ FIXPOINT   '\          '***
    Tx2% = Rx& \ FIXPOINT   ' \   Parameters for GourHline subroutine
    Col1& = Lc&             ' /         '***
    Col2& = Rc&             '/          '***
    GOSUB GourHline                     '***
    Lx& = Lx& + delta1&
    Rx& = Rx& + delta3&
    Lc& = Lc& + CDelta1&                '***    DDA the color grad
    Rc& = Rc& + CDelta3&                '***
NEXT y%

'Flat top
'Lower part of triangle

Lx& = x2 * FIXPOINT
Lc& = c2 * FIXPOINT                     '***

FOR y% = y2 TO y3
    Tx1% = Lx& \ FIXPOINT               '***
    Tx2% = Rx& \ FIXPOINT               '***
    Col1& = Lc&                         '***
    Col2& = Rc&                         '***
    GOSUB GourHline                     '***
    Lx& = Lx& + delta2&
    Rx& = Rx& + delta3&
    Lc& = Lc& + CDelta2&                '***
    Rc& = Rc& + CDelta3&                '***
NEXT y%

EXIT SUB

'**************************************************************************
'Draws a color gradiated horizontal line interpolated from col1 to col2
'Needed variables.
'   Tx1% = integer x1 coordinate
'   Tx2% = integer x2 coordinate
'   y% = integer y coordinate
'   Col1& = Long int of color1 *Fixpoint. In this case 2^16
'   Col2& = Ditto.
'**************************************************************************
GourHline:

    Gx1% = Tx1%             'Save values to be safe
    Gx2% = Tx2%
    yy% = y%

    Clr1& = Col1&
    Clr2& = Col2&

    IF Gx1% > Gx2% THEN             'Sort values
        SWAP Gx1%, Gx2%
        SWAP Clr1&, Clr2&
    END IF
    Gdx% = (Gx2% - Gx1%) + 1       'Get Xdelta(+1) for the Div by 0 error
    Cdx& = Clr2& - Clr1&           'Color delta
    deltac& = Cdx& \ Gdx%          'Interpolate
    Col& = Clr1&                   'save orig color to be safe

    FOR l% = Gx1% TO Gx2%           'Rasterizer loop
        PSET (l%, yy%), (Col& \ FIXPOINT)               'Use poke for speed
        Col& = Col& + deltac&               'DDA
    NEXT l%

RETURN

END SUB

SUB GradColor (Col1, r1, g1, b1, Col2, r2, g2, b2)
'Makes a gradient color by interpolating the RGB values of the first
'color index (col1) and col2 by the number of cols.
'Only use this in screen 13

R! = r1
g! = g1
B! = b1
cols = (Col2 - Col1 + 1)
Rstep! = (r2 - r1 + 1) / cols
Gstep! = (g2 - g1 + 1) / cols
Bstep! = (b2 - b1 + 1) / cols
FOR Col = Col1 TO Col2
    R! = R! + Rstep!
    g! = g! + Gstep!
    B! = B! + Bstep!
    IF R! > 63 THEN R! = 63
    IF R! < 0 THEN R! = 0
    IF g! > 63 THEN g! = 63
    IF g! < 0 THEN g! = 0
    IF B! > 63 THEN B! = 63
    IF B! < 0 THEN B! = 0
    OUT &H3C8, Col
    OUT &H3C9, FIX(R!)
    OUT &H3C9, FIX(g!)
    OUT &H3C9, FIX(B!)
NEXT Col

END SUB

SUB LoadLightWaveQ (M() AS Point3d, P() AS PolyType, File$, TSIZE%)
Textured = 0
DIM utx!(1 TO 4)
DIM vtx!(1 TO 4)

NumTris = 0
NumPoints = 0

currentVert = 0
currentFace = 0

f = FREEFILE
OPEN File$ FOR INPUT AS #f
DO WHILE NOT EOF(f)
        LINE INPUT #f, Temp$
        SELECT CASE MID$(Temp$, 1, 1)
                CASE "f"
                        NumTris = NumTris + 1
                        GOSUB CountVertsQ
                CASE "#"
                        GOSUB GetHeaderQ
                CASE ELSE
        END SELECT
LOOP
CLOSE #f

REDIM P(1 TO NumTris) AS PolyType
f = FREEFILE
OPEN File$ FOR INPUT AS #f
DO WHILE NOT EOF(f)
        LINE INPUT #f, Temp$
        GOSUB RemodelQ
        SELECT CASE LTRIM$(RTRIM$(MID$(Temp$, 1, 2)))
                CASE "v"
                        GOSUB GetVertexQ
                CASE "vt"
                        vtxcounter = vtxcounter + 1
                        GOSUB GetUV
                CASE "f"
                        IF NOT Textured THEN
                                GOSUB GetFacesQ
                        ELSE
                                GOSUB GetFacesQT
                        END IF
                        UVcounter = 0
                CASE ELSE
        END SELECT
LOOP
CLOSE #f

EXIT SUB


'========================Header=======================================
GetHeaderQ:

'///Vertex
Vnum = INSTR(Temp$, "Vertices:")
IF Vnum <> 0 THEN
        Vnum = Vnum + LEN("Vertices:")
        PRINT Vnum
        NumPoints = VAL(MID$(Temp$, Vnum + 1, LEN(Temp$) - Vnum))
        PRINT "Numverts:"; NumPoints
        C$ = INPUT$(1)
        REDIM M(1 TO NumPoints) AS Point3d
END IF

'///Polys
Tnum = INSTR(Temp$, "Faces:")
IF Tnum <> 0 THEN
        Tnum = Tnum + LEN("Faces:")
        'PRINT Tnum
        '''NumTris = VAL(MID$(Temp$, Tnum + 1, LEN(Temp$) - Tnum))
        PRINT "NumFace:"; NumTris
        C$ = INPUT$(1)
        ''REDIM P(1 TO NumTris) AS PolyType
END IF


RETURN

'=========================Vertex====================================

GetVertexQ:
currentVert = currentVert + 1
spc1 = INSTR(Temp$, " ") + 1        '1st space
spc2 = INSTR(spc1, Temp$, " ") + 1  '2nd
spc3 = INSTR(spc2, Temp$, " ") + 1  '3rd
Leng1 = (spc2 - spc1)               'length of value
Leng2 = (spc3 - spc2)
Leng3 = (LEN(Temp$) - spc3) + 2

M(currentVert).x = VAL(MID$(Temp$, spc1, Leng1))
M(currentVert).y = VAL(MID$(Temp$, spc2, Leng2))
M(currentVert).z = -VAL(MID$(Temp$, spc3, Leng3))

RETURN


'=========================Faces======================================
GetFacesQ:

spacecnt = 0
FOR t = 1 TO LEN(Temp$)
        IF MID$(Temp$, t, 1) = " " THEN
                spacecnt = spacecnt + 1
        END IF
NEXT t

IF spacecnt < 4 THEN
        currentFace = currentFace + 1
        spc1 = INSTR(Temp$, " ") + 1       '1st space
        spc2 = INSTR(spc1, Temp$, " ") + 1 '2nd
        spc3 = INSTR(spc2, Temp$, " ") + 1 '3rd

        Leng1 = (spc2 - spc1)           'length of value
        Leng2 = (spc3 - spc2)
        Leng3 = (LEN(Temp$) - spc3) + 2

        P(currentFace).p1 = VAL(MID$(Temp$, spc1, Leng1))        'value of Face 1
        P(currentFace).p2 = VAL(MID$(Temp$, spc2, Leng2))        'ditto
        P(currentFace).p3 = VAL(MID$(Temp$, spc3, Leng3))
        P(currentFace).idx = currentFace
        P(currentFace).clr = 20 + INT(RND * 128)
ELSE
        spc1 = INSTR(Temp$, " ") + 1       '1st space
        spc2 = INSTR(spc1, Temp$, " ") + 1 '2nd
        spc3 = INSTR(spc2, Temp$, " ") + 1 '3rd
        spc4 = INSTR(spc3, Temp$, " ") + 1 '3rd

        Leng1 = (spc2 - spc1)           'length of value
        Leng2 = (spc3 - spc2)
        Leng3 = (spc4 - spc3)
        Leng4 = (LEN(Temp$) - spc4) + 2

        p1 = VAL(MID$(Temp$, spc1, Leng1))        'value of Face 1
        p2 = VAL(MID$(Temp$, spc2, Leng2))        'ditto
        p3 = VAL(MID$(Temp$, spc3, Leng3))
        p4 = VAL(MID$(Temp$, spc4, Leng4))

        currentFace = currentFace + 1
        P(currentFace).p1 = p1
        P(currentFace).p2 = p2
        P(currentFace).p3 = p4
        P(currentFace).idx = currentFace
        P(currentFace).clr = 20 + INT(RND * 128)

        currentFace = currentFace + 1
        P(currentFace).p1 = p2
        P(currentFace).p2 = p3
        P(currentFace).p3 = p4
        P(currentFace).idx = currentFace
        P(currentFace).clr = 20 + INT(RND * 128)

END IF

RETURN


'=========================Faces and UV============================
GetFacesQT:
spacecnt = 0
FOR t = 1 TO LEN(Temp$)
        IF MID$(Temp$, t, 1) = " " THEN
                spacecnt = spacecnt + 1
        END IF
NEXT t

IF spacecnt < 4 THEN
        currentFace = currentFace + 1
        spc1 = INSTR(Temp$, " ") + 1       '1st space
        spc2 = INSTR(spc1, Temp$, " ") + 1 '2nd
        spc3 = INSTR(spc2, Temp$, " ") + 1 '3rd

        Leng1 = (spc2 - spc1)           'length of value
        Leng2 = (spc3 - spc2)
        Leng3 = (LEN(Temp$) - spc3) + 2

        Char1$ = MID$(Temp$, spc1, Leng1)
        Char2$ = MID$(Temp$, spc2, Leng2)
        Char3$ = MID$(Temp$, spc3, Leng3)


        Spc1x = INSTR(Char1$, "/") - 1    '1st slash
        Spc2x = INSTR(Char2$, "/") - 1    '1st slash
        Spc3x = INSTR(Char3$, "/") - 1    '1st slash

        Face1$ = LEFT$(Char1$, Spc1x)
        Face2$ = LEFT$(Char2$, Spc2x)
        Face3$ = LEFT$(Char3$, Spc3x)

        vtx1$ = RIGHT$(Char1$, Leng1 - Spc1x - 1)
        vtx2$ = RIGHT$(Char2$, Leng2 - Spc2x - 1)
        vtx3$ = RIGHT$(Char3$, Leng3 - Spc3x - 2)

        vtx1 = ABS(VAL(vtx1$))
        vtx2 = ABS(VAL(vtx2$))
        vtx3 = ABS(VAL(vtx3$))

        P(currentFace).p1 = VAL(Face1$)        'value of Face 1
        P(currentFace).p2 = VAL(Face2$)
        P(currentFace).p3 = VAL(Face3$)
        P(currentFace).idx = currentFace
        P(currentFace).clr = 20 + INT(RND * 128)

        P(currentFace).u1 = utx!(1) * TSIZE%
        P(currentFace).v1 = vtx!(1) * TSIZE%
        P(currentFace).u2 = utx!(2) * TSIZE%
        P(currentFace).v2 = vtx!(2) * TSIZE%
        P(currentFace).u3 = utx!(3) * TSIZE%
        P(currentFace).v3 = vtx!(3) * TSIZE%


ELSE
        spc1 = INSTR(Temp$, " ") + 1       '1st space
        spc2 = INSTR(spc1, Temp$, " ") + 1 '2nd
        spc3 = INSTR(spc2, Temp$, " ") + 1 '3rd
        spc4 = INSTR(spc3, Temp$, " ") + 1 '4th

        Leng1 = (spc2 - spc1)           'length of value
        Leng2 = (spc3 - spc2)
        Leng3 = (spc4 - spc3)
        Leng4 = (LEN(Temp$) - spc4) + 2

        Char1$ = MID$(Temp$, spc1, Leng1)
        Char2$ = MID$(Temp$, spc2, Leng2)
        Char3$ = MID$(Temp$, spc3, Leng3)
        Char4$ = MID$(Temp$, spc4, Leng4)


        Spc1x = INSTR(Char1$, "/") - 1    '1st slash
        Spc2x = INSTR(Char2$, "/") - 1    '1st slash
        Spc3x = INSTR(Char3$, "/") - 1    '1st slash
        Spc4x = INSTR(Char4$, "/") - 1    '1st slash

        Face1$ = LEFT$(Char1$, Spc1x)
        Face2$ = LEFT$(Char2$, Spc2x)
        Face3$ = LEFT$(Char3$, Spc3x)
        Face4$ = LEFT$(Char4$, Spc4x)

        vtx1$ = RIGHT$(Char1$, Leng1 - Spc1x - 1)
        vtx2$ = RIGHT$(Char2$, Leng2 - Spc2x - 1)
        vtx3$ = RIGHT$(Char3$, Leng3 - Spc3x - 1)
        vtx4$ = RIGHT$(Char4$, Leng4 - Spc4x - 2)

        vtx1 = ABS(VAL(vtx1$))
        vtx2 = ABS(VAL(vtx2$))
        vtx3 = ABS(VAL(vtx3$))
        vtx4 = ABS(VAL(vtx4$))

        p1 = VAL(Face1$)        'value of Face 1
        p2 = VAL(Face2$)
        p3 = VAL(Face3$)
        p4 = VAL(Face4$)


        'First tri
        currentFace = currentFace + 1
        P(currentFace).p1 = p1
        P(currentFace).p2 = p2
        P(currentFace).p3 = p4
        P(currentFace).idx = currentFace
        P(currentFace).clr = 20 + INT(RND * 128)

        P(currentFace).u1 = utx!(1) * TSIZE%
        P(currentFace).v1 = vtx!(1) * TSIZE%
        P(currentFace).u2 = utx!(2) * TSIZE%
        P(currentFace).v2 = vtx!(2) * TSIZE%
        P(currentFace).u3 = utx!(4) * TSIZE%
        P(currentFace).v3 = vtx!(4) * TSIZE%

        'Second tri
        currentFace = currentFace + 1
        P(currentFace).p1 = p2
        P(currentFace).p2 = p3
        P(currentFace).p3 = p4
        P(currentFace).idx = currentFace
        P(currentFace).clr = 20 + INT(RND * 128)

        P(currentFace).u1 = utx!(2) * TSIZE%
        P(currentFace).v1 = vtx!(2) * TSIZE%
        P(currentFace).u2 = utx!(3) * TSIZE%
        P(currentFace).v2 = vtx!(3) * TSIZE%
        P(currentFace).u3 = utx!(4) * TSIZE%
        P(currentFace).v3 = vtx!(4) * TSIZE%




END IF


RETURN


'//==============================Remodel==========================
RemodelQ:
Temp2$ = ""
Leng = LEN(Temp$)
FOR i = 1 TO Leng
        Char$ = MID$(Temp$, i, 2)
        IF Char$ = "- " THEN
                Temp2$ = Temp2$ + LEFT$(Char$, 1)
                i = i + 1
        ELSE
                Temp2$ = Temp2$ + LEFT$(Char$, 1)
        END IF
NEXT i
Temp$ = Temp2$
RETURN


CountVertsQ:
        spacecnt = 0
        FOR t = 1 TO LEN(Temp$)
                IF MID$(Temp$, t, 1) = " " THEN
                        spacecnt = spacecnt + 1
                END IF
                IF MID$(Temp$, t, 1) = "/" THEN
                        Textured = -1
                END IF
        NEXT t
        IF spacecnt > 3 THEN NumTris = NumTris + 1
RETURN


'//==============================UV=============================

GetUV:
UVcounter = UVcounter + 1
'Vertex U,V
spc1 = INSTR(Temp2$, " ") + 1       '1st space
spc2 = INSTR(spc1, Temp2$, " ") + 1 '2nd

Leng1 = (spc2 - spc1)           'length of value
Leng2 = (LEN(Temp2$) - spc2) + 2

u$ = MID$(Temp2$, spc1, Leng1)
v$ = MID$(Temp2$, spc2, Leng2)

UText! = VAL(u$)
VText! = VAL(v$)


utx!(UVcounter) = UText!
vtx!(UVcounter) = VText!

RETURN

END SUB

SUB Rel.LoadBMP (File$, SwitchPal%) STATIC
'Loads a BMP to a layer or directly to the screen
'if you want it to be on screen pass &HA000 as DestSeg%
'only supports 256 color BMPs.
DIM BMP AS BMPHeaderType

f% = FREEFILE                   'Get free filenum
OPEN File$ FOR BINARY AS #f%    'Binary read
GET #f%, , BMP                   'Get header

'Our File Pointer points to 55 byte seek 55, first byte
'Pal should be 1024 in length
Pall$ = BMP.Pal
IF SwitchPal% THEN              'if we switch to pal then
        IF LEN(Pall$) = 1024 THEN
                OUT &H3C8, 0              'color zero start
                FOR i% = 1 TO 1024 STEP 4
                        B% = ASC(MID$(Pall$, i%, 1)) \ 4     'div by 4
                        g% = ASC(MID$(Pall$, i% + 1, 1)) \ 4 'div by 4
                        R% = ASC(MID$(Pall$, i% + 2, 1)) \ 4 'div by 4
                        'Byte 4 unused. Just for padding 32 bit regs
                        OUT &H3C9, R%
                        OUT &H3C9, g%
                        OUT &H3C9, B%
                NEXT i%
        END IF
END IF

'Read and Write time!!!
'Notes: Bad MS(I don't get it why they stored it backwards?)

Byte$ = SPACE$(BMP.WID)
DEF SEG = DestSeg%

Wide% = BMP.WID - 1             'Sub 1 since we start at zero
Hite% = BMP.HEI - 1
FOR y% = Hite% TO 0 STEP -1
        GET #f%, , Byte$
FOR x% = 0 TO Wide%
        C% = ASC(MID$(Byte$, x% + 1, 1))
        PSET (x%, y%), C%
NEXT x%
NEXT y%

END SUB

SUB RotateAndProject (Model() AS Point3d, AngleX, AngleY, AngleZ) STATIC

''Right handed system
''x=goes right
''y=up
''z=goes into you(out of 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.
''or nake a fist and touch your thumb to your nose, the fingers
''curl counter clocwise.
''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 = 1 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!


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

END SUB

SUB RotNormals (v() AS VectorType, v2() AS VectorType, AngleX, AngleY, AngleZ)

'We don't have to calculate normals in real time but we could instead
'rotate them just as we would rotate our points.

'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 = 1 TO UBOUND(v)

        x! = v(i).x       'Load Original normals
        y! = v(i).y
        z! = v(i).z

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

        v2(i).x = RotX!             'Rotated normals
        v2(i).y = RotY!
        v2(i).z = RotZ!
NEXT i

END SUB

SUB ScaleModel (M() AS Point3d, Scale!)
FOR i = 1 TO UBOUND(M)
        M(i).x = M(i).x * Scale!
        M(i).y = M(i).y * Scale!
        M(i).z = M(i).z * Scale!
NEXT i

END SUB

SUB SetPolyBaseColor (Poly() AS PolyType)
'Sets the basecolor for each poly for use in translucency

    FOR i% = 1 TO UBOUND(Poly)
        C% = ((C% MOD 15) + 1) * 16
        Poly(i%).clr = C%
        i% = i% + 1            'Unrem these 2 lines ;*)
        Poly(i%).clr = C%
    NEXT i%

END SUB

SUB SetVideoSeg (Segment) STATIC

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

SUB ShellSort (Poly() AS PolyType, Min, Max)
    'Shell sort Algorithm
    ' Set comparison offset to half the number of records.
    offset = Max \ 2

    ' Loop until offset gets to zero.
    DO WHILE offset > 0

        Limit = Max - offset

        DO

            ' Assume no switches at this offset.
            Switch = FALSE

            ' Compare elements for the specified field and switch
            ' any that are out of order.
            FOR i = Min TO Limit - 1
                Ti = Poly(i).zcenter
                Tj = Poly(i + offset).zcenter
                        IF Ti > Tj THEN
                            SWAP Poly(i).idx, Poly(i + offset).idx
                            SWAP Poly(i).zcenter, Poly(i + offset).zcenter
                            Switch = i
                        END IF

            NEXT i

            ' Sort on next pass only to location where last switch was made.
            Limit = Switch

        LOOP WHILE Switch

        ' No switches at last offset. Try an offset half as big.
        offset = offset \ 2
    LOOP


END SUB

SUB SortPolys (Model() AS Point3d, Poly() AS PolyType)

 FOR i% = 1 TO UBOUND(Poly)
  Poly(i%).zcenter = Model(Poly(i%).p1).zr + Model(Poly(i%).p2).zr + Model(Poly(i%).p3).zr
  Poly(i%).idx = i%
 NEXT i%

 ShellSort Poly(), 1, UBOUND(Poly) + 1
                                    
END SUB

SUB TextureTri (ox1%, oy1%, ou1%, ov1%, ox2%, oy2%, ou2%, ov2%, ox3%, oy3%, ou3%, ov3%, TSEG%, TOFF%)
'
'
'             /
'        d1 /  |
'         /    |
'         \    |
'          \   |d3
'        d2 \  |
'            \ |
'             \|

'This implementation of the Textured triangle routine is
'the the fast FIXPOINT point version.
'Almost the same as a Flat Triangle routine with an added interpolation
'of the U and V Texture coordinates.  Note the comments with '***. It means
'Addition from the Flat filler code to make it a Texture filler code.

CONST FIXPOINT = 65536

DIM x1 AS INTEGER, y1 AS INTEGER
DIM x2 AS INTEGER, y2 AS INTEGER
DIM x3 AS INTEGER, y3 AS INTEGER

DIM u1 AS INTEGER, v1 AS INTEGER               '***texture coords
DIM u2 AS INTEGER, v2 AS INTEGER
DIM u3 AS INTEGER, v3 AS INTEGER


DIM dx1 AS INTEGER, dy1 AS INTEGER, du1 AS INTEGER, dv1  AS INTEGER      '***
DIM dx2 AS INTEGER, dy2 AS INTEGER, du2 AS INTEGER, dv2  AS INTEGER      '***
DIM dx3 AS INTEGER, dy3 AS INTEGER, du3 AS INTEGER, dv3  AS INTEGER      '***


DIM delta1&, delta2&, delta3&
DIM UDelta1&, UDelta2&, UDelta3&        '***
DIM VDelta1&, VDelta2&, VDelta3&        '***

DIM Lx&, Rx&
DIM Lu&, Ru&                            '***
DIM Lv&, Rv&                            '***

x1 = ox1%
y1 = oy1%
u1 = ou1%                               '***
v1 = ov1%                               '***

x2 = ox2%
y2 = oy2%
u2 = ou2%                               '***
v2 = ov2%                               '***

x3 = ox3%
y3 = oy3%
u3 = ou3%                               '***
v3 = ov3%                               '***



DEF SEG = TSEG%
TEXTUREWID% = (PEEK(TOFF%) + PEEK(TOFF% + 1) * 256) \ 8
TWM1% = TEXTUREWID% - 1

IF y2 < y1 THEN
    SWAP y1, y2
    SWAP x1, x2
    SWAP u1, u2
    SWAP v1, v2
END IF
IF y3 < y1 THEN
    SWAP y3, y1
    SWAP x3, x1
    SWAP u3, u1
    SWAP v3, v1
END IF

IF y3 < y2 THEN
    SWAP y3, y2
    SWAP x3, x2
    SWAP u3, u2
    SWAP v3, v2
END IF

dx1 = x2 - x1
dy1 = y2 - y1
du1 = u2 - u1                           '***
dv1 = v2 - v1
IF dy1 <> 0 THEN
    delta1& = dx1 * FIXPOINT \ dy1
    UDelta1& = du1 * FIXPOINT \ dy1     '***
    VDelta1& = dv1 * FIXPOINT \ dy1     '***
ELSE
    delta1& = 0
    UDelta1& = 0                        '***
    VDelta1& = 0                        '***
END IF

dx2 = x3 - x2
dy2 = y3 - y2
du2 = u3 - u2                           '***
dv2 = v3 - v2
IF dy2 <> 0 THEN
    delta2& = dx2 * FIXPOINT \ dy2
    UDelta2& = du2 * FIXPOINT \ dy2     '***
    VDelta2& = dv2 * FIXPOINT \ dy2     '***
ELSE
    delta2& = 0
    UDelta2& = 0                        '***
    VDelta2& = 0                        '***
END IF


dx3 = x1 - x3
dy3 = y1 - y3
du3 = u1 - u3                           '***
dv3 = v1 - v3
IF dy3 <> 0 THEN
    delta3& = dx3 * FIXPOINT \ dy3
    UDelta3& = du3 * FIXPOINT \ dy3     '***
    VDelta3& = dv3 * FIXPOINT \ dy3     '***
ELSE
    delta3& = 0
    UDelta3& = 0                        '***
    VDelta3& = 0                        '***
END IF


'Flat bottom
'Tup part of triangle

Lx& = x1 * FIXPOINT
Rx& = Lx&

Lu& = u1 * FIXPOINT                     '***Left U
Ru& = Lu&                               '***Right U
Lv& = v1 * FIXPOINT                     '***Left V
Rv& = Lv&                               '***Right V


FOR y% = y1 TO y2 - 1
    Tx1% = Lx& \ FIXPOINT   '\          '***
    Tx2% = Rx& \ FIXPOINT   ' \   Parameters for TextureHline subroutine
    TLu1& = Lu&             ' /         '***
    TLu2& = Ru&             '/
    TLv1& = Lv&            '/           '***
    TLv2& = Rv&
    GOSUB TextureHline                  '***
    Lx& = Lx& + delta1&
    Rx& = Rx& + delta3&
    Lu& = Lu& + UDelta1&                '***
    Ru& = Ru& + UDelta3&                '***
    Lv& = Lv& + VDelta1&                '***
    Rv& = Rv& + VDelta3&                '***
NEXT y%

'Flat top
'Lower part of triangle

Lx& = x2 * FIXPOINT
Lu& = u2 * FIXPOINT                     '***
Lv& = v2 * FIXPOINT                     '***

FOR y% = y2 TO y3
    Tx1% = Lx& \ FIXPOINT   '\          '***
    Tx2% = Rx& \ FIXPOINT   ' \   Parameters for TextureHline subroutine
    TLu1& = Lu&             ' /         '***
    TLu2& = Ru&             '/
    TLv1& = Lv&            '/           '***
    TLv2& = Rv&
    GOSUB TextureHline                  '***
    Lx& = Lx& + delta2&
    Rx& = Rx& + delta3&
    Lu& = Lu& + UDelta2&                '***
    Ru& = Ru& + UDelta3&                '***
    Lv& = Lv& + VDelta2&                '***
    Rv& = Rv& + VDelta3&                '***
NEXT y%

EXIT SUB

'**************************************************************************
'Draws a Textured horizontal line interpolated from u1 to u2, v1 to v2
'Needed variables.
'   Tx1% = integer x1 coordinate
'   Tx2% = integer x2 coordinate
'   y% = integer y coordinate
'   u1& = Long int of u1 *Fixpoint. In this case 2^16
'   u2& = Ditto.
'   v1& = Long int of v1 *Fixpoint. In this case 2^16
'   v2& = Ditto.
'**************************************************************************
TextureHline:

    Gx1% = Tx1%             'Save values to be safe
    Gx2% = Tx2%
    yy% = y%

    Tu1& = TLu1&
    Tu2& = TLu2&
    Tv1& = TLv1&
    Tv2& = TLv2&

    IF Gx1% > Gx2% THEN             'Sort values
        SWAP Gx1%, Gx2%
        SWAP Tu1&, Tu2&
        SWAP Tv1&, Tv2&
    END IF
    Gdx% = (Gx2% - Gx1%) + 1       'Get Xdelta(+1) for the Div by 0 error
    Udx& = Tu2& - Tu1&             'U delta
    deltaU& = Udx& \ Gdx%          'Interpolate
    Vdx& = Tv2& - Tv1&             'V delta
    deltaV& = Vdx& \ Gdx%          'Interpolate


    u& = Tu1&                       'save values to be safe
    v& = Tv1&
    FOR l% = Gx1% TO Gx2%                   'Rasterizer loop
        u% = (u& \ FIXPOINT) AND TWM1%
        v% = (v& \ FIXPOINT) AND TWM1%
        Pix = PEEK(4 + u% + v% * TEXTUREWID%)
        PSET (l%, yy%), Pix                 'Use poke for speed
        u& = u& + deltaU&                   'DDA
        v& = v& + deltaV&                   'DDA
    NEXT l%

RETURN

END SUB