Showing posts with label Simulation. Show all posts
Showing posts with label Simulation. Show all posts

Tuesday, January 7, 2014

3D Ball

# Based in an example program, a retake on a 3D simulation
graphsize 500,500
vx=.002
vy=.003
vz=.005
xball=1
yball=1
zball=1
while 1=1
a = mousex / 200
b = mousey / 200
gosub update
end while
update:
fastgraphics
clg
x=0
y=2
z=0
gosub matrix
x1=sx
y1=sy
x=2
y=0
z=0
gosub matrix
x2=sx
y2=sy
x=2
y=2
z=0
gosub matrix
x3=sx
y3=sy
color darkgreen
poly{200,200,x1,y1,x3,y3,x2,y2}
xball=xball+vx
yball=yball+vy
zball=zball+vz
vz=vz-.0005
if xball>2 then vx=-vx
if xball<0 then vx=-vx
if yball>2 then vy=-vy
if yball<0 then vy=-vy
if zball<0 then vz=-vz*.98
color black
x=xball
y=yball
z=0
gosub matrix
chord sx,sy,10,5-((y1+y2+y3)/100),0,pi*2
color red
x=xball
y=yball
z=zball
gosub matrix
circle sx,sy,5

if y3<200 then
color darkyellow
poly{200,200,x1,y1,x3,y3,x2,y2}
end if
refresh
clg
return
matrix:
u = x
v = y
w = z
u2 = u * cos(a) - v * sin(a)
v2 = u * sin(a) + v * cos(a)
w2 = w
u = u2
v = v2
w = w2
u2 = u
v2 = v * cos(b) - w * sin(b)
w2 = v * sin(b) + w * cos(b)
u = u2
v = v2
w = w2
sx = 200+u * (w + 2) * 35
sy = 200+v * (w + 2) * 35
return
Posted by at No comments:

Sunday, October 13, 2013

n body simulation

# this is a n-body simulation , use arrow keys to keep it centered
# Number of inital particles


graphsize 600,600
fastgraphics
n=100
dim x(n+1)
dim y(n+1)
dim xspeed(n+1)
dim yspeed(n+1)
dim xac(n+1)
dim yac(n+1)
dim mass(n+1)
dim radius(n+1)
# initializing variables ##############
for p = 1 to n
a=rand*2*pi
r=rand*300
x[p]=r*cos(a)+300
y[p]=r*sin(a)+300
s=rand*2*pi/20
xspeed[p]=cos(a+s)-cos(a)
yspeed[p]=sin(a+s)-sin(a)
radius[p]=3
mass[p]=radius[p]^3
next p

gravity=0
dist=0
colision = 0
dx=0
dy=0
v=0
h=0

loop:
# arrow keys####################
a = key
if 16777234=a then h=h-5
if 16777236 =a then h=h+5
if 16777237=a then v=v-5
if 16777235=a then v=v+5

for u = 1 to n
for t = 1 to n
if u<>t and mass[t]>0 and mass[u]>0 then
dx=x[u]-x[t]
dy=y[u]-y[t]
dist=(dx^2 + dy^2)^(1/2)
collide = false
if dist < radius[u]+radius[t] then collide = true
# gravity code################
if collide = true then
x[u]=(x[u]*mass[u]+x[t]*mass[t])/(mass[u]+mass[t])
y[u]=(y[u]*mass[u]+y[t]*mass[t])/(mass[u]+mass[t])
xspeed[u]=(xspeed[u]*mass[u]+xspeed[t]*mass[t])/(mass[u]+mass[t])
yspeed[u]=(yspeed[u]*mass[u]+yspeed[t]*mass[t])/(mass[u]+mass[t])
mass[u]=mass[u]+mass[t]
radius[u]=mass[u]^(1/3)
mass[t]=0
radius[t]=0
end if

# colision code################
if collide = false then
gravity = mass[t]*mass[u]/dist^2
xac[u]= gravity*dx/(1000*mass[u])
yac[u]= gravity*dy/(1000*mass[u])
xspeed[u]=xspeed[u]-xac[u]
yspeed[u]=yspeed[u]-yac[u]
x[u]=x[u]+xspeed[u]
y[u]=y[u]+yspeed[u]
end if
###############################
end if
next t
color white
circle x[u]+h,y[u]+v,radius[u]
next u
refresh
clg
color black
rect 0,0,600,600

goto loop
Posted by at No comments:

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
Posted by at No comments:

Friday, November 9, 2012

Golden Waves

