Author |
Topic: physics sims (Read 482 times) |
|
bluatigro
Full Member
member is offline
Gender: 
Posts: 111
|
 |
physics sims
« Thread started on: May 2nd, 2016, 08:59am » |
|
first a bouncing bal
Code:
global b.x , b.y , b.r , b.dx , b.dy , b.kl$
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , g
winx = WindowWidth
winy = WindowHeight
g = 0.1
b.r = 30
b.x = b.r
b.y = b.r + 50
b.dx = 5
b.kl$ = "red"
nomainwin
open "Physics sim" for graphics as #m
#m "trapclose [quit]"
#m "when characterInput [key]"
#m "setfocus"
timer 40 , [timer]
wait
[timer]
#m "fill white"
#m "goto " ; b.x ; " " ; b.y
#m "color " ; b.kl$
#m "backcolor " ; b.kl$
#m "down"
#m "circlefilled " ; b.r
#m "up"
#m "goto 0 " ; winy - 100
#m "down"
#m "backcolor green"
#m "boxfilled " ; winx ; " " ; winy
#m "up"
if b.x < b.r then
b.dx = abs( b.dx )
end if
if b.x > winx - b.r then
b.dx = 0-abs( b.dx )
end if
if b.y < b.r then
b.dy = abs( b.dy )
end if
if b.y > winy - b.r - 100 then
b.dy = 0-abs( b.dy ) * 0.95
end if
b.x = b.x + b.dx
b.y = b.y + b.dy
b.dy = b.dy + g
wait
[key]
key$ = right$( Inkey$ , 1 )
if key$ <> chr$( _VK_ESCAPE ) then wait
[quit]
close #m
end
|
|
 Logged
