Let's kick up the fun in here - relsoft - 07-21-2003
Yeah, good writer too!!! I just finished my WuLine demo but I ain't posting until somebody else does. ;*)
Let's kick up the fun in here - Nexinarus - 07-21-2003
Pfffft fine ill try make a demo
Let's kick up the fun in here - oracle - 07-21-2003
Don't bother, Rel is gonna win 8)
No wait, do bother. I want to see all of rel's entries
Let's kick up the fun in here - relsoft - 07-21-2003
This is gonna be last place. ;*(
Courtesy of Hugo E. ;*)
Code: '3d rotator using wulines!!!!!!
'The slowest WuLine demo you'll ever see!!!! Check the FPS out!!!
'Relsoft 2003
'WuLines tutorial by Hugo Elias
'SetVideoSeg by Plasma357
'Torus Loader I got from one of Biskbart's demo. ;*)
'Qsort from the same demo modified for my needs
'Note: I need a better and faster algo for the wulines ;*(
'Mail me or shout if you have one. Better yet just
'point a link to a tutorial on how to make a faster
'wu line and wu pixel.
'vic_viperph@yahoo.com
DECLARE SUB SortPolys (Model() AS ANY, Poly() AS ANY)
DECLARE SUB QSort (SortArray() AS ANY, Lower%, Upper%)
DECLARE SUB Wuline (xx%, yy%, xx2%, yy2%, col%)
DECLARE SUB SetVideoSeg (Segment%)
DECLARE SUB DrawModel (Model() AS ANY, Poly() AS ANY)
DECLARE SUB RotateAndProject (Model() AS ANY, AngleX%, AngleY%, AngleZ%)
DECLARE SUB LoadTorus (Rings%, Bands%, RINGRADIUS%, BandRadius%, Model() AS ANY)
DEFINT A-Z
REM $DYNAMIC
TYPE Point3d
x AS LONG
y AS LONG
Z AS LONG
Xr AS LONG
Yr AS LONG
Zr AS LONG
ScrX AS INTEGER
ScrY AS INTEGER
clr AS INTEGER
END TYPE
TYPE PolyType
P1 AS INTEGER
P2 AS INTEGER
P3 AS INTEGER
clr AS INTEGER
Zorder AS INTEGER
Index AS INTEGER
END TYPE
CONST FixPoint = 256
CONST LENS = 256
CONST XCENTER = 160
CONST YCENTER = 100
CONST TORNUMRINGS = 20 'Number of Rings outside TORUS
CONST TORNUMBANDS = 8 'Number of PIXEL per RING
CONST TORRINGRADIUS = 70 '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 LONG
DIM SHARED Lsin(359) AS LONG
REDIM SHARED Torus(1) AS Point3d
REDIM SHARED Tri(0 TO 4800) AS PolyType
DIM SHARED ThetaX, ThetaY, ThetaZ
DIM SHARED CamZ, LastT%
CamZ = LENS
FOR I = 0 TO 359
A! = I * PI / 180
Lcos(I) = COS(A!) * FixPoint
Lsin(I) = SIN(A!) * FixPoint
NEXT I
CLS
SCREEN 13
'Grey Scale the Palette
FOR I = 0 TO 255
OUT &H3C8, I
OUT &H3C9, I \ 4
OUT &H3C9, I \ 9
OUT &H3C9, 0
NEXT I
ThetaX = 0
ThetaY = 0
ThetaZ = 0
LoadTorus TORNUMRINGS, TORNUMBANDS, TORRINGRADIUS, TORBANDRADIUS, Torus()
REDIM Vpage(32009) AS INTEGER 'Clear offscreen buffer
Vpage(6) = 2560 'Width 320*8
Vpage(7) = 200 'Height
Layer = VARSEG(Vpage(0)) + 1 'Buffer Seg(Ask Plasma)
SetVideoSeg Layer 'Set Draw to Buffer
T# = TIMER
Frame& = 0
DO
Frame& = Frame& + 1
SetVideoSeg Layer 'Set Draw to Buffer
LINE (0, 0)-(319, 199), 0, BF
ThetaX = (ThetaX + 1) MOD 360
ThetaY = (ThetaY + 1) MOD 360
ThetaZ = (ThetaZ + 1) MOD 360
RotateAndProject Torus(), ThetaX, ThetaY, ThetaZ
SortPolys Torus(), Tri()
DrawModel Torus(), Tri()
SetVideoSeg &HA000
PUT (0, 0), Vpage(6), PSET
LOOP UNTIL INKEY$ <> ""
DEF SEG
PALETTE
PRINT Frame& / (TIMER - T#)
C$ = INPUT$(1)
END
REM $STATIC
SUB DrawModel (Model() AS Point3d, Poly() AS PolyType)
FOR I = 0 TO UBOUND(Poly) - 1
J = Poly(I).Index
J = I
x1 = Model(Tri(J).P1).ScrX 'Get triangles from "projected"
x2 = Model(Tri(J).P2).ScrX 'X and Y coords since Znormal
x3 = Model(Tri(J).P3).ScrX 'Does not require a Z coord
y1 = Model(Tri(J).P1).ScrY 'V1= Point1 connected to V2 then
y2 = Model(Tri(J).P2).ScrY 'V2 to V3 and so on...
y3 = Model(Tri(J).P3).ScrY
clr = 3 * (Model(Tri(J).P3).clr + Model(Tri(J).P3).Zr)
IF clr < 0 THEN clr = 0
IF clr >= 255 THEN clr = 255
Wuline x2, y2, x3, y3, clr
NEXT I
END SUB
SUB LoadTorus (Rings, Bands, RINGRADIUS, BandRadius, Model() AS Point3d)
REDIM Model((Rings * Bands)) 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
Model(I%).clr = (RINGRADIUS)
I% = I% + 1
NEXT S1%
NEXT S2%
MaxPoint% = Rings * Bands
I% = 0
FOR S1% = Bands - 1 TO 0 STEP -1
FOR S2% = Rings - 1 TO 0 STEP -1
Tri(I%).P1 = S1% * Rings + S2%
Tri(I%).P2 = S1% * Rings + (S2% + 1) MOD Rings
Tri(I%).P3 = (S1% * Rings + S2% + Rings) MOD MaxPoint%
I% = I% + 1
LastT% = LastT% + 1
Tri(I%).P1 = S1% * Rings + (S2% + 1) MOD Rings
Tri(I%).P2 = (S1% * Rings + (S2% + 1) MOD Rings + Rings) MOD MaxPoint%
Tri(I%).P3 = (S1% * Rings + S2% + Rings) MOD MaxPoint%
I% = I% + 1
LastT% = LastT% + 1
NEXT S2%
NEXT S1%
END SUB
SUB QSort (SortArray() AS PolyType, Lower%, Upper%) STATIC
'QuickSort iterative (rather than recursive) by Cornel Huth
IF NOT InitDone THEN
DIM Stack(1 TO 128, 1) AS INTEGER 'Low=0,Hi=1
DIM Sp AS INTEGER
InitDone = -1
END IF
'out stack pointer
Sp = 1
'maxsp = sp
Stack(Sp, 0) = Lower%
Stack(Sp, 1) = Upper%
Sp = Sp + 1
DO
Sp = Sp - 1
Low = Stack(Sp, 0)
Hi = Stack(Sp, 1)
DO
I = Low
J = Hi
mid = (Low + Hi) \ 2
Compare = SortArray(mid).Zorder
DO
DO WHILE SortArray(I).Zorder < Compare
I = I + 1
LOOP
DO WHILE SortArray(J).Zorder > Compare
J = J - 1
LOOP
IF I <= J THEN
SWAP SortArray(I), SortArray(J)
I = I + 1
J = J - 1
END IF
LOOP WHILE I <= J
IF J - Low < Hi - I THEN
IF I < Hi THEN
Stack(Sp, 0) = I
Stack(Sp, 1) = Hi
Sp = Sp + 1
END IF
Hi = J
ELSE
IF Low < J THEN
Stack(Sp, 0) = Low
Stack(Sp, 1) = J
Sp = Sp + 1
END IF
Low = I
END IF
LOOP WHILE Low < Hi
LOOP WHILE Sp <> 1
END SUB
SUB RotateAndProject (Model() AS Point3d, AngleX, AngleY, AngleZ) STATIC
'The queen of all my 3drotation formulas!!!
'9 point transformation matrix formula derived from 16 point equation
'of Nick Hampshire(made a book on Vic GFX).
'Now uses FixPoint math for speed. :*)
'Dunno where Entrophy derived his matrix rotations but this one seems
'to coincide with the standard Right-Handed system so this is what I'll use.
CX& = Lcos(AngleX)
SX& = Lsin(AngleX)
CY& = Lcos(AngleY)
SY& = Lsin(AngleY)
CZ& = Lcos(AngleZ)
SZ& = Lsin(AngleZ)
'Transformation matrix formula
'This is actually 16(or 12) equations but I pared it down to 9
'since TX4=0,TY4=0,TZ4=0,13 to 16th =0,0,0,1 (yes Doom!!!)
'And added Fixpoint math for speed. ;*)
'Note the all integer divide ;*)
tx1& = CY& * CZ& \ FixPoint
tx2& = CY& * SZ& \ FixPoint
tx3& = -SY&
ty1& = (CX& * -SZ& \ FixPoint) + (SX& * SY& * CZ& \ FixPoint \ FixPoint)
ty2& = (CX& * CZ& \ FixPoint + SX& * SY& * SZ& \ FixPoint \ FixPoint)
ty3& = SX& * CY& \ FixPoint
tz1& = (-SX& * -SZ& \ FixPoint + CX& * SY& * CZ& \ FixPoint \ FixPoint)
tz2& = (-SX& * CZ& \ FixPoint + CZ& * SY& * SZ& \ FixPoint \ FixPoint)
tz3& = CX& * CY& \ FixPoint
FOR I = 0 TO UBOUND(Model)
x& = Model(I).x 'Load Original model
y& = Model(I).y
Z& = Model(I).Z
RotX& = (x& * tx1& + y& * ty1& + Z& * tz1&) \ FixPoint 'Rotate the Axes
RotY& = (x& * tx2& + y& * ty2& + Z& * tz2&) \ FixPoint
RotZ& = (x& * tx3& + y& * ty3& + Z& * tz3&) \ FixPoint
Model(I).Xr = RotX&
Model(I).Yr = RotY&
Model(I).Zr = RotZ&
'Project
Distance% = (LENS - RotZ&)
Model(I).ScrX = (CamZ * RotX& / Distance%) + XCENTER
Model(I).ScrY = -(CamZ * RotY& / Distance%) + YCENTER
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 SortIndex (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).Zorder
Tj = Poly(I + Offset).Zorder
IF Ti > Tj THEN
SWAP Poly(I), Poly(I + Offset)
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% = 0 TO UBOUND(Poly)
Poly(I%).Zorder = Model(Poly(I%).P1).Zr + Model(Poly(I%).P2).Zr + Model(Poly(I%).P3).Zr
Poly(I%).Index = I%
NEXT I%
QSort Poly(), 0, UBOUND(Poly) - 1
END SUB
SUB Wuline (xx, yy, xx2, yy2, col)
x1! = xx
y1! = yy
x2! = xx2
y2! = yy2
xd! = x2! - x1!
yd! = y2! - y1!
IF ABS(xd!) > ABS(yd!) THEN ' Horizontal lines.
IF x1! > x2! THEN
SWAP x1!, x2!
SWAP y1!, y2!
xd! = x2! - x1!
yd! = y2! - y1!
END IF
grad! = yd! / xd!
' End point 1.
xend! = FIX(x1! - .5)
yend! = y1! + grad! * (xend! - x1!)
xgap! = 1 - ABS(x1! - .5 - INT(x1! - .5))
ix1 = INT(xend!)
iy1 = INT(yend!)
brightness1! = (1 - ABS(yend! - INT(yend!))) * xgap!
brightness2! = ABS(yend! - INT(yend!)) * xgap!
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
PSET (ix1, iy1), c1
PSET (ix1, iy1 + 1), c2
yf! = yend! + grad!
' End point 2.
xend! = FIX(x2! + .5)
yend! = y2! + (grad! * (xend! - x2!))
xgap! = 1 - ABS(x2! - .5 - INT(x2! - .5))
ix2 = INT(xend!)
iy2 = INT(yend!)
brightness1! = (1 - ABS(yend! - INT(yend!))) * xgap!
brightness2! = ABS(yend! - INT(yend!)) * xgap!
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
PSET (ix2, iy2), c1
PSET (ix2, iy2 + 1), c2
' Main loop.
FOR x = (ix1 + 1) TO (ix2 - 1)
brightness1! = 1 - ABS(yf! - INT(yf!))
brightness2! = ABS(yf! - INT(yf!))
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
PSET (x, INT(yf!)), c1
PSET (x, INT(yf!) + 1), c2
yf! = yf! + grad!
NEXT x
ELSE 'Vert line
IF ABS(yd!) = 0 THEN
LINE (x1!, y1!)-(x2!, y2!), col
EXIT SUB
END IF
IF y1! > y2! THEN
SWAP x1!, x2!
SWAP y1!, y2!
xd! = x2! - x1!
yd! = y2! - y1!
END IF
grad! = xd! / yd!
' End point 1.
yend! = FIX(y1! + .5)
xend! = x1! + grad! * (yend! - y1!)
ygap! = 1 - ABS(y1! + .5 - INT(y1! + .5))
ix1 = INT(xend!)
iy1 = INT(yend!)
brightness1! = (1 - ABS(xend! - INT(xend!))) * ygap!
brightness2! = ABS(xend! - INT(xend!)) * ygap!
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
PSET (ix1, iy1), c1
PSET (ix1, iy1 + 1), c2
xf! = xend! + grad!
' End point 2.
yend! = FIX(y2! + .5)
xend! = x2! + grad! * (yend! - y2!)
ygap! = 1 - ABS(y2! - .5 - INT(y2! - .5))
ix2 = INT(xend!)
iy2 = INT(yend!)
brightness1! = (1 - ABS(xend! - INT(xend!))) * ygap!
brightness2! = ABS(xend! - INT(xend!)) * ygap!
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
PSET (ix2, iy2), c1
PSET (ix2, iy2 - 1), c2
' Main loop.
FOR y = (iy1 + 1) TO (iy2 - 1)
brightness1! = 1 - ABS(xf! - INT(xf!))
brightness2! = ABS(xf! - INT(xf!))
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
PSET (INT(xf!), y), c1
PSET (INT(xf! + 1), y), c2
xf! = xf! + grad!
NEXT y
END IF
END SUB
Let's kick up the fun in here - oracle - 07-21-2003
4.78FPS uncompiled
5.89FPS compiled
huge difference ;*)
All that effort, and you're right. Last place ;*)
Let's kick up the fun in here - Nexinarus - 07-21-2003
Hey you bastard im not finished . Na its ok ill prolly take a while, im making something (thanks to Hugo of course ) Im a little stuck i need to get it working properly. Now ill check out your demo #2.
Let's kick up the fun in here - relsoft - 07-24-2003
Quote:4.78FPS uncompiled
5.89FPS compiled
huge difference ;*)
All that effort, and you're right. Last place ;*)
I new someone would notice...;*)
Let's kick up the fun in here - oracle - 07-25-2003
How impossibly slow is it on your machine???
Let's kick up the fun in here - toonski84 - 07-25-2003
well, if it didnt chug before, i just added transparency for real anti-aliasing
Code: DECLARE SUB alphapset (x%, y%, opacity%)
'3d rotator using wulines!!!!!!
'The slowest WuLine demo you'll ever see!!!! Check the FPS out!!!
'Relsoft 2003
'WuLines tutorial by Hugo Elias
'SetVideoSeg by Plasma357
'Torus Loader I got from one of Biskbart's demo. ;*)
'Qsort from the same demo modified for my needs
'Note: I need a better and faster algo for the wulines ;*(
'Mail me or shout if you have one. Better yet just
'point a link to a tutorial on how to make a faster
'wu line and wu pixel.
'vic_viperph@yahoo.com
DECLARE SUB SortPolys (Model() AS ANY, Poly() AS ANY)
DECLARE SUB QSort (SortArray() AS ANY, Lower%, Upper%)
DECLARE SUB Wuline (xx%, yy%, xx2%, yy2%, col%)
DECLARE SUB SetVideoSeg (Segment%)
DECLARE SUB DrawModel (Model() AS ANY, Poly() AS ANY)
DECLARE SUB RotateAndProject (Model() AS ANY, AngleX%, AngleY%, AngleZ%)
DECLARE SUB LoadTorus (Rings%, Bands%, RINGRADIUS%, BandRadius%, Model() AS ANY)
DEFINT A-Z
REM $DYNAMIC
TYPE Point3d
x AS LONG
y AS LONG
Z AS LONG
Xr AS LONG
Yr AS LONG
Zr AS LONG
ScrX AS INTEGER
ScrY AS INTEGER
clr AS INTEGER
END TYPE
TYPE PolyType
P1 AS INTEGER
P2 AS INTEGER
P3 AS INTEGER
clr AS INTEGER
Zorder AS INTEGER
Index AS INTEGER
END TYPE
CONST FixPoint = 256
CONST LENS = 256
CONST XCENTER = 160
CONST YCENTER = 100
CONST TORNUMRINGS = 20 'Number of Rings outside TORUS
CONST TORNUMBANDS = 8 'Number of PIXEL per RING
CONST TORRINGRADIUS = 70 '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 LONG
DIM SHARED Lsin(359) AS LONG
REDIM SHARED Torus(1) AS Point3d
REDIM SHARED Tri(0 TO 4800) AS PolyType
DIM SHARED ThetaX, ThetaY, ThetaZ
DIM SHARED CamZ, LastT%
CamZ = LENS
FOR I = 0 TO 359
a! = I * PI / 180
Lcos(I) = COS(a!) * FixPoint
Lsin(I) = SIN(a!) * FixPoint
NEXT I
CLS
SCREEN 13
'Grey Scale the Palette
FOR I = 0 TO 255
OUT &H3C8, I
OUT &H3C9, I \ 4
OUT &H3C9, I \ 9
OUT &H3C9, 0
NEXT I
ThetaX = 0
ThetaY = 0
ThetaZ = 0
LoadTorus TORNUMRINGS, TORNUMBANDS, TORRINGRADIUS, TORBANDRADIUS, Torus()
REDIM Vpage(32009) AS INTEGER 'Clear offscreen buffer
Vpage(6) = 2560 'Width 320*8
Vpage(7) = 200 'Height
Layer = VARSEG(Vpage(0)) + 1 'Buffer Seg(Ask Plasma)
SetVideoSeg Layer 'Set Draw to Buffer
T# = TIMER
Frame& = 0
DO
Frame& = Frame& + 1
SetVideoSeg Layer 'Set Draw to Buffer
LINE (0, 0)-(319, 199), 0, BF
ThetaX = (ThetaX + 1) MOD 360
ThetaY = (ThetaY + 1) MOD 360
ThetaZ = (ThetaZ + 1) MOD 360
RotateAndProject Torus(), ThetaX, ThetaY, ThetaZ
SortPolys Torus(), Tri()
DrawModel Torus(), Tri()
SetVideoSeg &HA000
PUT (0, 0), Vpage(6), PSET
LOOP UNTIL INKEY$ <> ""
DEF SEG
PALETTE
PRINT Frame& / (TIMER - T#)
C$ = INPUT$(1)
END
REM $STATIC
SUB alphapset (x, y, opacity)
a = POINT(x, y)
b = 255 - a
PSET (x, y), a + b * (opacity / 255)
END SUB
SUB DrawModel (Model() AS Point3d, Poly() AS PolyType)
FOR I = 0 TO UBOUND(Poly) - 1
J = Poly(I).Index
J = I
x1 = Model(Tri(J).P1).ScrX 'Get triangles from "projected"
x2 = Model(Tri(J).P2).ScrX 'X and Y coords since Znormal
x3 = Model(Tri(J).P3).ScrX 'Does not require a Z coord
y1 = Model(Tri(J).P1).ScrY 'V1= Point1 connected to V2 then
y2 = Model(Tri(J).P2).ScrY 'V2 to V3 and so on...
y3 = Model(Tri(J).P3).ScrY
clr = 3 * (Model(Tri(J).P3).clr + Model(Tri(J).P3).Zr)
IF clr < 0 THEN clr = 0
IF clr >= 255 THEN clr = 255
Wuline x2, y2, x3, y3, clr
NEXT I
END SUB
SUB LoadTorus (Rings, Bands, RINGRADIUS, BandRadius, Model() AS Point3d)
REDIM Model((Rings * Bands)) 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
Model(I%).clr = (RINGRADIUS)
I% = I% + 1
NEXT S1%
NEXT S2%
MaxPoint% = Rings * Bands
I% = 0
FOR S1% = Bands - 1 TO 0 STEP -1
FOR S2% = Rings - 1 TO 0 STEP -1
Tri(I%).P1 = S1% * Rings + S2%
Tri(I%).P2 = S1% * Rings + (S2% + 1) MOD Rings
Tri(I%).P3 = (S1% * Rings + S2% + Rings) MOD MaxPoint%
I% = I% + 1
LastT% = LastT% + 1
Tri(I%).P1 = S1% * Rings + (S2% + 1) MOD Rings
Tri(I%).P2 = (S1% * Rings + (S2% + 1) MOD Rings + Rings) MOD MaxPoint%
Tri(I%).P3 = (S1% * Rings + S2% + Rings) MOD MaxPoint%
I% = I% + 1
LastT% = LastT% + 1
NEXT S2%
NEXT S1%
END SUB
SUB QSort (SortArray() AS PolyType, Lower%, Upper%) STATIC
'QuickSort iterative (rather than recursive) by Cornel Huth
IF NOT InitDone THEN
DIM Stack(1 TO 128, 1) AS INTEGER 'Low=0,Hi=1
DIM Sp AS INTEGER
InitDone = -1
END IF
'out stack pointer
Sp = 1
'maxsp = sp
Stack(Sp, 0) = Lower%
Stack(Sp, 1) = Upper%
Sp = Sp + 1
DO
Sp = Sp - 1
Low = Stack(Sp, 0)
Hi = Stack(Sp, 1)
DO
I = Low
J = Hi
mid = (Low + Hi) \ 2
Compare = SortArray(mid).Zorder
DO
DO WHILE SortArray(I).Zorder < Compare
I = I + 1
LOOP
DO WHILE SortArray(J).Zorder > Compare
J = J - 1
LOOP
IF I <= J THEN
SWAP SortArray(I), SortArray(J)
I = I + 1
J = J - 1
END IF
LOOP WHILE I <= J
IF J - Low < Hi - I THEN
IF I < Hi THEN
Stack(Sp, 0) = I
Stack(Sp, 1) = Hi
Sp = Sp + 1
END IF
Hi = J
ELSE
IF Low < J THEN
Stack(Sp, 0) = Low
Stack(Sp, 1) = J
Sp = Sp + 1
END IF
Low = I
END IF
LOOP WHILE Low < Hi
LOOP WHILE Sp <> 1
END SUB
SUB RotateAndProject (Model() AS Point3d, AngleX, AngleY, AngleZ) STATIC
'The queen of all my 3drotation formulas!!!
'9 point transformation matrix formula derived from 16 point equation
'of Nick Hampshire(made a book on Vic GFX).
'Now uses FixPoint math for speed. :*)
'Dunno where Entrophy derived his matrix rotations but this one seems
'to coincide with the standard Right-Handed system so this is what I'll use.
CX& = Lcos(AngleX)
SX& = Lsin(AngleX)
CY& = Lcos(AngleY)
SY& = Lsin(AngleY)
CZ& = Lcos(AngleZ)
SZ& = Lsin(AngleZ)
'Transformation matrix formula
'This is actually 16(or 12) equations but I pared it down to 9
'since TX4=0,TY4=0,TZ4=0,13 to 16th =0,0,0,1 (yes Doom!!!)
'And added Fixpoint math for speed. ;*)
'Note the all integer divide ;*)
tx1& = CY& * CZ& \ FixPoint
tx2& = CY& * SZ& \ FixPoint
tx3& = -SY&
ty1& = (CX& * -SZ& \ FixPoint) + (SX& * SY& * CZ& \ FixPoint \ FixPoint)
ty2& = (CX& * CZ& \ FixPoint + SX& * SY& * SZ& \ FixPoint \ FixPoint)
ty3& = SX& * CY& \ FixPoint
tz1& = (-SX& * -SZ& \ FixPoint + CX& * SY& * CZ& \ FixPoint \ FixPoint)
tz2& = (-SX& * CZ& \ FixPoint + CZ& * SY& * SZ& \ FixPoint \ FixPoint)
tz3& = CX& * CY& \ FixPoint
FOR I = 0 TO UBOUND(Model)
x& = Model(I).x 'Load Original model
y& = Model(I).y
Z& = Model(I).Z
RotX& = (x& * tx1& + y& * ty1& + Z& * tz1&) \ FixPoint 'Rotate the Axes
RotY& = (x& * tx2& + y& * ty2& + Z& * tz2&) \ FixPoint
RotZ& = (x& * tx3& + y& * ty3& + Z& * tz3&) \ FixPoint
Model(I).Xr = RotX&
Model(I).Yr = RotY&
Model(I).Zr = RotZ&
'Project
Distance% = (LENS - RotZ&)
Model(I).ScrX = (CamZ * RotX& / Distance%) + XCENTER
Model(I).ScrY = -(CamZ * RotY& / Distance%) + YCENTER
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 SortIndex (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).Zorder
Tj = Poly(I + Offset).Zorder
IF Ti > Tj THEN
SWAP Poly(I), Poly(I + Offset)
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% = 0 TO UBOUND(Poly)
Poly(I%).Zorder = Model(Poly(I%).P1).Zr + Model(Poly(I%).P2).Zr + Model(Poly(I%).P3).Zr
Poly(I%).Index = I%
NEXT I%
QSort Poly(), 0, UBOUND(Poly) - 1
END SUB
SUB Wuline (xx, yy, xx2, yy2, col)
x1! = xx
y1! = yy
x2! = xx2
y2! = yy2
xd! = x2! - x1!
yd! = y2! - y1!
IF ABS(xd!) > ABS(yd!) THEN ' Horizontal lines.
IF x1! > x2! THEN
SWAP x1!, x2!
SWAP y1!, y2!
xd! = x2! - x1!
yd! = y2! - y1!
END IF
grad! = yd! / xd!
' End point 1.
xend! = FIX(x1! - .5)
yend! = y1! + grad! * (xend! - x1!)
xgap! = 1 - ABS(x1! - .5 - INT(x1! - .5))
ix1 = INT(xend!)
iy1 = INT(yend!)
brightness1! = (1 - ABS(yend! - INT(yend!))) * xgap!
brightness2! = ABS(yend! - INT(yend!)) * xgap!
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
PSET (ix1, iy1), c1
PSET (ix1, iy1 + 1), c2
yf! = yend! + grad!
' End point 2.
xend! = FIX(x2! + .5)
yend! = y2! + (grad! * (xend! - x2!))
xgap! = 1 - ABS(x2! - .5 - INT(x2! - .5))
ix2 = INT(xend!)
iy2 = INT(yend!)
brightness1! = (1 - ABS(yend! - INT(yend!))) * xgap!
brightness2! = ABS(yend! - INT(yend!)) * xgap!
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
alphapset ix2, iy2, c1
alphapset ix2, iy2 + 1, c2
' Main loop.
FOR x = (ix1 + 1) TO (ix2 - 1)
brightness1! = 1 - ABS(yf! - INT(yf!))
brightness2! = ABS(yf! - INT(yf!))
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
alphapset x, INT(yf!), c1
alphapset x, INT(yf!) + 1, c2
yf! = yf! + grad!
NEXT x
ELSE 'Vert line
IF ABS(yd!) = 0 THEN
LINE (x1!, y1!)-(x2!, y2!), col
EXIT SUB
END IF
IF y1! > y2! THEN
SWAP x1!, x2!
SWAP y1!, y2!
xd! = x2! - x1!
yd! = y2! - y1!
END IF
grad! = xd! / yd!
' End point 1.
yend! = FIX(y1! + .5)
xend! = x1! + grad! * (yend! - y1!)
ygap! = 1 - ABS(y1! + .5 - INT(y1! + .5))
ix1 = INT(xend!)
iy1 = INT(yend!)
brightness1! = (1 - ABS(xend! - INT(xend!))) * ygap!
brightness2! = ABS(xend! - INT(xend!)) * ygap!
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
alphapset ix1, iy1, c1
alphapset ix1, iy1 + 1, c2
xf! = xend! + grad!
' End point 2.
yend! = FIX(y2! + .5)
xend! = x2! + grad! * (yend! - y2!)
ygap! = 1 - ABS(y2! - .5 - INT(y2! - .5))
ix2 = INT(xend!)
iy2 = INT(yend!)
brightness1! = (1 - ABS(xend! - INT(xend!))) * ygap!
brightness2! = ABS(xend! - INT(xend!)) * ygap!
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
alphapset ix2, iy2, c1
alphapset ix2, iy2 - 1, c2
' Main loop.
FOR y = (iy1 + 1) TO (iy2 - 1)
brightness1! = 1 - ABS(xf! - INT(xf!))
brightness2! = ABS(xf! - INT(xf!))
c1 = CINT(brightness1! * col)
c2 = CINT(brightness2! * col)
alphapset INT(xf!), y, c1
alphapset INT(xf! + 1), y, c2
xf! = xf! + grad!
NEXT y
END IF
END SUB
Let's kick up the fun in here - Blitz - 07-25-2003
Pure qb you say? Count me out then. I say forget "pure qb" and let people use what they want. As long as it's real mode dos. That way you get much neater stuff. And isn't that the point? Neat gfx, nice code?
|