aUCBLogo Demos and Tests / drumsimulation

be drumsimulation
   part2 10^2 5
end

to part2 partnum pensize_
   rnum=round sqrt partnum
   partx=(array partnum 1)
   partv=array partx
   parta=array partx
   a=array partx
   partcolor=array partx
   partbounces=array partx
   noforce=Array partx
   trails=false

   perspective
   setUpdateGraph false
   setPointSize pensize_
;   disablePointSmooth
   enablePointSmooth
;   enableDepthTest
   enableShadows
   cs ht pu setpc [50 230 20]
   setx 0 sety -200-pensize_
   pd rt 90 fd 1000 pu home pd
   OnMouseLeftDown [trails=true]
   OnMouseRightDown
   [   cs ht pu setpc [50 230 20]
      setx 0 sety -200-pensize_
      pd rt 90 fd 1000 pu home pd
      trails=false
   ]
   dopt=40
   repeat partnum
   [   j=repcount
      partx.j=Float (List
         dopt*(Int (j-1)/rnum)-dopt/(sqrt 2)*mod j-1 rnum
         0
         dopt*rnum/2-dopt*(mod j-1 rnum))
      partv.j=(List 0.0 -2.0 0.0)
      parta.j=(List 0.0 0.0 0.0)
      a.j=(List 0.0 0.0 0.0)
      partbounces.j=Int 0
      partcolor.j=HSBA 360*j/(partnum+1) 1 1 1
      noforce.j=Int 1
   ]
;   noforce1_=Array noforce1
;   noforce10=Array noforce1
;   noforce11=Array noforce1
;   noforce20=Array noforce1
   for [i [partnum-rnum+1] partnum]
   [   parta.i=(List 0.0 -0.05 0.0)
   ]
   for [i 1 rnum]
   [   noforce.i=Int 0
      noforce.(i*rnum)=Int 0
   ]
   for [i 0 rnum-1]
   [   noforce.(rnum*rnum-i)=Int 0
      noforce.(i*rnum+1)=Int 0
   ]
;   norefresh
   fn=10000
   force=(Array fn+1 0)
   fac=0.01
   ffein=10
   dopf=10*dopt
   for [i 4 fn]
   [   force.i=
         saturateBelow -1
         saturateAbove 1
         fac*( 1*((i/dopf)^(-8))-2*(i/dopf)^(-4))
   ]
   for [i 0 3]
   [   force.i=0
   ]
   pd setpc 0 setXY rSeq -400 400 fn tolist force*1000 pu
   updateGraph
;stop
   grass=loadImage "grass.jpg
   texGrass=Texture grass

   eye=Array 3
   phi=0
   theta=30
   dtheta=1
   center={0 0 0}
   upvector={0 1 0}
   dphi=1
   ddphi=dphi/3
   rotatescene_r=800
   dr=1.1
   onCharHandler
   OnChar [onCharHandler]
   pal=(Array 256 0)
   repeat 256 [pal.#-1=HSB 360*#/256 1 1]
   video=false
;   video=true
   if video [(VideoStart "sheet 30)]
   running=true
   while [running]
   [   a*=0

      dx=(partx-rotate partx 1)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a+dx*f ;*noforce1

      dx=(partx-rotate partx 2)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a-dx*f

      dx=(partx-rotate partx rnum)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a+dx*f ;*noforce10

      dx=(partx-rotate partx rnum+1)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a+dx*f ;*noforce11

      dx=(partx-rotate partx rnum*2)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a-dx*f

      dx=(partx-rotate partx -1)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a+dx*f ;*noforce1

      dx=(partx-rotate partx -2)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a-dx*f

      dx=(partx-rotate partx -rnum)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a+dx*f ;*noforce10

      dx=(partx-rotate partx -rnum-1)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a+dx*f ;*noforce11

      dx=(partx-rotate partx -rnum*2)
      f=force.Int (saturateAbove fn (Norm dx)*ffein)
      a=a-dx*f

      partv=partv+a
      partv=partv*0.998
      partv=partv+parta
      partx+=partv*noforce
      partcolor=pal.Int saturateAbove 255 (Norm partv)*50
      repeat partnum
      [   j=repcount
         if (abs partx.j.2) > 300
         [   partx.j=partx.j-partv.j
            partv.j.2=partv.j.2/(-1.5)
;            partbounces.j=partbounces.j+1
;            if partbounces.j==200
;            [   partx.j=Float (List -300 rnd*100 0)
;               partv.j=(List rnd/100 (rnd+1)/100 (rnd-0.5)/100)
;               partbounces.j=Int 0
;            ]
         ]
      ]
      clearScreen
      clearShadows
      setEye eye center upvector
      draw_plane
;      setPixel partx partcolor
;ignore [
      PenDown
      SurfaceStart
      i=1
      for [y 1 rnum]
      [   for [x 1 rnum]
         [   setPC partcolor.i
            setPosXYZ partx.i
            i=i+1
         ]
         SurfaceColumn
      ]
      SurfaceEnd
      SurfaceStart
      for [y 1 rnum]
      [   i=y
         for [x 1 rnum]
         [   setPC partcolor.i
            setPosXYZ partx.i
            i=i+rnum
         ]
         SurfaceColumn
      ]
      SurfaceEnd
      PenUp
;]
;      if Key? [break]
      castShadows
      updateGraph
      if video [VideoFrame]
      dispatchMessages
      GC
   ]
   if video [VideoEnd]
end

be draw_plane
   horizon=10000
   Home
   setY -300 down 90
   fd horizon  rt 90  fd horizon  rt 90
   setpc hsb 60 0.3 0.7
   pd
   PolyStart
      setTexXY   0 300 fd horizon*2  rt 90
      setTexXY 300 300 fd horizon*2  rt 90
      setTexXY 300   0 fd horizon*2  rt 90
      setTexXY   0   0 fd horizon*2  rt 90
   PolyEnd
end

to onCharHandler
   ch=KeyboardValue
   if ch==wxk_escape   [OnChar [] running=false]
   if ch==wxk_return   [onePoint=not onePoint]
   if ch==wxk_right [phi=phi+dphi]
   if ch==wxk_left  [phi=phi-dphi]
   if ch==wxk_up    [theta=theta+dtheta]
   if ch==wxk_down  [theta=theta-dtheta]
   if ch==wxk_prior [rotatescene_r=rotatescene_r/dr]
   if ch==wxk_next  [rotatescene_r=rotatescene_r*dr]
   eye.1=rotatescene_r*(cos theta)*sin phi
   eye.2=rotatescene_r* sin theta
   eye.3=rotatescene_r*(cos theta)*cos phi
   setLightPos {1000 1000 1000}
   setEye eye center upvector
   redraw
   updateGraph
end