graphsize 600,600
fastgraphics
for t=1 to 60 step .1
color darkred
rect 0,0,600,600
For y1 = 0 to 24
For x1 = 0 to 24
x=12*(24-x1)+12*y1
y=-6*(24-x1)+6*y1+300
d= ((10-x1)^2+(10-y1)^2)^.5
h=60*sin(x1/4+t)+65
if t>10 and t<20 then h=60*sin(y1/4+t)+65
if t>20 and t<30 then h=60*sin((x1-y1)/4+t)+65
if t>30 and t<40 then h=30*sin(x1/2+t)+30*sin(y1/2+t)+65
if t>40 and t<50 then h=60*sin((x1+y1)/4+t)+65
if t>50 and t<60 then h=60*sin(d*.3+t)+65
color rgb(100+h,100+h,h)
poly{x,y-h,x+10,y+5-h,x+20,y-h,x+10,y-5-h}
color rgb(60,60,0)
poly{x,y-h,x+10,y+5-h,x+10,y,x,y-5}
color rgb(150,150,0)
poly{x+10,y+5-h,x+10,y,x+20,y-5,x+20,y-h}
next x1
next y1
refresh
clg
next t
Posted by at

Friday, October 12, 2012

Multiparticle collider


Rem 2D collisions
fastgraphics
m=6
n=m^2
Dim x(n)
Dim y(n)
Dim vx(n)
Dim vy(n)
Dim mass(n)
Dim colisionflag(n,n)
ed=1
u=0
rem initial variables
for a = 0 to m-1
for b = 0 to m-1
x[u]=50*a+10
y[u]=50*b+10
vx[u]=rand-.5
vy[u]=rand-.5
mass[u]=7
u=u+1
next b
next a
Rem main loop
While 1=1
for u = 0 to n-1
If x[u]<mass[u] or x[u]>(300-mass[u]) then vx[u]=-vx[u]
If y[u]<mass[u] or y[u]>(300-mass[u]) then vy[u]=-vy[u]
x[u]=x[u]+vx[u]
y[u]=y[u]+vy[u]
color rgb (u*7,0,255-u*7)
circle x[u],y[u],mass[u]
next u
refresh
clg
gosub colision
end while
colision:
rem collision detection
for u1 = 0 to n-2
for u2 = u1+1 to n-1
dx = x[u2]-x[u1]
dy = y[u2]-y[u1]
distance = (dx*dx+dy*dy)^.5
if distance < (mass[u1]+mass[u2]) then
if colisionflag[u1,u2]=0 then
rem vx and vy calc
ax=dx/distance
ay=dy/distance
va1=vx[u1]*ax+vy[u1]*ay
vb1=-vx[u1]*ay+vy[u1]*ax
va2=vx[u2]*ax+vy[u2]*ay
vb2=-vx[u2]*ay+vy[u2]*ax
vaP1=va1 + (1+ed)*(va2-va1)/(1+mass[u1]/mass[u2])
vaP2=va2 + (1+ed)*(va1-va2)/(1+mass[u2]/mass[u1])
vx[u1]=vaP1*ax-vb1*ay
vy[u1]=vaP1*ay+vb1*ax
vx[u2]=vaP2*ax-vb2*ay
vy[u2]=vaP2*ay+vb2*ax
colisionflag[u1,u2]=1
end if
else
colisionflag[u1,u2]=0
end if
next u2
next u1
return

Posted by at No comments:

Wednesday, December 15, 2010

Rule 30

Rem http://en.wikipedia.org/wiki/Rule_30
clg
fastgraphics
graphsize 900,450
plot (450,1)
print pixel (10,10)
For y = 1 to 450
For x = 1 to 900
if pixel (x-1,y-1)=0 and pixel (x,y-1)<>0 and pixel (x+1,y-1)<>0 then plot(x,y)
if pixel (x-1,y-1)<>0 and pixel (x,y-1)=0 and pixel (x+1,y-1)=0 then plot(x,y)
if pixel (x-1,y-1)<>0 and pixel (x,y-1)=0 and pixel (x+1,y-1)<>0 then plot(x,y)
if pixel (x-1,y-1)<>0 and pixel (x,y-1)<>0 and pixel (x+1,y-1)=0 then plot(x,y)
next x
refresh
next y
Posted by at No comments:

Sunday, December 5, 2010

Black hole


