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 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.]
            ]
            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 2) rt 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 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]
      if not FileP f [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