Dark Bit Factory & Gravity

PROGRAMMING => Other languages => Yabasic => Topic started by: bikemadness on November 03, 2021

Title: Billiard Pin Ball
Post by: bikemadness on November 03, 2021

I never expanded on this.

Made it prettier though.

Code: [Select]

ang1=pi/180
ang2=180/pi
ra=30

restore colours
read shade
dim R(shade)
dim G(shade)
dim B(shade)

for a=1 to shade
read R(a)
read G(a)
read B(a)
next a

restore spheres
read ball

dim dirs(ball)
dim xs(ball)
dim ys(ball)
dim ssp(ball)
dim hitang(ball)
dim hit(ball)
dim reang(ball)
dim ra(ball)
dim go(ball)

for a=1 to ball
dirs(a)=0
read xs(a),ys(a)
ssp(a)=0
ra(a)=30
go(a)=int(ran(6))+1
next a

dirm=30
xm=500
ym=100
msp=8

open window 640,512
repeat
setdispbuf vm
vm=1-vm
setdrawbuf vm
clear window

setrgb 1,200,200,0
fill rectangle 0,0 to 640,512

for a=1 to ball
xs(a)=xs(a)+cos(dirs(a)*ang1)*ssp(a)
ys(a)=ys(a)+sin(dirs(a)*ang1)*ssp(a)

hitang(a)=atan(xs(a)-xm,ym-ys(a))*ang2+180
hit(a)=(abs(xs(a)-xm)^2+abs(ys(a)-ym)^2)^0.5
reang(a)=((dirs(a)+180)-dirm)*2+dirm-180
if hit(a)<ra(a)*2 dirm=reang(a)
dirs(a)=hitang(a)-90

if hit(a)<ra(a)*2 go(a)=go(a)+1
if go(a)>6 go(a)=1

for b=1 to shade
if go(a)=b setrgb 1,R(b),G(b),B(b)
next b

fill circle xs(a),ys(a),ra(a)

setrgb 1,0,0,0
circle xs(a),ys(a),ra(a)

next a

xm=xm+cos(dirm*ang1)*msp
ym=ym+sin(dirm*ang1)*msp

setrgb 1,250,120,0
fill circle xm,ym,ra

setrgb 1,0,0,0
circle xm,ym,ra

if xm<0+ra dirm=270-dirm+270
if xm>640-ra dirm=90-dirm+90
if ym<0+ra dirm=-dirm
if ym>510-ra dirm=180-dirm+180
if dirm>360 dirm=dirm-360
if dirm<0 dirm=dirm+360

until (1=0)

label spheres
data 10
data 252,126
data 396,126
data 468,252
data 396,378
data 252,378
data 180,252
data 50,50
data 590,50
data 50,462
data 590,462

label colours
data 6
data 256,000,000
data 000,256,000
data 000,000,256
data 256,256,000
data 256,128,000
data 256,000,256