Posts: 3,288
Threads: 167
Joined: Nov 2001
Yeah, good writer too!!! I just finished my WuLine demo but I ain't posting until somebody else does. ;*)
Posts: 294
Threads: 9
Joined: Oct 2002
Pfffft fine ill try make a demo
Posts: 3,343
Threads: 83
Joined: Mar 2003
Don't bother, Rel is gonna win 8)
No wait, do bother. I want to see all of rel's entries 
Posts: 3,288
Threads: 167
Joined: Nov 2001
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
Posts: 3,343
Threads: 83
Joined: Mar 2003
4.78FPS uncompiled
5.89FPS compiled
huge difference ;*)
All that effort, and you're right. Last place ;*)
Posts: 294
Threads: 9
Joined: Oct 2002
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.
Posts: 3,288
Threads: 167
Joined: Nov 2001
Quote:4.78FPS uncompiled
5.89FPS compiled
huge difference ;*)
All that effort, and you're right. Last place ;*)
I new someone would notice...;*)
Posts: 3,343
Threads: 83
Joined: Mar 2003
How impossibly slow is it on your machine???
Posts: 2,020
Threads: 24
Joined: Jun 2002
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
i]"I know what you're thinking. Did he fire six shots or only five? Well, to tell you the truth, in all this excitement, I've kinda lost track myself. But being as this is a .44 Magnum ... you've got to ask yourself one question: 'Do I feel lucky?' Well, do ya punk?"[/i] - Dirty Harry
Posts: 788
Threads: 53
Joined: Nov 2002
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?
oship me and i will give you lots of guurrls and beeea
|
![[Image: anya2.jpg]](http://rel.betterwebber.com/Mypics/anya2.jpg)