aUCBLogo Demos and Tests / bounce2


be bounce2
   
norefresh
   
white=rgb 1 1 1
   
setsc white
   
cs ht
;   setUpdateGraph false
   
ball
   
stones
   
explosions
   
court
   
bat
   
_setPos ball::r
   
forever
   
[   explosions::draw
      
ball::move
      
dispatchMessages
      
bat::move
      
updateGraph
      
gc
      
if (or key? court::stonesNr==ball::balls==0) [stop]
   
]

   
be ball
      
r=(list -200)
      
phi=180.0*rnd
      
velocity=5*2200/mips   ;so the speed should be machine-independent
      
v=(list  velocity*cos phi  velocity*sin phi)
      
ballrad=25
      
girth=ballrad
      
blue=rgb 0 0 .5
      
balls=3
   
      
be move
         
_setpos r
         
noball
         
r=r+v
         
if or r.1 < -400+ballrad r.1 400-ballrad
         
[   v.1=-v.1
            
r.1=r.1+v.1
         
]
         
if r.2 300-ballrad
         
[   v.2= -v.2
            
r.2=r.2+v.2
         
]
         
if r.2 < -300+ballrad
         
[   balls=balls-1
            
v.2= -v.2
            
r.2=r.2+v.2
            
playWave "C:\Windows\Media\ding.wav 1
         
]
         
reflect=false
         
repeat int girth
         
[   phi=repcount/girth*360
            
_setPos r+(list cos phi  sin phi)*ballrad
            
if pixel != white
            
[   if not reflect
               
[   reflect=true
                  
phistart=phi
                  
rpos=pos
                  
abspos=rpos+(list 400 -299-stones::size)
               
]
               
phiend=phi
            
]
         
]
         
if reflect
         
[   phi=(phiend+phistart)/2
            
n=(list cos phi sin phi)
            
p=n*(0+n*v)
            
o=v-p
            
v=o-p
            
stonepos=rpos-(mod abspos stones::size)
            
if (stonepos.2) > -200
            
[
               
explosions::exlist=fput (list stonepos 1) 
                  
explosions::exlist
               
court::stonesNr-=1
            
]
         
]
         
_setPos r
         
draw
      
end
      
      
be circ size
         
pd
         
fillellipse size size
         
pu
      
end
      
      
be noball
         
setpc white
         
setfc white
         
circ ballrad
      
end
      
      
be draw
         
setpc blue
         
setfc blue
         
circ ballrad
      
end
   
end
   
   
be stones
      
cs
      
size=50
      
Nr=8
      
stone=Array Nr
      
repeat Nr
      
[   hue=360*repcount/Nr
         
setpc hsb hue 1 1
         
setfc hsb hue 1 1
         
myfrbox size
         
stone.repcount=bitCopy size size
      
]
      
setpc white
      
setfc white
      
myfrbox size
      
nostone=bitCopy size size
   
end
   
   
be myfrbox size
      
pu rt 45  fd size/(sqrt 2)  lt 45 pd
      
(frBox size)
      
pu lt 135  fd size/(sqrt 2rt 135 pd
   
end
   
   
be explosions
      
Nr=50
      
size=stones::size
      
bmp=Array Nr
      
exlist=[]
      
red=rgb 1 0 0
      
repeat Nr-1
      
[   cs
         
setpc red
         
setfc red
         
smallfrbox size size*(1-repcount/(Nr+1))
         
bmp.repcount=bitCopy size size
      
]
      
cs
      
bmp.Nr=bitCopy size size

      
be draw
         
keep=[]
         
foreach exlist
         
[   _setpos first ?
            
n=last ?
            
bitPaste bmp.n
            
if Nr
            
[   setItem ? n+1
               
keep=fput ? keep
            
]
         
]
         
exlist=keep
      
end
   
end
   
   
be smallfrbox size size2
      
pu rt 45  fd size/sqrt 2  lt 45 pd
      
(frBox size2)
      
pu lt 135  fd size/sqrt rt 135 pd
   
end
   
   
be court
      
cs
      
pu
      
size=stones::size
      
_setpos list -400 299-size
      
setheading 90
      
sx=int 800/size
      
sy=int 400/size
      
stonesNr=0
      
repeat sy
      
[   repeat sx
         
[   b=stones::stone.(1+mod repcount stones::Nr)
            
bitPaste b   ;stone.(1+mod repcount differentStones)
            
stonesNr=stonesNr+1
            
fd size
         
]
         
bk sx*size
         
rt 90  fd size  lt 90
      
]
   
end
   
   
be bat
      
batpos=[-270]
      
red=rgb 1 0 0
      
setHeading 0

      
be nobat
         
setpc white
         
setfc white
         
pd
         
fillellipse 50 10
         
pu
      
end
      
      
be draw
         
setpc red
         
setfc red
         
pd
         
fillellipse 50 10
         
pu
      
end
      
      
be move
         
if batpos != mousePos
         
[   _setpos batpos
            
nobat
            
batpos.1=mousePos.1
            
_setpos batpos
            
draw
         
]
      
end
   
end
end