10-08-2005, 02:03 AM
Only for fun ;-)
Joshy
Joshy
Code:
option explicit
'change it
const scr_w as integer = 640
const scr_h as integer = 480
const maxstrings as integer = 50 'Number of strings
const maxpoints as integer = 50 'Points per string
const stiffnes as single = 40 'an smaller value make the strings more softly thus also longer.
const gravity as single = 9.81 'No comment ;-)
'Do not change off here.
const laststring as integer = maxstrings-1
const lastpoint as integer = maxpoints - 1
const maxsprings as integer = maxpoints - 1
const lastspring as integer = maxsprings- 1
const damping as single = 30
const DT as single = 0.005
const scr_w_half as integer=scr_w/2-1
const scr_h_half as integer=scr_h/2-1
#ifndef true
#define true 1
#endif
#ifndef false
#define false 0
#endif
type boolean as integer
type vector3d
x as single
y as single
z as single
end type
type POINT3D
position as VECTOR3D
velocity as VECTOR3D
force as VECTOR3D
fixed as BOOLEAN
end type
type SPRING3D
p1 as integer
p2 as integer
init_length as single
current_length as single
end type
dim shared as POINT3D points (maxstrings,maxpoints)
dim shared as SPRING3D springs(maxstrings,maxsprings)
sub CreateNet()
dim as integer sc,i,p1,p2
dim as single w,sx,sy
sx=scr_w_half/(maxstrings+2)
for sc=0 to laststring
sy=1+rnd*(scr_h_half/(maxpoints+2))
for i=0 to lastspring
springs(sc,i).p1 = i
springs(sc,i).p2 = i+1
springs(sc,i).init_length = 10 'sy
next
points(sc,0).fixed=true
points(sc,0).position.x=sx+sc*sx
for i=1 to lastpoint-1
points(sc,i).position.x=scr_w\2 '(sx+(sc*sx))+sin(w)*100
w = w + 0.01
next
points(sc,lastpoint).fixed=true
points(sc,lastpoint).position.x=scr_w - (sx+sc*sx)
next
end sub
sub CalcForces()
dim as integer i,sc
dim as VECTOR3D pointdiff,velocitydiff
dim as single force,forcex,forcey,v,pv,direction
for sc=0 to laststring
for i=1 to lastpoint-1
points(sc,i).force.x = 0
points(sc,i).force.y = gravity
next
'Kraefte in den Baendern verteilen
for i=0 to lastspring
pointdiff.x=points(sc,springs(sc,i).p1).position.x - points(sc,springs(sc,i).p2).position.x
pointdiff.y=points(sc,springs(sc,i).p1).position.y - points(sc,springs(sc,i).p2).position.y
springs(sc,i).current_length=sqr(pointdiff.x*pointdiff.x + pointdiff.y*pointdiff.y)
if springs(sc,i).current_length<>0.0 then
velocitydiff.x = points(sc,springs(sc,i).p1).velocity.x - points(sc,springs(sc,i).p2).velocity.x
velocitydiff.y = points(sc,springs(sc,i).p1).velocity.y - points(sc,springs(sc,i).p2).velocity.y
force=(springs(sc,i).current_length-springs(sc,i).init_length)*stiffnes + _
(velocitydiff.x*pointdiff.x + velocitydiff.y * pointdiff.y) * _
(damping/springs(sc,i).current_length)
forcex=pointdiff.x/springs(sc,i).current_length*force
forcey=pointdiff.y/springs(sc,i).current_length*force
points(sc,springs(sc,i).p1).force.x-=forcex
points(sc,springs(sc,i).p1).force.y-=forcey
points(sc,springs(sc,i).p2).force.x+=forcex
points(sc,springs(sc,i).p2).force.y+=forcey
end if
next
'Innerhalb des Screens bewegen
for i = 0 to lastpoint
if points(sc,i).fixed=false then
points(sc,i).velocity.x+= Points(sc,i).force.x * DT
direction=points(sc,i).velocity.x * DT
if (points(sc,i).position.x + direction) < 1 then
points(sc,i).position.x=1
points(sc,i).velocity.x*= - 0.5
points(sc,i).velocity.y*= 0.5
elseif (points(sc,i).position.x + direction) > (scr_w-1) then
points(sc,i).position.x=(scr_w-1)
points(sc,i).velocity.x*= - 0.5
points(sc,i).velocity.y*= 0.95
else
points(sc,i).position.x+=direction
end if
points(sc,i).velocity.y+= Points(sc,i).force.y * DT
direction=points(sc,i).velocity.y * DT
if (points(sc,i).position.y + direction) < 1 then
points(sc,i).position.y=1
points(sc,i).velocity.y*= - 0.5
points(sc,i).velocity.x*= 0.5
elseif (points(sc,i).position.y + direction) > (scr_h-1) then
points(sc,i).position.y=(scr_h-1)
points(sc,i).velocity.y*= - 0.5
points(sc,i).velocity.x*= 0.5
else
points(sc,i).position.y+=direction
end if
end if 'not fixed
next
next
end sub
sub DrawStrings2()
dim as integer i,sc
for sc=0 to laststring
for i=0 to lastpoint-1
line (points(sc,i ).position.x,points(sc,i ).position.y)- _
(points(sc,i+1).position.x,points(sc,i+1).position.y), sc and &hFF
next
next
end sub
'
'main
'
dim as integer frames,wpage,vpage=1
dim as single t1,t2
CreateNet
t1=timer
screenres scr_w,scr_h,8,2
while len(inkey)=0
CalcForces
screenset wpage,vpage
swap wpage,vpage
cls
DrawStrings2
t2=timer
frames+=1
if (t2-t1) > 1 then
windowtitle "FPS="+str(frames)
t1=t2:frames=0
end if
wend
sleep
sorry about my english