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 sety -200-pensize_
   
pd rt 90 fd 1000 pu home pd
   
OnMouseLeftDown [trails=true]
   
OnMouseRightDown 
   
[   cs ht pu setpc [50 230 20] 
      
setx 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-rnum
         
0
         
dopt*rnum/2-dopt*(mod j-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+11 1 1
      
noforce.j=Int 1
   
]
;   noforce1_=Array noforce1
;   noforce10=Array noforce1
;   noforce11=Array noforce1
;   noforce20=Array noforce1
   
for [[partnum-rnum+1partnum]
   
[   parta.i=(List 0.0 -0.05 0.0)
   
]
   
for [rnum]
   
[   noforce.i=Int 0
      
noforce.(i*rnum)=Int 0
   
]
   
for [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 [fn]
   
[   force.i=
         
saturateBelow -1 
         
saturateAbove 1
         
fac*( 1*((i/dopf)^(-8))-2*(i/dopf)^(-4))
   
]
   
for [0 3]
   
[   force.i=0
   
]
   
pd setpc 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*;*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*;*noforce10
   
      
dx=(partx-rotate partx rnum+1)
      
f=force.Int (saturateAbove fn (Norm dx)*ffein)
      
a=a+dx*;*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*;*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*;*noforce10
   
      
dx=(partx-rotate partx -rnum-1)
      
f=force.Int (saturateAbove fn (Norm dx)*ffein)
      
a=a+dx*;*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 [rnum]
      
[   for [rnum]
         
[   setPC partcolor.i
            
setPosXYZ partx.i
            
i=i+1
         
]
         
SurfaceColumn
      
]
      
SurfaceEnd
      
SurfaceStart
      
for [rnum]
      
[   i=y
         
for [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_rsin theta
   
eye.3=rotatescene_r*(cos theta)*cos phi
   
setLightPos {1000 1000 1000}
   
setEye eye center upvector
   
redraw
   
updateGraph
end