aUCBLogo Demos and Tests / bitmaptest4

be bitmapTest4
   setUpdateGraph false
   WindowMode
   disableTexture
   setScreenColor 0
   pu   setXY -400 -300 pd
   buf=BitCopy 800 600
   Home
   zahlring
   disableLineSmooth
   pu   setXY -300 -300 pd
   zahlringbmp=BitCopy 600 600
   pu   setXY -400 -300 pd
   bkgr=BitCopy 800 600
   maxx=BitMaxX bkgr
   maxy=BitMaxY bkgr
   size=550
   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
   setPenSize 0
   Home
   n=1
   r=Array n
   v=Array n
   a=(list .0 -0.5)
   c=Array n
   s=Array n
   scirc=Array n
   s.1=BitCopy size size
   maxx2=BitMaxX s.1
   maxy2=BitMaxY s.1
   r0=List maxx/2-size/2 maxy/2-size/2
   r1=size*(1-1/2*sqrt 2)
   repeat n
   [   i=repcount
      r.i=(List random maxx-maxx2 random Int maxy-maxy2/1.05)
      v.i=List 8*(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 size/2
      ;run pick [fbox frbox circ]
      s.i=BitCopy size size
      BitMakeTransparent s.i RGB 0 0 0
      updateGraph
   ]
   maxx2=BitMaxX s.1
;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 > maxx-maxx2
         [   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
      BitPasteToScaled s.(1+mod k n) buf -maxx/8 0 5.5/6 5.5/6
      BitMakeTransparent s.(1+mod k n) RGB 0 0 0
      tmp=s.i
      tmp*=Float 0.8
      s.i=tmp
;      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 size
   pu rt 45  fd (sqrt 2)*size/2 pd
   rt ang
   fillRect [-1 -1]*size/2 [1 1]*size/2
   lt ang
   pu bk (sqrt 2)*100 lt 45 pd
end

be zahlring
   g=5*7
   r=300 ; Radius des Kreises
   setsc 0
   setPenSize [2 2]
   cs ht
   c=rgba 0 .8 1 .04
   setpc c
   xy=(array g 0)
   for [i 0 g-1]
   [   phi=360*i/g
      xy.i=(list sin phi cos phi)*r
   ]
   for [f 0 g-1]
   [   for [n 1 g-1]
      [   setPC HSBA n/g*360 .9 1 .6
         pu
         _setPos xy.f
         i=mod f*n g
         pd
         _setPos xy.i
      ]
      updategraph
   ]
   ;savebmp "zahlring.bmp   ;if refresh then save a hires bmp
end