Generating realistic 'Flowers'.
Spring in the Northern Hemisphere is a lovely time.
I just happened to notice, for the first time in 70 years, that wood anemones don't always have the same number of petals- usually 6 or 7, but sometimes 5 or 8. I'm a bit obsessive/compulsive at times....
I thought it'd be fun to make some programmatic flowers. I started by writing a routine to draw ellipses, fill them and display them rotated and centred wherever I wished. This is easier than using the turtle 'ellipse' option, and I had no great need for speed. At this point I got a bit carried away, and lots of nice patterns resulted.
Now I got back on track and created the petal arrangement.
Lots more things to play with- spiralling petals of increasing size for instance.
LB makes this kind of flight-of-fancy very easy.
= 
' **************************************************************************
' *** **
' *** filledShapesNonTurtle4c 5 Jun 2016 tenochtitlanuk **
' *** **
' **************************************************************************
' Demonstrates turtle drawn directly, avoiding LB's turtle errors and giving
' direct access to turtle's position/heading, saved in global TX, TY, Ttheta.
' Also demonstrates colour-filling. Shape outlines are drawn in a colour
' differing by +1 in RGB components. 1 in 2^24 chance it's already in use!
' The first argument for ExtFloodFill is the handle for the graphicbox device contest.
' The x and y location to begin the fill are the next arguments.
' These coordinates are counted from the upper left corner of the graphics area.
' The arguments for color and fill type are next.
' With _FLOODFILLBORDER ( =0) type of fill, the fill area is bounded by the color specified by the crColor parameter.
' With _FLOODFILLSURFACE ( =1) type of fill, the fill area is defined by the color that is specified by crColor.
' Filling continues outward in all directions as long as the color is encountered.
' NB Fills from a centre within shape, which must be therefore on-screen.
nomainwin
global pi, TX, TY, Ttheta, wFillType, hdc
TX =400: TY =350: Ttheta =0 ' screen centre, pointing North/up.
pi =4 *atn( 1)
' n step turn ..........
shape$ ="4, 0.5, 150, 1, 120, 1, 120, 1, -60" ' equilateral triangle, apex up.
'add an 'R' flag if figure is a loop of identical step/turns??
WindowWidth =750: WindowHeight =740 ' width 1150 if enable the textwindow for diagnostics
graphicbox #w.gb, 10, 10, 804, 704
'texteditor #w.te, 820, 10, 320, 700
menu #w, "File", "Save", [save]
open "Demo. of Filled Shapes & improved Turtle." for window as #w
#w "trapclose quit"
#w.gb "down ; fill 80 80 80 ; color cyan"
'#w.te "!font courier 16"
h = hwnd( #w.gb)
calldll #user32, "GetDC", h as ulong, hdc as ulong
wFillType =0
'call graticule
#w.gb "flush ; up ; size 1"
'#w.te " Now at " +using( "####", TX) +using( "####", TY) +" & facing " + using( "####.#", Ttheta)
ra =300
for angle =0 to 360 *8 step 27
ra =200 -angle /360 /10 *150
x =400 +int( ra *cosRad( angle))
y =350 +int( ra *sinRad( angle))
w = 40 ' int( ( 4 *360 -angle) /360 /4 *40)
h =int( ( 10 *360 -angle) /360 /10 *160)
call ellipse x, y, w, h, angle, int( 254 -angle /50), int( 254 -angle /50), 0
'call delay 1000
next angle
wait
'#w.te " Now at "+ using( "####", TX) +using( "####", TY) +" & facing " + using( "####.#", Ttheta)
#w.gb "flush"
wait
function MakeRGB( red, green, blue)
if red < 0 then red = 0
if red >255 then red =255
if green < 0 then green = 0
if green >255 then green =255
if blue < 0 then blue = 0
if blue >255 then blue =255
MakeRGB =( blue *256 *256) +( green *256) +red
end function
function sinRad( a)
sinRad =sin( a *pi /180)
end function
function cosRad( a)
cosRad =cos( a *pi /180)
end function
sub draw lifted, x, y
if lifted =0 then #w.gb "up" else #w.gb "down"
#w.gb "line "; TX; " "; TY; " "; x; " "; y
Ttheta =atan2( x -TX, TY -y) *180 /pi ' NB DEGREES.
TX =x
TY =y
end sub
sub turn angle ' increment/update global turtle direction ( in DEGREES)
Ttheta =( Ttheta +angle) mod 360
end sub
sub forward s
dx =s *cosRad( Ttheta)
dy =s *sinRad( Ttheta)
#w.gb "down ; line "; TX; " "; TY; " "; TX +dx; " "; TY +dy; " ; up"
TX =TX +dx
TY =TY +dy
end sub
function atan2( x, y)
Result$ = "Undetermined"
If ( x = 0) and ( y > 0) Then atan2 = pi / 2: Result$ = "Determined"
If ( x = 0) and ( y < 0) Then atan2 = 3 * pi / 2: Result$ = "Determined"
If ( x > 0) and ( y = 0) Then atan2 = 0: Result$ = "Determined"
If ( x < 0) and ( y = 0) Then atan2 = pi: Result$ = "Determined"
If Result$ = "Determined" Then [End.of.function]
BaseAngle = Atn( abs( y) /abs( x))
If (x > 0) and (y > 0) Then atan2 = BaseAngle
If (x < 0) and (y > 0) Then atan2 = pi -BaseAngle
If (x < 0) and (y < 0) Then atan2 = pi +BaseAngle
If (x > 0) and (y < 0) Then atan2 = 2*pi -BaseAngle
[End.of.function]
end function
sub graticule
for x =0 to 800 step 100 ' draw vertical graticule lines
#w.gb "line "; x; " "; 0; " "; x; " "; 700
next x
for y =0 to 700 step 100
#w.gb "line "; 0; " "; y; " "; 800; " "; y
next y
end sub
[save]
#w.gb "getbmp scr 0 0 800 700"
filedialog "Save as ", "*.bmp", fn$
bmpsave "scr", fn$
wait
sub quit h$
close #h$
calldll #user32, "ReleaseDC", hw as ulong, hdc as ulong 'release the DC
end
end sub
' _________________________________________
sub ellipse x, y, Major, Minor, inclination, R, G, B
crColor =MakeRGB( R, G, B)
xx =Minor *cosRad( 0)
yy =Major *sinRad( 0)
xs =x +xx *cosRad( inclination) -yy *sinRad( inclination)
ys =y +xx *sinRad( inclination) +yy *cosRad( inclination)
#w.gb "goto "; xs; " "; ys
#w.gb "down"
#w.gb "color "; R; " "; G; " "; B ' targetcolour R G B
#w.gb "backcolor "; R +1; " "; G +1; " "; B +1 ' visibly same, but distinguished by ExtFloodFill as boundary. -fillcolour R+1 G+1 B+1
for angle =0 to 370 step 10
xx =Minor *cosRad( angle)
yy =Major *sinRad( angle)
xs =x +xx *cosRad( inclination) -yy *sinRad( inclination)
ys =y +xx *sinRad( inclination) +yy *cosRad( inclination)
#w.gb "goto "; xs; " "; ys
next angle
#w.gb "color red ; size 5 ; set "; x; " "; y; " ; size 1"
'call delay 1000
'goto [noFill]
calldll #gdi32, "ExtFloodFill",_
hdc As uLong,_ 'device context
x As Long,_ 'x location to start filling
y As Long,_ 'y location to start filling
crColor As Long,_ 'long colour value of border, or colour to replace
wFillType As Long,_ 'flag for type of fill
result As Long 'nonzero if successful
[noFill]
#w.gb "up"
end sub
'1 2 3 4 5 6 7 ..
sub display shape$, scale, col$, x, y, angle ' shape$ ="4, 0.5,150, 1,120, 1,120, 1,120, 1, 150"
noOfTerms =val( word$( shape$, 1, ","))
#w.gb "color "; col$
#w.gb "north"
#w.gb "up ; goto "; x ; " "; y
#w.gb "turn "; angle
vStep =val( word$( shape$, 2, ",")) *scale
#w.gb "go "; vStep: print "up ; go "; vStep
vAngle =val( word$( shape$, 3, ","))
#w.gb "turn "; vAngle: print "turn "; vAngle
#w.gb "down": print "down"
for i =1 to noOfTerms +1
vStep =val( word$( shape$, 2 *i +2, ",")) *scale
vAngle =val( word$( shape$, 2 *i +3, ","))
#w.gb "go "; vStep
#w.gb "turn "; vAngle
print "go "; vStep; " ; turn "; vAngle
next i
call delay 1000
end sub
sub delay t
timer t, [cont]
wait
[cont]
timer 0
end sub
' from here is spare, now redundant code
'side =20
'for i =1 to 10
'R =int( 255 *rnd( 1)): G =int( 255 *rnd( 1)): B =int( 255 *rnd( 1))' RGB never =255...
'crColor =MakeRGB( R, G, B)
'x =400: y =350
'#w.gb "color "; R; " "; G; " "; B ' targetcolour R G B
'call delay 1000
call display shape$, 400 -30 *i, str$( R) +" " +str$( G) +" " +str$( B), x, y, i *3 ' here, a single call.
'rMa =int( 10 +100 *rnd( 1)): rMi =int( 10 +100 *rnd( 1)): inclination =int( 0 + 90 *rnd( 1))
'call ellipse x, y, rMa, rMi, inclination
'#w.gb "backcolor "; R +1; " "; G +1; " "; B +1 ' visibly same, but distinguished by ExtFloodFill as boundary. -fillcolour R+1 G+1 B+1
'call delay 1000
'calldll #gdi32, "ExtFloodFill",_
'hdc As uLong,_ 'device context
'x As Long,_ 'x location to start filling
'y As Long,_ 'y location to start filling
'crColor As Long,_ 'long colour value of border, or colour to replace
'wFillType As Long,_ 'flag for type of fill
'result As Long 'nonzero if successful
'next i