aUCBLogo Demos and Tests / bounce4
be bounce4
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
[ playWaveFast soundinit::tada
printmessage [You win!!!]
stop
]
]
be ball
r=(list 0 -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 2 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 ball. You have\ ] balls [\ ball])
if balls > 1 [type [s]]
pr [\ left.]
]
playWaveFast soundinit::chord
]
; []]]
;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-6)
pu lt 135 fd size/(sqrt 2) rt 135 pd
end
be explosions
if name? "explosions::bmp [stop]
Nr=50
size=stones::size
bmp=Array Nr
exlist=[]
disableDepthTest
ht
t0=1
t=t0
t1=10
local [f]
f=7
radius=size/f
maxlevel=4
until [or t> Nr-1 Key?]
[ cs
(reRandom 0)
explode radius*(1-exp -t/t1) exp -t/t1 maxlevel
updateGraph
setXYZ -f/2*radius -f/2*radius 0
bmp.t=BitCopy f*radius f*radius
BitMakeTransparent bmp.t "white
home
t=t+1
]
cs
bmp.Nr=bitCopy size size
tend=t
(GC true)
enableDepthTest
setPC white
be explode r a level
setPC hsba 0 1-(norm PosXYZ)/(4*radius) 0.7 a
sphere r
local [ori p r2 i]
ori=Orientation
p=PosXYZ
if level > 1
[ for [i 1 12]
[ rightRoll 360*rnd
up 180*rnd
r2=r*(1-0.1*rnd)
pu
fd r2
if r > 0
[ explode r2*(1-exp -t/t1*r2/r) a*sqr r2/r level-1
]
setPosXYZ p
setOrientation ori
]
]
end
be draw
keep=[]
foreach exlist
[ _setpos first ?
n=last ?
bitPaste bmp.n
if n < Nr
[ setItem 2 ? 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 2 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.x true
stonesNr=stonesNr+1
fd size
]
bk sx*size
rt 90 fd size lt 90
]
; show stones
end
be bat
batpos=[0 -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]
openReadBin f
setReader f
size=fileSize f
wav=readInt16ArrayBin size/2
setReader []
close f
; (pr f "loaded)
output wav
end
be soundinit
start=loadWav "start.wav
prefix=getEnv "comspec
rest=Items 4 count prefix prefix
prefix=Items 1 3 prefix
repeat count rest
[ i=repcount
if rest.i=="\
[ prefix=Word prefix Items 1 i rest
break
]
]
if not Directory? prefix
[ (throw "Error "I can't find the sound files!)
]
chord=loadWav Word prefix "Media\chord.wav
tada=loadWav Word prefix "Media\tada.wav
; start=tada
end
be playStartWav
playWaveFast soundinit::start
end
be printmessage txt
(pr "; txt)
repeat 100
[ home
setfc rgba 1 1 0 0.017
fillRect [-270 -50][270 50]
rt 90
setpc rgba 0 0 1 0.5
setLabelSize [30 30]
Label txt
updateGraph
]
end
end