ASM try art of assembly.
Code:
'''vector balls!!!!
'''Scaling of sprite snd sprite projection enabled
'''SetvideoSeg by Plasma357
'''Compile for speed. :*)
'''Rel.betterwebber.com
DECLARE SUB BubbleSort (Model() AS ANY)
DECLARE SUB LoadSpace (Model() AS ANY, radius%, NumBalls%)
DECLARE SUB DrawModel (Model() AS ANY, Balls%())
DECLARE SUB SetVideoSeg (Segment%)
DECLARE SUB RotateAndProject (Model() AS ANY, AngleX%, AngleY%, AngleZ%)
DECLARE SUB StretchSprite (px%, py%, newwid%, newhei%, idx%, Buffer%())
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
NHei AS INTEGER
Nwid AS INTEGER
idx AS INTEGER
END TYPE
CONST FALSE = 0, TRUE = NOT FALSE
CONST LENS = 256 'Z
CONST XCENTER = 160 '??
CONST YCENTER = 100 '??
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
CLS
SCREEN 13
RANDOMIZE TIMER
size = ((16 ^ 2) + 4) \ 2 '16*16 sprite
DIM SHARED Balls(size, 31) 'sprite
FOR i = 0 TO 31 'get our balls
LINE (0, 0)-(15, 15), 0, BF 'clear box
clr = 55 * (INT(RND * 128)) 'random colors
CIRCLE (8, 8), 7, clr 'draw
PAINT (8, 8), clr + 8, clr
CIRCLE (8, 8), 7, clr + 8
CIRCLE (5, 5), 1, 15
PAINT (5, 5), 15
GET (0, 0)-(15, 15), Balls(0, i) 'get sprite
NEXT i
LoadSpace Model(), 50, 31 'load model
camx% = 0
camy% = 0
camz% = 0
Thetax = 0'INT(RND * 360)
Thetay = 0'INT(RND * 360)
Thetaz = 0'INT(RND * 360)
Vpage(6) = 2560
Vpage(7) = 200
Layer = VARSEG(Vpage(0)) + 1
SetVideoSeg Layer
Finished = 0
zdir = -1
DO
camz% = camz% + zdir
IF camz% > 200 THEN
zdir = -zdir
ELSEIF camz% < -164 THEN
zdir = -zdir
END IF
Thetax = (Thetax + 1) MOD 360
Thetay = (Thetay + 1) MOD 360
Thetaz = (Thetaz + 1) MOD 360
RotateAndProject Model(), Thetax, Thetay, Thetaz
BubbleSort Model()
SetVideoSeg Layer
LINE (0, 0)-(319, 199), 0, BF
DrawModel Model(), Balls()
SetVideoSeg &HA000
WAIT &H3DA, 8
PUT (0, 0), Vpage(6), PSET
LOOP UNTIL INKEY$ <> ""
CLS
SCREEN 0
WIDTH 80
END
REM $STATIC
SUB BubbleSort (Model() AS Point3d)
'Not the best sorting but gets the job done. ;*)
'don't you fret, I will teach you 3 more sorting algos. :*)
min = LBOUND(Model)
max = UBOUND(Model)
FOR i = min TO max 'loop through all the balls
FOR j = i TO max - 1
IF Model(j).zr > Model(j + 1).zr THEN 'Swap if not in order
SWAP Model(j), Model(j + 1)
END IF
NEXT j
NEXT i
END SUB
SUB DrawModel (Model() AS Point3d, Balls()) STATIC
'uses a stretch sprite routine to do sprite projection
FOR i = 0 TO UBOUND(Model)
x% = INT(Model(i).scrx)
y% = INT(Model(i).scry)
IF NOT Model(i).cull THEN
StretchSprite x%, y%, Model(i).Nwid, Model(i).NHei, Model(i).idx, Vpage()
END IF
NEXT i
END SUB
SUB LoadSpace (Model() AS Point3d, radius, NumBalls)
'////Initialize the starting values of our balls
REDIM Model(NumBalls) AS Point3d
FOR i = 0 TO UBOUND(Model)
ax! = RND - .5
ay! = RND - .5
az! = RND - .5
dist! = SQR(ax! ^ 2 + ay! ^ 2 + az! ^ 2)
Model(i).x = ax! / dist! * (20 + (RND * radius))
Model(i).y = ay! / dist! * (20 + (RND * radius))
Model(i).z = az! / dist! * (20 + (RND * radius))
Model(i).idx = INT(RND * 31)
NEXT i
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 = (LENS * RotX! / Distance%) + XCENTER
Model(i).scry = -(LENS * RotY! / Distance%) + YCENTER
Model(i).NHei = 16 * 256 / Distance%
Model(i).Nwid = 16 * 256 / Distance%
ELSE
Model(i).cull = TRUE
END IF
NEXT i
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
SUB StretchSprite (px%, py%, newwid%, newhei%, idx, Buffer())
'balls is a GET/PUT array
'uses 8.8 fixed point math for lil speed inside the IDE
'clipping supported
wid% = Balls(0, idx) \ 8
Hei% = Balls(1, idx)
xstep% = (wid% * 256 \ newwid%)
ystep% = (Hei% * 256 \ newhei%)
y% = py%
x% = px%
'Clip/Crop it
IF y% < 0 THEN
CY = -y%
newhei% = newhei% - CY
y% = 0
miny% = CY
ELSEIF y% > 199 THEN
EXIT SUB
ELSE
Ndy = y% + newhei%
IF Ndy > 199 THEN
newhei% = newhei% - (Ndy - (200))
END IF
END IF
IF x% < 0 THEN
cx = -x%
newwid% = newwid% - cx
x% = 0
minx% = cx
ELSEIF x% > 319 THEN
EXIT SUB
ELSE
Ndx = x% + newwid%
IF Ndx > 319 THEN
newwid% = newwid% - (Ndx - 320)
END IF
END IF
'ax=x
'bx=wid
'cx=y
'dx=hei
Vseg% = VARSEG(Buffer(0))
Voff% = VARPTR(Buffer(8))
u& = 0
v& = 0
T20Mw = 320 - newwid%
di& = Voff% + y% * 320& + x% 'start coords
v& = miny% * ystep%
minxstep& = minx% * xstep%
FOR y% = 0 TO newhei% - 1
u& = minxstep&
ya = v& \ 256
Temp& = (ya) * wid% + VARPTR(Balls(2, idx))
Offset& = Temp&
FOR x% = 0 TO newwid% - 1
xa = u& \ 256
Offset& = Temp& + xa
DEF SEG = VARSEG(Balls(0, idx))
C% = PEEK(Offset&)
IF C% THEN
DEF SEG = Vseg%
POKE di&, C%
END IF
u& = u& + xstep%
di& = di& + 1
NEXT x%
v& = v& + ystep%
di& = di& + T20Mw
NEXT y%
END SUB