aUCBLogo Demos and Tests / bounce5
be bounce5
; norefresh
white=RGB 1 1 1
setSC white
cS hT
setUpdateGraph false
setDepthFunc 3
stones
ball
explosions
court
bat
soundinit
setDepthFunc 7
disableLighting
setZ 0
_setPos ball::r
PU
WindowMode
forever
[ cS
court::draw
bat::move
ball::move
explosions::draw
dispatchMessages
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
blue=RGB 0 0 .5
balls=3
perspective
cS
setEye {0 0 600}{0 0 0}{0 1 0}
rockbricks=loadImage "rockbricks.jpg
balltex=Texture rockbricks
ballori=Orientation
be move
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 Pixel == white
[ break
]
]
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
[ stonepos=rpos-(Mod abspos stones::size)
nr=1
if stonepos.2 > -200
[ local [spos]
spos=round ((List 400 -299-stones::size)+stonepos)/stones::size+1
spos.2= -spos.2
; pr spos
nr=mdItem spos court::stone
ifElse nr > 0
[ mdSetItem spos court::stone 0
explosions::exlist=fPut (List stonepos+stones::size/2 1)
explosions::exlist
court::stonesNr-=1
][
; reflect=false
nr=1
]
]
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
playWaveFast soundinit::stone.nr
]
]]]]
_setPos r
draw
end
be draw
setDepthFunc 3
enableLighting
enableTexture
setPC white
Texture balltex
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
perspective
setEye {0 0 600}{0 0 0}{0 1 0}
cS
disableTexture
size=100
Nr=8
if Name? "stones::stone [stop]
stone=Array Nr
repeat Nr
[ hue=360*repCount/Nr
setPC HSB hue 1 1
setFC HSB hue 1 1
cs
myfrbox size*2.2
local [s]
s=-size*3/2
pu setXYZ s s s
stone.repCount=Texture BitCopy size*3 size*3
cs
setFC white
disableLighting
fillRect [0 0] list size size
stone.repCount=Texture BitCopy size size
disableTexture
enableLighting
updateGraph
]
end
be myfrbox size
; PU rt 45 fd size/(Sqrt 2) lt 45 PD
(3dfrBox size-3)
; PU lt 135 fd size/(Sqrt 2) rt 135 PD
end
be explosions
Nr=200
size=stones::size
expos=3*size/2
expos1=List -expos -expos
expos2=List expos expos
if Name? "explosions::bmp [stop]
bmp=Array Nr
exlist=[]
enableLighting
if Directory? "explosion
[ loadExplosions
stop
]
local [gau f ex mx my x y c r g b a]
gau=(Gauge [] [Generating Explosions...] Nr 0 wxGA_SMOOTH)
makeDirectory "explosion
changeDir "explosion
hT
disableDepthTest
disableTexture
t0=1
t=t0
t1=40
f=7
radius=size/f
maxlevel=4
until [or t> Nr Key?]
[ cS
(reRandom 0)
disTex
explode radius*(1-exp -t/t1) 0.5*exp -t/t1 maxlevel
updateGraph
setXYZ -f/2*radius -f/2*radius 0
ex=BitCopy size size
; BitMakeTransparent ex "white
mx=BitMaxX ex
my=BitMaxY ex
for [x 0 mx]
[ for [y 0 my]
[ c=reRGBA BitPixel ex x y
r=c.1 g=c.2 b=c.3 a=1-Sqr r
BitSetPixel ex x y RGBA r g b a
]
]
saveImage ex (word "explosion t ".png)
bmp.t=Texture ex
Home
GaugeSetValue gau t
t=t+1
]
GaugeDestroy gau
(GC true)
enableDepthTest
setPC white
changeDir "..
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 loadExplosions
changeDir "explosion
local [gau ex mx my x y c r g b a]
gau=(Gauge [] [Loading Explosions...] Nr 0 wxGA_SMOOTH)
dispatchMessages
Nr=Nr-10 ;seems be work better than without this
repeat Nr
[ ex=loadImage (word "explosion repcount+1 ".png)
bmp.repcount=Texture ex
GaugeSetValue gau repCount
if Key? [break]
]
GaugeDestroy gau
(GC true)
enableDepthTest
setPC white
changeDir "..
end
be draw
keep=[]
setFC white
disableDepthTest
foreach exlist
[ _setPos first ?
n=last ?
Texture bmp.n
enableTexture
setHeading 0
setFC white
fillRect expos1 expos2
if n < Nr
[ setItem 2 ? n+1
keep=fPut ? keep
]
]
exlist=keep
enableDepthTest
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
setFC white
disableLighting
sx=Int 800/size
sy=Int 400/size
stonesNr=Int 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)
Texture b
setHeading 0
fillRect [0 0](List size size)
setHeading 90
setItem y stone.x x
stonesNr=stonesNr+1
fd size
]
bk sx*size
rt 90 fd size lt 90
]
; show stones
be draw
PU
_setPos List -400 299-size
setFC white
disableLighting
enableTexture
setHeading 90
local [x y]
repeat sy
[ y=repCount
repeat sx
[ x=repCount
if (stone.x).y > 0
[ b=stones::stone.(1+Mod x stones::Nr)
Texture b
setHeading 0
fillRect [0 0](List size size)
setHeading 90
]
fd size
]
bk sx*size
rt 90 fd size lt 90
]
end
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
disableTexture
setDepthFunc 3
Ellipsoid 50 10 50
setDepthFunc 7
disableLighting
; fillellipse 50 10
PU
end
be move
; show mousePos
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
if Name? "soundinit::click [stop]
click=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!)
]
ding =loadwav Word prefix "Media\ding.wav
chord=loadWav Word prefix "Media\chord.wav
tada=loadWav Word prefix "Media\tada.wav
cmajor=[0 2 4 5 7 9 11 12]
stone=Array stones::Nr
repeat stones::Nr
[ i=repcount
stone.i=resizeWav click 2^((12-cmajor.i)/12)
]
end
be resizeWav wav factor
local "w
w=Int16Array 44+round ((count wav)-44)*factor
setItems 1 w Items 1 44 wav
setItems 45 w resize
(Items 45 count wav wav) (count w)-44
output w
end
be playstartwav
playWaveFast soundinit::click
end
be printmessage txt
(pr "; txt)
repeat 100
[ Home
setFC RGBA 1 1 0 0.03
Texture explosions::bmp.(1+round explosions::Nr*repCount/130)
enableTexture
fillRect [-270 -50][270 50]
rt 90
setPC RGBA 0 0 1 0.3
setLabelSize [30 30]
disableTexture
Label txt
updateGraph
]
end
end