Thursday, September 26, 2013

Rock-paper-scissors



# This is a simulation of a system based on the popular game Rock-paper-scissors



clg: n=80: radius=8
graphsize 600,600
font "arial",10,100
outputvisible ( false )
fastgraphics
Dim type(n):Dim xpos(n):Dim ypos(n):Dim xspeed(n):Dim yspeed(n): Dim type(n)
# initial values
for u = 0 to n-1
a=rand
xpos[u]=(rand*600):ypos[u]=(rand*400):xspeed[u]=sin(a):yspeed[u]=cos(a):type[u]=int(rand*3)
next u
c=0
color black
rect 0,410,600,190
loop:
for u = 0 to n-2
for v = u+1 to n-1
distx=(xpos[u]-xpos[v])^2
disty=(ypos[u]-ypos[v])^2
dist=(distx+disty)^0.5
if dist<2*radius then gosub colision
next v
next u
S=0
R=0
P=0
c=c+1
if c=600 then
c=0
color black
rect 0,410,600,190
endif
for u = 0 to n-1
xpos[u]=xpos[u]+ xspeed[u]
ypos[u]=ypos[u]+ yspeed[u]
if xpos[u]<0 then xspeed[u]=(rand/10-1.05)*xspeed[u]
if ypos[u]<0 then yspeed[u]=(rand/10-1.05)*yspeed[u]
if xpos[u]>600 then xspeed[u]=(rand/10-1.05)*xspeed[u]
if ypos[u]>400 then yspeed[u]=(rand/10-1.05)*yspeed[u]
# Drawing objects
if type[u]=0 then
color red
circle xpos[u],ypos[u],radius
color black
text xpos[u]-5,ypos[u]-5,"S"
S=S+1
end if
if type[u]=1 then
color green
circle xpos[u],ypos[u],radius
color black
text xpos[u]-5,ypos[u]-5,"R"
R=R+1
end if
if type[u]=2 then
color yellow
circle xpos[u],ypos[u],radius
color black
text xpos[u]-5,ypos[u]-5,"P"
P=P+1
end if
next u
color red
circle c,600-(180/n)*S,1
color green
circle c,600-(180/n)*R,1
color yellow
circle c,600-(180/n)*P,1
refresh
color white
rect 0,0,600,410
goto loop
colision:
if type[u]=0 and type[v]=1 then type[u]=1
if type[v]=0 and type[u]=1 then type[v]=1
if type[u]=1 and type[v]=2 then type[u]=2
if type[v]=1 and type[u]=2 then type[v]=2
if type[u]=2 and type[v]=0 then type[u]=0
if type[v]=2 and type[u]=0 then type[v]=0
return

Tuesday, September 24, 2013

Number Bases

# counting in different bases
graphsize 300,300
font "Times New Roman",18,100
fastgraphics
dim base$(17)
dim comp(17)
for x = 1 to 2048
for base = 2 to 16
base$[base]=toradix(x,base)
comp=length(base$[base])
text 180-comp*12,20*base-42,base$[base]
text 200,20*base-42,"Base "+base
next base
refresh
clg
next x

Tuesday, September 17, 2013

PASCAL TRIANGLE

# I got this one from the BBC basic in Rosetta Code site
font "arial",10,100
graphsize 700,350
nrows = 16
FOR row = 1 TO nrows
acc = 1
FOR element = 1 TO row
text element*40+350-row*20,row*20, acc+" "
acc = acc * (row - element) / element
NEXT element
PRINT
NEXT row