|
|
|
|
bluatigro
Full Member
member is offline
Gender:
Posts: 111
|
|
Re: physics sims
« Reply #1 on: May 2nd, 2016, 09:01am » |
|
more bals
Code:
global b.max
b.max = 20
dim b.x( b.max ) , b.y( b.max ) , b.r( b.max )
dim b.dx( b.max ) , b.dy( b.max ) , b.kl$( b.max )
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , g
winx = WindowWidth
winy = WindowHeight
g = 1e-3
for i = 0 to b.max
b.r(i) = range( 10 , 30 )
b.x(i) = range( b.r(i) , winx - b.r(i) )
b.y(i) = range( b.r(i) , winy - b.r(i) - 100 )
b.dx(i) = range( -5 , 5 )
b.dy(i) = range( -5 , 5 )
b.kl$(i) = rndkl$()
next i
nomainwin
open "Physics sim" for graphics as #m
#m "trapclose [quit]"
#m "when characterInput [key]"
#m "setfocus"
timer 40 , [timer]
wait
[timer]
#m "fill white"
for i = 0 to b.max
#m "goto " ; b.x(i) ; " " ; b.y(i)
#m "color " ; b.kl$(i)
#m "backcolor " ; b.kl$(i)
#m "down"
#m "circlefilled " ; b.r(i)
#m "up"
next i
#m "goto 0 " ; winy - 100
#m "down"
#m "backcolor green"
#m "boxfilled " ; winx ; " " ; winy
#m "up"
for i = 1 to b.max
for j = 0 to i - 1
d = dist(b.x(i),b.y(i),b.x(j),b.y(j))
r = b.r(i)+b.r(j)
if d < r then
b.x(i)=b.x(i)-b.dx(i)*(r-d)
b.y(i)=b.y(i)-b.dy(i)*(r-d)
b.x(j)=b.x(j)-b.dx(j)*(r-d)
b.y(j)=b.y(j)-b.dy(j)*(r-d)
h = b.dx(i)
b.dx(i)=b.dx(j)
b.dx(j)=h
h = b.dy(i)
b.dy(i)=b.dy(j)
b.dy(j)=h
end if
next j
next i
for i = 0 to b.max
if b.x(i) < b.r(i) then
b.dx(i) = abs( b.dx(i) )
end if
if b.x(i) > winx - b.r(i) then
b.dx(i) = 0-abs( b.dx(i) )
end if
if b.y(i) < b.r(i) then
b.dy(i) = abs( b.dy(i) )
end if
if b.y(i) > winy - b.r(i) - 100 then
b.dy(i) = 0-abs( b.dy(i) ) * 0.9
end if
b.x(i) = b.x(i) + b.dx(i)
b.y(i) = b.y(i) + b.dy(i)
b.dy(i) = b.dy(i) + g
next i
wait
[key]
key$ = right$( Inkey$ , 1 )
if key$ <> chr$( _VK_ESCAPE ) then wait
[quit]
close #m
end
function range( l , h )
range = rnd(0) * ( h - l ) + l
end function
function rgb$( r , g , b )
r = int( r ) and 255
g = int( g ) and 255
b = int( b ) and 255
rgb$ = str$( r ) + " " ; g ; " " ; b
end function
function rndkl$()
r = range( 0 , 255 )
g = range( 0 , 255 )
b = range( 0 , 255 )
rndkl$ = rgb$( r , g , b )
end function
function dist( a , b , c , d )
dist = sqr((a-c)^2+(b-d)^2)
end function
|
|
Logged
|
|
|
|
bluatigro
Full Member
member is offline
Gender:
Posts: 111
|
|
Re: physics sims
« Reply #2 on: May 2nd, 2016, 09:03am » |
|
bal fals in water
Code:
global b.x , b.y , b.r , b.dx , b.dy , b.kl$
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , g
winx = WindowWidth
winy = WindowHeight
g = 0.1
b.r = 60
b.x = winx / 2
b.y = b.r + 50
b.kl$ = "red"
nomainwin
open "Physics sim" for graphics as #m
#m "trapclose [quit]"
#m "when characterInput [key]"
#m "setfocus"
#m "size 5"
timer 40 , [timer]
wait
[timer]
#m "fill black"
#m "goto 0 " ; winy / 2
#m "down"
#m "color blue"
#m "line 0 " ; winy / 2 ; " " ; winx ; " " ; winy / 2
#m "up"
#m "goto " ; b.x ; " " ; b.y
#m "color " ; b.kl$
#m "backcolor " ; b.kl$
#m "down"
#m "circle " ; b.r
#m "up"
if b.x < b.r then
b.dx = abs( b.dx )
end if
if b.x > winx - b.r then
b.dx = 0-abs( b.dx )
end if
if b.y < b.r then
b.dy = abs( b.dy )
end if
if b.y > winy - b.r - 100 then
b.dy = 0-abs( b.dy ) * 0.95
end if
dr = ( b.y - winy / 2 ) / b.r
if dr <= -1 then
ratio = 0
else
if dr < 1 then
ratio = .5 + 0.25 * dr * ( 3 - dr * dr )
else
ratio = 1
end if
end if
turb = ratio * b.dy / 20
gravity = g
up = ratio * g * 2
b.x = b.x + b.dx
b.y = b.y + b.dy
b.dy = b.dy + gravity - up - turb
wait
[key]
key$ = right$( Inkey$ , 1 )
if key$ = chr$( _VK_SPACE ) then
b.y = b.r
end if
if key$ <> chr$( _VK_ESCAPE ) then wait
[quit]
close #m
end
|
|
Logged
|
|
|
|
bluatigro
Full Member
member is offline
Gender:
Posts: 111
|
|
Re: physics sims
« Reply #3 on: May 2nd, 2016, 09:07am » |
|
using lgbfx lib
bal fals in water
error :
bal does not floot
Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx , pi
global key$ , mouse.x , mouse.y
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
global b.x , b.dx , b.y , b.dy , b.r , b.kl , tel
b.r = 30
b.x = winx / 2
b.y = b.r
b.kl = red
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx physics" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
timer 40 , [timer]
wait
[timer]
call setcolor black
call lbgfx "cls"
call setcolor blue
call lbgfx "boxfilled 0 " ; winy / 2 ; " " ; winx ; " " ; winy
call setcolor rainbow( tel )
call lbgfx "circlefilled " ; b.x ; " " ; b.y ; " " ; b.r
if b.x < b.r then
b.dx = abs( b.dx )
end if
if b.x > winx - b.r then
b.dx = 0-abs( b.dx )
end if
if b.y < b.r then
b.dy = abs( b.dy )
end if
if b.y > winy - b.r - 100 then
b.dy = 0-abs( b.dy ) * 0.95
end if
dr = ( b.y - winy / 2 ) / b.r
if dr <= -1 then
ratio = 0
else
if dr < 1 then
ratio = .5 + 0.25 * dr * ( 3 - dr * dr )
else
ratio = 1
end if
end if
turb = ratio * b.dy / 20
gravity = 0.1
up = ratio * g * 2
b.x = b.x + b.dx
b.y = b.y + b.dy
b.dy = b.dy + gravity - up - turb
tel = tel + 1
if tel > winx / 3 then
tel = 0
b.y = b.r
end if
call lbgfx "flip"
wait
[key]
key$ = right$( Inkey$ , 1 )
if key$ = " " then
tel = 0
b.y = b.r
end if
if key$ <> chr$( 27 ) then wait
[quit]
call DestroyLBGfx
close #lbgfx
close #main
end
[move]
mouse.x = MouseX
mouse.y = MouseY
wait
''math
function rad( deg )
rad = deg * pi / 180
end function
''color stuf
function rgb( r , g , b )
r = int( r ) and 255
g = int( g ) and 255
b = int( b ) and 255
rgb = r + g * 256 + b * 256 ^ 2
end function
sub setcolor kl
r = kl and 255
g = int( kl / 256 ) and 255
b = int( kl / 256 ^ 2 ) and 255
call lbgfx "color ";r;" ";g;" ";b
call lbgfx "backcolor ";r;" ";g;" ";b
end sub
function mix( kla , f , klb )
r1 = kla and 255
g1 = int( kla / 256 ) and 255
b1 = int( kla / 256 ^ 2 ) and 255
r2 = klb and 255
g2 = int( klb / 256 ) and 255
b2 = int( klb / 256 ^ 2 ) and 255
r = r1 + ( r2 - r1 ) * f
g = g1 + ( g2 - g1 ) * f
b = b1 + ( b2 - b1 ) * f
mix = rgb( r , g , b )
end function
function rainbow( deg )
r = sin( rad( deg ) ) * 127 + 128
g = sin( rad( deg - 120 ) ) * 127 + 128
b = sin( rad( deg + 120 ) ) * 127 + 128
rainbow = rgb( r , g , b )
end function
''dan teel stuf
sub lbgfx text$
calldll #lbgfx,"graphicCommand" _
,gfx as ulong _
,text$ as ptr _
,ret as void
end sub
function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
calldll #user32,"CreateWindowExA",_
0 as long,_
"LBGfx32" as ptr,_
0 as ulong,_
style as ulong,_
x as long,_
y as long,_
w as long,_
h as long,_
hParent as ulong,_
0 as ulong,_
instance as ulong,_
hMessageHandler as ulong,_
CreateLBGfx as ulong
end function
sub DestroyLBGfx
calldll #user32, "DestroyWindow",_
gfx as ulong, _
ret as long
end sub
sub FixWindowSize hwnd,width,height
struct fixrect _
,left as long _
,top as long _
,right as long _
,bottom as long
calldll #user32,"GetClientRect" _
,hwnd as ulong _
,fixrect as struct _
,ret as void
width=width-fixrect.right.struct+width
height=height-fixrect.bottom.struct+height
calldll #user32,"GetWindowRect" _
,hwnd as ulong _
,fixrect as struct _
,ret as void
x=fixrect.left.struct
y=fixrect.top.struct
calldll #user32,"MoveWindow" _
,hwnd as ulong _
,x as long _
,y as long _
,width as long _
,height as long _
,1 as long _
,ret as void
end sub
|
| « Last Edit: May 2nd, 2016, 09:08am by bluatigro » |
Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: physics sims
« Reply #4 on: May 2nd, 2016, 09:09am » |
|
on May 2nd, 2016, 08:59am, bluatigro wrote:
It's nicer if you remove the scrollbar and borders:
Code:open "Physics sim" for graphics_fs_nsb as #m
Richard.
|
|
Logged
|
|
|
|
bluatigro
Full Member
member is offline
Gender:
Posts: 111
|
|
Re: physics sims
« Reply #5 on: May 2nd, 2016, 09:12am » |
|
first try at flokking
using lbgfx
error :
the boids look strange
at the end the boids move alway to the right
Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , gfx , pi
global key$ , mouse.x , mouse.y
winx = WindowWidth
winy = WindowHeight
pi = atn( 1 ) * 4
global red , green , yellow
global blue , magenta , cyan
red = rgb( 255 , 0 , 0 )
green = rgb( 0 , 255 , 0 )
yellow = rgb( 255 , 255 , 0 )
blue = rgb( 0 , 0 , 255 )
magenta = rgb( 255 , 0 , 255 )
cyan = rgb( 0 , 255 , 255 )
global b.max
b.max = 20
dim x(b.max),y(b.max),dx(b.max),dy(b.max)
graphicbox #m.lbgfx, 0,0,0,0
nomainwin
open "LBGfx" for window as #m
call FixWindowSize hwnd(#m),winx,winy
#m.lbgfx "when mouseMove [move]"
#m.lbgfx "when characterInput [key]"
#m "trapclose [quit]"
#m.lbgfx "setfocus"
open DefaultDir$+"\LBGfx.dll" for dll as #lbgfx
gfx=CreateLBGfx(0,0,winx,winy _
,hwnd(#m),hwnd(#m.lbgfx))
for i = 0 to b.max
x(i)=winx/2+sin(rad(i*360/b.max))*210
y(i)=winy/2+cos(rad(i*360/b.max))*210
dx(i)=sin(rad(i*360/b.max))
dy(i)=cos(rad(i*360/b.max))
next i
timer 40 , [timer]
wait
[timer]
call lbgfx "backcolor black"
call lbgfx "cls"
for i = 0 to b.max
call boid.draw i
call boid.to.center i
call boid.align i
call boid.from.neigbor i
x(i)=x(i)+dx(i)
y(i)=y(i)+dy(i)
if x(i)<0 then x(i)=winx
if x(i)>winx then x(i)=0
if y(i)<0 then y(i)=winy
if y(i)>winy then y(i)=0
next i
call lbgfx "flip"
wait
[key]
key$ = right$( Inkey$ , 1 )
if key$ <> chr$( 27 ) then wait
[quit]
call DestroyLBGfx
close #lbgfx
close #main
end
[move]
mouse.x = MouseX
mouse.y = MouseY
wait
''graphics
sub boid.draw no
x = x(no)
y = y(no)
dx = dx(no)
dy = dy(no)
a = degrees( atan2( dx , dy ) )
call setcolor rainbow( a )
call lbgfx "circlefilled ";x;" ";y;" 30"
x1 = 14
y1 = -14
x2 = -14
y2 = -14
call rotate x1 , y1 , a + 90
call rotate x2 , y2 , a + 90
call setcolor white
call lbgfx "circlefilled ";x+x1;" ";y+y1;" 10"
call setcolor black
call lbgfx "circlefilled ";x+x1;" ";y+y1;" 5"
call setcolor white
call lbgfx "circlefilled ";x+x2;" ";y+y2;" 10"
call setcolor black
call lbgfx "circlefilled ";x+x2;" ";y+y2;" 5"
end sub
sub boid.to.center no
sum.x = 0
sum.y = 0
for i = 0 to b.max
if no <> i then
if boid.dist(i,no)<200 then
sum.x = sum.x + x(i)
sum.y = sum.y + y(i)
end if
end if
next i
a = atan2(dx(no),dy(no))
w = atan2(sum.x,sum.y)
dx = dx(no)
dy = dy(no)
if w < a then
call rotate dx , dy , -1
else
if w > a then
call rotate dx , dy , 1
end if
end if
dx(no) = dx
dy(no) = dy
end sub
sub boid.align no
sum.x = 0
sum.y = 0
for i = 0 to b.max
if no <> i then
if boid.dist(i,no)<200 then
sum.x = sum.x + dx(i)
sum.y = sum.y + dy(i)
end if
end if
next i
a = atan2(dx(no),dy(no))
w = atan2(sum.x,sum.y)
dx = dx(no)
dy = dy(no)
if w < a then
call rotate dx , dy , -1
else
if w > a then
call rotate dx , dy , 1
end if
end if
dx(no) = dx
dy(no) = dy
end sub
sub boid.from.neigbor no
tel = 0
dist = 1e9
for i = 0 to b.max
if no <> i then
if boid.dist(i,no)<dist then
tel = i
dist = boid.dist(i,no)
end if
end if
next i
a = atan2(x(tel)-x(no),y(tel)-y(tel))
w = atan2(dx(no),dy(no))
dx = dx(no)
dy = dy(no)
if w < a then
call rotate dx , dy , 2
else
if w > a then
call rotate dx , dy , -2
end if
end if
dx(no) = dx
dy(no) = dy
end sub
function boid.dist( a , b )
boid.dist = sqr((x(a)-x(b))^2+(y(a)-y(b))^2)
end function
''math
function atan2( a , b )
if a = 0 then
if b < 0 then
uit = 0 - pi / 2
else
uit = pi / 2
end if
else
if a < 0 then
uit = pi - atn( b / abs( a ) )
else
uit = atn( b / a )
end if
end if
atan2 = uit
end function
function rad( deg )
rad = deg * pi / 180
end function
function degrees( r )
degrees = r * 180 / pi
end function
function range( l , h )
range = rnd(0) * ( h - l ) + l
end function
sub rotate byref k , byref l , deg
s = sin( rad( deg ) )
c = cos( rad( deg ) )
hk = k * c - l * s
hl = k * s + l * c
k = hk
l = hl
end sub
''color stuf
function rgb( r , g , b )
r = int( r ) and 255
g = int( g ) and 255
b = int( b ) and 255
rgb = r + g * 256 + b * 256 ^ 2
end function
function rainbow( deg )
r = sin( rad( deg ) ) * 127 + 128
g = sin( rad( deg - 120 ) ) * 127 + 128
b = sin( rad( deg + 120 ) ) * 127 + 128
rainbow = rgb( r , g , b )
end function
sub setcolor kl
r = kl and 255
g = int( kl / 256 ) and 255
b = int( kl / 256 ^ 2 ) and 255
call lbgfx "color ";r;" ";g;" ";b
call lbgfx "backcolor ";r;" ";g;" ";b
end sub
function mix( kla , f , klb )
r1 = kla and 255
g1 = int( kla / 256 ) and 255
b1 = int( kla / 256 ^ 2 ) and 255
r2 = klb and 255
g2 = int( klb / 256 ) and 255
b2 = int( klb / 256 ^ 2 ) and 255
r = r1 + ( r2 - r1 ) * f
g = g1 + ( g2 - g1 ) * f
b = b1 + ( b2 - b1 ) * f
mix = rgb( r , g , b )
end function
''dan teel stuf
sub lbgfx text$
calldll #lbgfx,"graphicCommand" _
,gfx as ulong _
,text$ as ptr _
,ret as void
end sub
function CreateLBGfx(x,y,w,h,hParent,hMessageHandler)'Returns 0 if fail, hWnd if pass
style=_WS_VISIBLE+_WS_CHILD+_WS_CLIPCHILDREN
calldll #kernel32,"GetModuleHandleA",0 as ulong,instance as ulong
calldll #user32,"CreateWindowExA",_
0 as long,_
"LBGfx32" as ptr,_
0 as ulong,_
style as ulong,_
x as long,_
y as long,_
w as long,_
h as long,_
hParent as ulong,_
0 as ulong,_
instance as ulong,_
hMessageHandler as ulong,_
CreateLBGfx as ulong
end function
sub DestroyLBGfx
calldll #user32, "DestroyWindow",_
gfx as ulong, _
ret as long
end sub
sub FixWindowSize hwnd,width,height
struct fixrect _
,left as long _
,top as long _
,right as long _
,bottom as long
calldll #user32,"GetClientRect" _
,hwnd as ulong _
,fixrect as struct _
,ret as void
width=width-fixrect.right.struct+width
height=height-fixrect.bottom.struct+height
calldll #user32,"GetWindowRect" _
,hwnd as ulong _
,fixrect as struct _
,ret as void
x=fixrect.left.struct
y=fixrect.top.struct
calldll #user32,"MoveWindow" _
,hwnd as ulong _
,x as long _
,y as long _
,width as long _
,height as long _
,1 as long _
,ret as void
end sub
|
| « Last Edit: May 2nd, 2016, 09:14am by bluatigro » |
Logged
|
|
|
|
|
