aUCBLogo Demos and Tests / bitmaptest3

to bitmaptest3
   setUpdateGraph false
   WindowMode
   disableTexture
   setPenSize [2 2]
   setScreenColor 0
   pu   setXY -400 -300 pd
   buf=BitCopy 800 600
   Home
   zahlring
   pu   setXY -300 -300 pd
   zahlringbmp=BitCopy 600 600
   pu   setXY -400 -300 pd
   bkgr=BitCopy 800 600
   alphamask=255*256^3
   mx=BitMaxX bkgr
   my=BitMaxY bkgr
;ignore [
   for [y 0 my]
   [   for [x 0 mx]
      [   BitSetPixel zahlringbmp x y
            BitOr (BitPixel zahlringbmp x y) alphamask
      ]
   ]
;]
   zahlrintex=Texture zahlringbmp
   setPS [0 0]
   Home
   n=20
   r=Array n
   v=Array n
   a=(list .0 -1.)
   c=Array n
   s=Array n
   scirc=Array n
   repeat n
   [   i=repcount
      r.i=List 600*rnd 400*rnd
      v.i=List 10*(rnd-0.5) 0.0
      c.i=HSB 360*i/n 1 1
      hideTurtle
      clearScreen
      setPC c.i
      setFC c.i
      ;setPC RGB 1 1 1
      ;setFC RGB 1 1 1
      texcirc 360*i/n
      ;run pick [fbox frbox circ]
      s.i=BitCopy 201 201
      BitMakeTransparent s.i RGB 0 0 0
      updateGraph
   ]
;pause
   pu   setXY -400 -300 pd
   noRefresh
   k=0
   forever
   [   v=v+a
      r=r+v
      BitPasteTo buf bkgr 0 0
      repeat n
      [   i=repcount
         if r.i.2 < 0
         [   v.i.2=-v.i.2
            r.i.2=r.i.2+v.i.2
         ]
         if r.i.1 < 0 or2 r.i.1 > 600
         [   v.i.1=-v.i.1
            r.i.1=r.i.1+v.i.1
         ]
         BitPasteTo buf s.(1+mod i+k n) r.i.1 r.i.2
      ]
      k=k+1
      BitPasteFast buf
;      updateGraph
      GC
      if key? [break]
   ]
   refresh
end

to circ
   pu rt 45  fd (sqrt 2)*100 pd
   fillCircle 100
   pu bk (sqrt 2)*100 lt 45 pd
end

to fbox
   fillRect [0 0][200 200]
end

to frbox
   pu rt 45  fd (sqrt 2)*100  lt 45 pd
   rBox
   fill
   pu lt 135  fd (sqrt 2)*100  lt 135 pd
end

to texcirc ang
   pu rt 45  fd (sqrt 2)*100 pd
   rt ang
   fillRect [-100 -100][100 100]
   lt ang
   pu bk (sqrt 2)*100 lt 45 pd
end