aUCBLogo Demos and Tests / bounce3


be bounce3
   
norefresh
   
white=rgb 1 1 1
   
tracecolor=hsb 120 0 1
   
setsc white
   
cs ht
   
setUpdateGraph false
   
setDepthFunc 3
   
ball
   
stones
   
explosions
   
court
   
bat
   
soundinit
   
setDepthFunc 7
   
disableLighting
   
setz 0
   
_setPos ball::r
   
PU
   
WindowMode
   
forever
   
[   explosions::draw
      
ball::move
      
dispatchMessages
      
bat::move
      
updateGraph
      
gc
      
if key?
      
[   printmessage [You stopped.] 
         
stop
      
]
      
if ball::balls==0
      
[   printmessage [You've lost all balls.] 
         
stop
      
]
      
if and court::stonesNr==0  empty? explosions::exlist 
      
[   playWave soundinit::tada 1
         
printmessage [You win!!!] 
         
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/2
      
blue=rgb 0 0 .5
      
balls=3
      
      
perspective
      
cs
      
seteye {0 0 600}{0 0 0}{0 1 0}
      
setpc blue
      
pu rt 45  fd ballrad*sqrt pd
      
sphere ballrad-2
      
pu bk ballrad*sqrt 2  lt 45 pd
      
bmp=bitCopy 2*ballrad 2*ballrad
      
bitMakeTransparent bmp white
      
rockbricks=loadImage "rockbricks.jpg
      
balltex=Texture rockbricks
      
ballori=Orientation

      
be move
         
_setpos r
         
noball
         
r=r+v
         
ifelse or r.1 < -400+ballrad  r.1 400-ballrad
         
[   r=r-v
            
v.1=-v.1
            
playStartWav
         
]
         
[ifelse r.2 300-ballrad
         
[   r=r-v
            
v.2= -v.2
            
playStartWav
         
]
         
[ifelse r.2 < -300+ballrad
         
[   balls=balls-1
            
r=r-v
            
v.2=-v.2
            
if balls 0
            
[   (type [You've lost a ballYou haveballs [ball])
               
if balls [type [s]]
               
pr [left.]
            
]
            
playWave soundinit::chord 1
         
]
      
;   []]]
      ;comment
         
[reflect=false
         
repeat int girth
         
[   phi=repcount/girth*360
            
_setPos r+(list cos phi  sin phi)*ballrad
            
if and pixel != white pixel != tracecolor
            
[   if not reflect
               
[   reflect=true
                  
phistart=phi
                  
rpos=pos
                  
abspos=rpos+(list 400 -299-stones::size)
               
]
               
phiend=phi
            
]
         
]
         
if reflect
         
[   stonepos=rpos-(mod abspos stones::size)
            
if (stonepos.2) > -200
            
[   local [spos]
               
spos=round 
                  
((list 400 -299-stones::size)+stonepos)/stones::size+1
               
spos.2= -spos.2
      
;         pr spos
               
ifelse mdItem spos court::stone
               
[   mdSetItem spos court::stone false
                  
explosions::exlist=fput (list stonepos 1) 
                     
explosions::exlist
                  
court::stonesNr-=1
                  
playStartWav
               
][
               
;   reflect=false
               
]
            
]
            
if reflect
            
[   r=r-v
               
phi=(phiend+phistart)/2
               
n=(list cos phi sin phi)
               
p=n*(0+n*v)
               
o=v-p
               
v=o-p
            
]
         
]]]]
         
_setPos r
         
draw
      
end
      
      
be noball
         
setfc tracecolor
         
setz 0
         
fillellipse ballrad ballrad
      
end
      
      
be draw
         
setDepthFunc 3   
         
enableLighting
         
setPC white
         
enableTexture
         
local [ori nori]
         
ori=Orientation
         
setOrientation ballori
         
spinY   v.1
         
spinX -(v.2)
         
ballori=Orientation
         
sphere ballrad-4
         
setOrientation ori
         
disableTexture
         
setDepthFunc 7
         
disableLighting
      
end
   
end
   
   
be stones
      
cs
      
disableTexture
      
size=100
      
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
      
(3dfrBox size-10)
      
pu lt 135  fd size/(sqrt 2rt 135 pd
   
end
   
   
be explosions
      
Nr=200
      
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
      
(3dfrBox size2-6)
      
pu lt 135  fd size/sqrt rt 135 pd
   
end
   
   
be court
   
;   unperspective
      
cs
      
pu
      
size=stones::size
      
_setpos list -400 299-size
      
setheading 90
      
sx=int 800/size
      
sy=int 400/size
      
stonesNr=0
      
stone=mdArray list sx sy
      
local [x y]
      
repeat sy
      
[   y=repcount
         
repeat sx
         
[   x=repcount
            
b=stones::stone.(1+mod x stones::Nr)
            
bitPaste b
            
setItem y stone.true
            
stonesNr=stonesNr+1
            
fd size
         
]
         
bk sx*size
         
rt 90  fd size  lt 90
      
]
   
;   show stones
   
end
   
   
be bat
      
batpos=[-270]
      
red=rgb 1 0 0
      
setHeading 0

      
be nobat
         
setpc white
         
setfc white
         
seth 0
         
pd
         
Ellipsoid 50 10 50
      
;   fillellipse 80 25
         
pu
      
end
      
      
be draw
         
setpc red
         
setfc red
         
seth 0
         
pd
         
enableLighting
         
setDepthFunc 3
         
Ellipsoid 50 10 50
         
setDepthFunc 7
         
disableLighting
      
;   fillellipse 50 10
         
pu
      
end

      
be move
         
if batpos.1 != mousePos.1
         
[   _setpos batpos
      
;show mousePos
            
nobat
            
batpos.1=mousePos.1
            
_setpos batpos
            
draw
         
]
      
end
   
end
   
   
be loadWav f
      
local [size wav]
      
if not FileP [output []]
      
openReadBin f
      
setReader f
      
size=fileSize f
      
wav=readInt16ArrayBin size/2
      
setReader []
      
close f
   
;   (pr f "loaded)
      
output wav
   
end
   
   
be soundinit
      
start=[] ;loadWav "C:\Windows\Media\start.wav
      
chord=[] ;loadWav "C:\Windows\Media\chord.wav
      
tada=[] ;loadWav "C:\Windows\Media\tada.wav
   
end
   
   
be playStartWav
   
;   playWave soundinit::start 1
   
end
   
   
be printmessage txt
      
(pr "; txt)
      
repeat 100
      
[   home
         
setfc rgba 1 1 1 0.017
         
fillRect [-200 -50][200 50]
         
rt 90
         
setpc rgba 0 0 0 0.1
         
Label txt
         
updateGraph
      
]
   
end
end