'terminal velocity sim 'by dodicat ≫ Feb 07, 2012 21:13 'https://www.freebasic.net/forum/viewtopic.php?f=7&t=19341#p170576 ' Sets the graphics method GDI ' 描画方法を GDI に設定 SetEnviron("fbgfx=GDI") Dim As Integer xres,yres Screen 20 ScreenInfo xres,yres Const k=1 Const g=9.81 '重力 gravity Const m=5 '質量 mass Const v=200 '初速 initial velocity Const w=0 '風速 windspeed Dim As Any Pointer im=ImageCreate(xres,yres,0) Type v2 As Single x,y End Type #define r(f,l) Rnd * ((l) - (f)) + (f) Dim As Integer n=100 Dim As v2 startpos,position,lastposition ReDim Shared As v2 b() ReDim Shared As Single ang(),vel(),rad() #Macro setup(n) ReDim b(1 To n) ReDim rad(1 To n) ReDim vel(1 To n) ReDim ang(1 To n) For z As Integer=1 To n rad(z)=(8-3)*(z-1)/(n-1)+3 ang(z)=r(0,360) ang(z)=ang(z)*(4*Atn(1))/180 vel(z)=r(10,50) Next z #EndMacro setup(n) startpos=Type(100,0) Dim As Single theta=60 '発射角 initial angle theta=theta*(4*Atn(1))/180 'ラジアン degrees to radians Dim As Single t,y,zz Do Do t=t+.03 position.x=startpos.x+(m/k)*(1-Exp(-(k/m)*t))*(V*Cos(theta)-w)+w*t position.y=startpos.y+(m/k)*(1-Exp(-(k/m)*t))*(V*Sin(theta)+g*m/k)-(g*m/k)*t ScreenLock Cls Put(0,0),im PSet im,(position.x,yres-position.y),2 Circle (position.x,yres-position.y),5,4,,,,f If position.y<lastposition.y Then ScreenUnlock startpos=Type(position.x,position.y) t=0 Do t=t+.03 ScreenLock Cls Put(0,0),im For z As Integer=1 To n b(z)=Type(startpos.x+(m/k)*(1-Exp(-(k/m)*t))*(vel(z)*Cos(ang(z))-w)+w*t,_ startpos.y+(m/k)*(1-Exp(-(k/m)*t))*(vel(z)*Sin(ang(z))+g*m/k)-(g*m/k)*t) Circle(b(z).x,yres-b(z).y),rad(z),z,,,,f PSet im,(b(z).x,yres-b(z).y),z If y<b(z).y Then y=b(z).y:zz=z Next z ScreenUnlock Sleep 1,1 If InKey=Chr(27) Then Exit Do,Do,Do If b(zz).y<0 Then Exit Do,Do Loop End If lastposition=position ScreenUnlock Sleep 1,1 Loop Randomize startpos=Type(r(.4*xres,.6*xres)) theta=r(70,110) theta=theta*(4*Atn(1))/180 'degrees to radians n=r(250,450) y=0 setup(n) lastposition=startpos ImageDestroy(im) im=ImageCreate(xres,yres,0) t=0 Loop Until InKey=Chr(27) ImageDestroy(im)