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==0 ball::balls==0) [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

      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 2) rt 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 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
      (frBox size2)
      pu lt 135  fd size/sqrt 2 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=[0 -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