graphsize 600,600
x=160
y=180
xspeed=2
yspeed=-1
r=2
n=400
dim x(n+1)
dim y(n+1)
dim xspeed(n+1)
dim yspeed(n+1)
dim dist(n+1)
dim dx(n+1)
dim dy(n+1)
dim xac(n+1)
dim yac(n+1)
dim gravity(n+1)
dim crash(n+1)
colision = 0
for p = 1 to n
x[p]=rand*600
y[p]=rand*600
next p
for s = 1 to n
xspeed[s]=rand*2-1
yspeed[s]=rand*2-1
next s
px=300
py=300
circle px,py,5
fastgraphics
loop:
clg

for t = 1 to n
dist[t]=((x[t]-px)^2 + (y[t]-py)^2)^(1/2)
gravity[t] = (r/dist[t])^2
dx[t]=x[t]-px
dy[t]=y[t]-py
xac[t]= (dx[t]/dist[t])*gravity[t]
yac[t]= (dy[t]/dist[t])*gravity[t]
if crash[t]=0 then xspeed[t]=xspeed[t]*.999-xac[t]
if crash[t]=0 then yspeed[t]=yspeed[t]*.999-yac[t]
if crash[t]=0 then x[t]=x[t]+xspeed[t]
if crash[t]=0 then y[t]=y[t]+yspeed[t]
if dist[t] < r and crash[t]=0 then
r=r+8/r^2
colision = colision+1
crash[t]=1
end if
text 10,10,"Colisions="+colision
circle x[t],y[t],2
next t
circle px,py,r
refresh
goto loop
Posted by at No comments:

Friday, December 3, 2010

Forest fire


fastgraphics
graphsize 600,600
font "Arial", 20,100
dim cell(101,101)
cell[50,50]=2
burned = 1
Rem probabilitity to catch fire
p=.3
for turn = 1 to 1000
For x = 2 to 99
For y = 2 to 99
if cell[x-1,y]=2 and cell[x,y]=0 and rand < p then cell[x,y]=3
if cell[x,y-1]=2 and cell[x,y]=0 and rand < p then cell[x,y]=3
if cell[x,y+1]=2 and cell[x,y]=0 and rand < p then cell[x,y]=3
if cell[x+1,y]=2 and cell[x,y]=0 and rand < p then cell[x,y]=3
if cell[x-1,y-1]=2 and cell[x,y]=0 and rand < p then cell[x,y]=3
if cell[x-1,y+1]=2 and cell[x,y]=0 and rand < p then cell[x,y]=3
if cell[x+1,y-1]=2 and cell[x,y]=0 and rand < p then cell[x,y]=3
if cell[x+1,y+1]=2 and cell[x,y]=0 and rand < p then cell[x,y]=3
if cell[x,y]=3 then burned = burned + 1
next y
next x
For x = 2 to 99
For y = 2 to 99
if cell[x,y]=0 then color green
if cell[x,y]=1 then color darkorange
if cell[x,y]=2 then color red
if cell[x,y]=3 then color yellow
if cell[x,y]>1 then cell[x,y]=cell[x,y]-1
rect 6*x,6*y,6,6
next y
next x
color blue
Text 10,10,"Cicle="+turn+" % burned trees=" +(burned/100)
refresh
next turn
Posted by at No comments:

Monday, November 1, 2010

Game of life


Rem http://en.wikipedia.org/wiki/Conway%27s_Game_of_Life
fastgraphics
font "Arial", 20,100
graphsize 600,600
dim cell1(101,101)
dim cell2(101,101)
For x = 2 to 99
For y = 2 to 99
cell1[x,y]=int (rand*2)
next y
next x
for turn = 1 to 1000
For x = 2 to 99
For y = 2 to 99
neighbours = cell1[x-1,y]+cell1[x-1,y-1]+cell1[x,y-1]+cell1[x-1,y+1]+cell1[x+1,y-1]+cell1[x+1,y+1]+cell1[x,y+1]+cell1[x+1,y]
cell2[x,y]=cell1[x,y]
if cell1[x,y]=1 and (neighbours<2 or neighbours>3 ) then cell2[x,y]=0
if cell1[x,y]=0 and neighbours=3 then cell2[x,y]=1
next y
next x
For x = 2 to 99
For y = 2 to 99
cell1[x,y]=cell2[x,y]
color rgb( 255*(1-cell1[x,y]),255*(1-cell1[x,y]),255*(1-cell1[x,y]))
rect (6*x,6*y,6,6)
next y
next x
color red
text 10,10,"Cicle"+turn
refresh
next turn
Posted by at No comments:
Subscribe to: Comments (Atom)