FreeBASIC little physics

'遥か彼方

' Sets the graphics method GDI
' 描画方法を GDI に設定
SetEnviron("fbgfx=GDI")

Const g         As Single  = 9.80665
Const g2        As Single  = g * 2.0
Const gd2       As Single  = g * 0.5
Const pi        As Single  = 3.141592654
Const pi2       As Single  = pi * 2.0
Const onedegree As Single  = pi/180.0

Const max_particles As Integer = 100000
Const last_particle As Integer = max_particles - 1
Type PARTICLE
  bt   As Double 'birth time
  scrx As Integer
  scry As Integer
  posx As Integer
  posy As Integer
  v0   As Single 'speed    at time 0
  a    As Single
  col  As Integer
End Type
Dim Shared particles(max_particles) As PARTICLE
Sub init_particle(ByVal i As Integer,ByVal t As Double)
  Static w As Single
  Dim As Single rc,gc,bc
  rc=Cos(w)*0.5+0.5
  gc=Cos(w*1.25)*0.5+0.5
  bc=Cos(w*1.5)*0.5+0.5
  With particles(i)
    .posx=Int(Cos(w)*100)
    '.posy=int(sin(w)*240)
    .bt = t
    .v0 = Sin(w)*80
    .a  = Cos(w)*pi+pi2*Rnd
    .col=RGB(255*rc,255*gc,255*bc)
  End With
  w=w+(1.0/max_particles)
End Sub
Sub update_particles(ByVal t As Double)
  Dim As Single s,vs
  Dim i As Integer
  For i=0 To last_particle
    With particles(i)
    s=(t - .bt):vs=.v0*s
    .scrx=320 +.posx + Int(vs*Cos(.a))
    .scry=240 -(.posy + Int(vs*Sin(.a)-gd2*(s*s)))
    End With
  Next
End Sub   
Sub render_particles(ByVal t As Double)
  Dim i As Integer
  Dim pageptr As UInteger Ptr
  ScreenLock
  pageptr=ScreenPtr
  For i =0 To last_particle
    With particles(i)
      If .scry>479 Or .scrx<0 Or .scrx>639 Then
        init_particle i,t
      ElseIf .scry>-1 Then
        pageptr[.scrx+.scry*640]=.col
      End If
    End With
  Next
  ScreenUnlock
End Sub

'''main
Dim As Integer page,index
Dim As Double  starttime,curtime,nowtime
Dim As Single x,y

starttime=Timer
For index=0 To last_particle
  init_particle index,starttime
Next
ScreenRes 640,480,32,2
'''loop
While InKey=""
  ScreenSet page,page Xor 1:page = page Xor 1
  nowtime=Timer
  Cls
  update_particles nowtime
  render_particles nowtime
Wend

End