Page 1 of 1

3d boing balls

Posted: Thu Feb 12, 2015 1:09 am
by DrChip
rem boing
rem A box containing some balls that
rem bounce around, colliding with each
rem other as well.
rem does snyone want to help me finish
rem the screen and shadow (commented out)?
rem iPhone 6 plus : 8.3 b1

pi=3.1415
gosub initialize


main_loop:
do
refresh off
graphics clear 0,0,0
gosub drawbox
gosub drawballs
gosub moveballs
refresh on
until 1=2
return


drawbox:
fill color 0,0,1

'fill triangle bx(3),by(3) to bx(1),by(1) to bx(5),by(5)
trix(0)=bx(3)
triy(0)=by(3)
trix(1)=bx(1)
triy(1)=by(1)
trix(2)=bx(5)
triy(2)=by(5)
fill poly trix,triy count 3
'fill triangle bx(1),by(1) to bx(2),by(2) to bx(6),by(6)
trix(0)=bx(1)
triy(0)=by(1)
trix(1)=bx(2)
triy(1)=by(2)
trix(2)=bx(6)
triy(2)=by(6)
fill poly trix,triy count 3
'fill triangle bx(2),by(2) to bx(4),by(4) to bx(6),by(6)
trix(0)=bx(2)
triy(0)=by(2)
trix(1)=bx(4)
triy(1)=by(4)
trix(2)=bx(6)
triy(2)=by(6)
fill poly trix,triy count 3
'fill triangle bx(3),by(3) to bx(4),by(4) to bx(8),by(8)
trix(0)=bx(3)
triy(0)=by(3)
trix(1)=bx(4)
triy(1)=by(4)
trix(2)=bx(8)
triy(2)=by(8)
fill poly trix,triy count 3
'fill color 0,0,50
'fill triangle bx(3),by(3) to bx(5),by(5) to bx(7),by(7)
trix(0)=bx(3)
triy(0)=by(3)
trix(1)=bx(5)
triy(1)=by(5)
trix(2)=bx(7)
triy(2)=by(7)
fill poly trix,triy count 3
'fill triangle bx(1),by(1) to bx(5),by(5) to bx(6),by(6)
trix(0)=bx(1)
triy(0)=by(1)
trix(1)=bx(5)
triy(1)=by(5)
trix(2)=bx(6)
triy(2)=by(6)
fill poly trix,triy count 3
'fill triangle bx(4),by(4) to bx(6),by(6) to bx(8),by(8)
trix(0)=bx(4)
triy(0)=by(4)
trix(1)=bx(6)
triy(1)=by(6)
trix(2)=bx(8)
triy(2)=by(8)
fill poly trix,triy count 3
'fill triangle bx(3),by(3) to bx(7),by(7) to bx(8),by(8)
trix(0)=bx(3)
triy(0)=by(3)
trix(1)=bx(7)
triy(1)=by(7)
trix(2)=bx(8)
triy(2)=by(8)
fill poly trix,triy count 3
fill color 0,0,50/255
'fill triangle bx(7),by(7) to bx(5),by(5) to bx(6),by(6)
trix(0)=bx(7)
triy(0)=by(7)
trix(1)=bx(5)
triy(1)=by(5)
trix(2)=bx(6)
triy(2)=by(6)
fill poly trix,triy count 3
'fill triangle bx(7),by(7) to bx(6),by(6) to bx(8),by(8)
trix(0)=bx(7)
triy(0)=by(7)
trix(1)=bx(6)
triy(1)=by(6)
trix(2)=bx(8)
triy(2)=by(8)
fill poly trix,triy count 3
draw color 1,1,1
draw line bx(1),by(1) to bx(5),by(5)
draw line bx(2),by(2) to bx(6),by(6)
draw line bx(3),by(3) to bx(7),by(7)
draw line bx(4),by(4) to bx(8),by(8)
draw rect bx(5),by(5) to bx(8),by(8)
return


drawball:

ang=0
do
xo1=cosines(ang)*r
yo1=sines(ang)*r
xo2=cosines(ang+20)*r
yo2=sines(ang+20)*r
'fill triangle x,y to x+xo1,y+yo1 to x+xo2,y+yo2
trix(0)=x
triy(0)=y
trix(1)=x+xo1
triy(1)=y+yo1
trix(2)=x+xo2
triy(2)=y+yo2
fill poly trix,triy count 3
'fill triangle x,y to x-xo1,y+yo1 to x-xo2,y+yo2
trix(0)=x
triy(0)=y
trix(1)=x-xo1
triy(1)=y+yo1
trix(2)=x-xo2
triy(2)=y+yo2
fill poly trix,triy count 3
'fill triangle x,y to x-xo1,y-yo1 to x-xo2,y-yo2
trix(0)=x
triy(0)=y
trix(1)=x-xo1
triy(1)=y-yo1
trix(2)=x-xo2
triy(2)=y-yo2
fill poly trix,triy count 3
'fill triangle x,y to x+xo1,y-yo1 to x+xo2,y-yo2
trix(0)=x
triy(0)=y
trix(1)=x+xo1
triy(1)=y-yo1
trix(2)=x+xo2
triy(2)=y-yo2
fill poly trix,triy count 3
ang=ang+20
until ang>90
return


