aUCBLogo Demos and Tests / usaflags

;HI LOGO FANS!!!!!!!

;Here is a set of procedures to the my USA friends
;(a very advanced 4 of July gift):

;Juan J. Paredes G.
;(modified for aUCBLogo-4.7 by Andreas Micheler, Augsburg, Nov 2006)

to bluecorner sx sy
   setfc blue
   fillRect (list 0 sy) (list sx/2 sy*6/13)
end

to border sx sy
   setpc black
   pd
   repeat 2
   [   fd sy rt 90
      fd sx rt 90
   ]
   pu
end

to star sides size
   sides=int sides
   centralpoint=pos
   lt 360/sides/2
   fd size/3
   ipos=pos
   TessStart
   bk size/3
   rt 360/sides/2

   repeat sides
   [   fd size
      epos=pos
      pu setpos ipos
      pd setpos epos pu
      bk size
      rt 360/sides/2
      fd size/3
      ipos=pos
      pu setpos epos
      pd setpos ipos pu
      bk size/3
      rt 360/sides/2
   ]
   TessEnd
   pu setpos centralpoint
end

to stars x y
   oldpos=Pos
   fd y*6/13
   y=y*7/13
   x=x/2
   setpc white
   for [ix 1 6]
   [   rt 90 fd x/13 lt 90 fd y/10
      for [iy 1 5]
      [   star 5 x/20
         fd y/5
      ]
      bk y*(1+1/10)
      rt 90 fd x/13 lt 90 fd y/5
      for [iy 1 4]
      [   star 5 x/20
         fd y/5
      ]
      bk y
   ]
   setPos oldpos
end

to stripes sx sy
   oldpos=pos
   n=13
   repeat n
   [   setfc ifelse (mod # 2)==1 [red][white]
      fillRect [0 0] (list sx sy/n)
      fd sy/n
   ]
   setPos oldpos
end

to setColors
   ::red=RGB 1 0 0
   ::blue=RGB 0 0 1
   ::darkblue=RGB 0 0 .5
   ::white=RGB 1 1 1
   ::black=RGB 0 0 0
end

to USAFLAG size
   setColors
   stripes size size*3/4
   bluecorner size size*3/4
   stars size size*3/4
   border size size*3/4
   updateGraph
end

to USAFLAGS
;   norefresh   ;comment if you want to savebmp-it!
   size=random 400
   pu   setpos (list -400+random 800 -300+random 600)
   WindowMode ht
   seth random 360
   setColors
   stripes size size*3/4
   bluecorner size size*3/4
   stars size size*3/4
   border size size*3/4
   updateGraph
   if key? [stop]
   usaflags
end