drawshad:
fill color 0,0,0
ang=0
do
xo1=cosines(ang)*r
yo1=sines(ang)*r2
xo2=cosines(ang+30)*r
yo2=sines(ang+30)*r2
'fill triangle x,y to x+xo1,y+yo1 to x+xo2,y+yo2
trix(0)=x
triy(0)=y
trix(1)=x+xo1
triy(1)=y+yo1
trix(2)=x+xo2
triy(2)=y+yo2
fill poly trix,triy count 3
'fill triangle x,y to x-xo1,y+yo1 to x-xo2,y+yo2
trix(0)=x
triy(0)=y
trix(1)=x-xo1
triy(1)=y+yo1
trix(2)=x-xo2
triy(2)=y+yo2
fill poly trix,triy count 3
'fill triangle x,y to x-xo1,y-yo1 to x-xo2,y-yo2
trix(0)=x
triy(0)=y
trix(1)=x-xo1
triy(1)=y-yo1
trix(2)=x-xo2
triy(2)=y-yo2
fill poly trix,triy count 3
'fill triangle x,y to x+xo1,y-yo1 to x+xo2,y-yo2
trix(0)=x
triy(0)=y
trix(1)=x+xo1
triy(1)=y-yo1
trix(2)=x+xo2
triy(2)=y-yo2
fill poly trix,triy count 3
ang=ang+30
until ang>90
return


drawballs:

for ball=1 to numballs
x=ballx(ball)
y=bally(ball)
z=ballz(ball)
s=200/((z/focus)+1)
x=x/((z/focus)+1)
y=y/((z/focus)+1)
tempx(ball)=x
tempy(ball)=y
tempz(ball)=z
temps(ball)=s
next ball

for a=1 to numballs-1
for b=a+1 to numballs
if tempz(a)<tempz(b) then
tx=tempx(a)
ty=tempy(a)
tz=tempz(a)
ts=temps(a)
tempx(a)=tempx(b)
tempy(a)=tempy(b)
tempz(a)=tempz(b)
temps(a)=temps(b)
tempx(b)=tx
tempy(b)=ty
tempz(b)=tz
temps(b)=ts
end if
next b
next a

for ball=1 to numballs
x=tempx(ball)
z=tempz(ball)
s=temps(ball)
bri=128-(z/2)
r=bri/5
r2=r/2
y=s+r
'gosub drawshad
next ball

for ball=1 to numballs
x=tempx(ball)
y=tempy(ball)
z=tempz(ball)
s=temps(ball)
bri=128-(z/2)
r=bri/5
fill color (bri+100)/255,(bri/2)/255,(bri/2)/255

gosub drawball
next ball
return


moveballs:
for a=1 to numballs
x=ballx(a)!xd=ballxd(a)
y=bally(a)!yd=ballyd(a)
z=ballz(a)!zd=ballzd(a)
x=x+xd!y=y+yd!z=z+zd
if xd>8 then xd=xd-1
if xd<-8 then xd=xd+1
if zd>8 then zd=zd-1
if zd<-8 then zd=zd+1

yd=yd+1
if yd=0 then yd=1
if yd>20 then yd=20

if x<0 or x>400 then
xd=-xd
if x<0 then x=0
if x>400 then x=400
end if

if y<0 or y>400 then
yd=-yd
if y<0 then
y=0
end if
if y>400 then
y=400
if yd<0 then yd=yd+3
end if
end if

if z<-100 or z>200 then
zd=-zd
if z<-100 then z=-100
if z>200 then z=200
end if

if a<numballs then
for b=a+1 to numballs
dx=x-ballx(b)
dy=y-bally(b)
dz=z-ballz(b)
d=sqr(dx^2+dy^2+dz^2)/10
if d<5 then
xd=xd+dx/d
yd=yd+dy/d
zd=zd+dz/d
ballxd(b)=ballxd(b)-dx/d
ballyd(b)=ballyd(b)-dy/d-int(rnd(20))
ballzd(b)=ballzd(b)-dz/d
end if
next b
end if

ballx(a)=x
bally(a)=y
ballz(a)=z
ballxd(a)=xd
ballyd(a)=yd
ballzd(a)=zd
next a
return


initialize:
graphics
sw=screen_width()
sh=screen_height()
curbuf=0

numballs=6

dim cosines(361)
dim sines(361)
dim trix(4),triy(4)
for angle=0 to 360
cosines(angle)=cos(angle*(pi/180))
sines(angle)=sin(angle*(pi/180))
next angle

dim ballx(numballs+1)
dim bally(numballs+1)
dim ballz(numballs+1)
dim ballxd(numballs+1)
dim ballyd(numballs+1)
dim ballzd(numballs+1)
dim tempx(numballs+1)
dim tempy(numballs+1)
dim tempz(numballs+1)
dim temps(numballs+1)

for a=1 to numballs
ballx(a)=int(rnd(300))-100
bally(a)=int(rnd(300))-100
ballz(a)=int(rnd(300))-100
ballxd(a)=int(rnd(6))+2
ballyd(a)=int(rnd(6))+2
ballzd(a)=int(rnd(6))+2
next a

focus=800
dim bx(9)
dim by(9)
for a=1 to 8
read x
read y
read z
x=x/((z/focus)+1)
y=y/((z/focus)+1)
bx(a)=x
by(a)=y
next a

return

data 10,10,10
data 320,10,10
data 10,sh,10
data 320,sh,10
data 100,100,400
data 400,100,400
data 100,400,400
data 400,400,400

data 0,0,0
data 400,0,0
data 0,400,0
data 400,400,0
data 0,0,400
data 400,0,400
data 0,400,400
data 400,400,400

data -200,-200,-200
data 200,-200,-200
data -200,200,-200
data 200,200,-200
data -200,-200,200
data 200,-200,200
data -200,200,200
data 200,200,200

Re: 3d boing balls

Posted: Thu Feb 12, 2015 3:19 am
by Mr. Kibernetik
Cool jumping!