Author 
Topic: Star Maker (Read 922 times) 

bplus
Senior Member
member is offline
Gender:
Posts: 1255


Star Maker
« Thread started on: May 29^{th}, 2016, 09:06am » 

Finally a decent filled star!
Now a Star anywhere, any number of points, fat or skinny or anything in between and at any angle offset.
Code:'Star Maker demo.txt for Just Basic v1.01 [B+=MGA] 20160529
global H$, XMAX, YMAX, PI, DEG, RAD
H$ = "gr"
XMAX = 700 '<=== actual drawing space needed
YMAX = 700 '<=== actual drawing space needed
PI = acs(1)
RAD = PI / 180
DEG = 180 / PI
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 250
UpperLeftY = 1
open "Star Maker demo ...press any to quit" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
'============================== main code
cx = XMAX/2 : cy = YMAX/2
for i = 0 to 360 step 10
#gr "fill black"
call ink 200, 200, 255
call star cx, cy, 10, 350, 3, 3 * i, 1
call ink 225, 10, 255
call star cx, cy, 10, 275, 4, 2 * i, 1
call ink 255, 255, 255
call star cx, cy, 10, 100, 12, i, 1
call pause 1000
next
'============================== sets drawing
#gr "flush"
wait
'JB Library of procedures ======================================================
'notes: arrays are global limited in dimensions, no constants, no imports, no declares...
'must "call" subs no ()! not even in definitions and must use () for parameterless functions
sub star x, y, rInner, rOuter, nPoints, angleOffset, TFfill
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
' TFfill filled True or False (1 or 0)
pAngle = RAD * (360 / nPoints) : radAngleOffset = RAD * angleOffset
x1 = x + rInner * cos(radAngleOffset)
y1 = y + rInner * sin(radAngleOffset)
for i = 0 to nPoints  1
x2 = x + rOuter * cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * sin((i + 1) * pAngle + radAngleOffset)
if TFfill then
call filltri x1, y1, x2, y2, x3, y3
else
call aline x1, y1, x2, y2
call aline x2, y2, x3, y3
end if
x1 = x3 : y1 = y3
next
if TFfill then call fcirc x, y, rInner
end sub
sub ink r,g,b
#gr "color ";r;" ";g;" ";b
#gr "backcolor ";r;" ";g;" ";b
end sub
sub aline x0,y0,x1,y1
#gr "line ";x0;" ";y0;" ";x1;" ";y1
end sub
sub fcirc x, y, radius
#gr "place ";x;" ";y;"; circlefilled ";radius
end sub
'Fast Filled Triangle Sub by AndyAmaya
Sub filltri x1, y1, x2, y2, x3, y3
'triangle coordinates must be ordered: where x1 < x2 < x3
If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
'swap x1, y1, with x3, y3
If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
'swap x2, y2 with x3, y3
If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
If x1 <> x3 Then slope1 = (y3  y1) /(x3  x1)
'draw the first half of the triangle
length = x2  x1
If length <> 0 Then
slope2 = (y2  y1)/(x2  x1)
For x = 0 To length
scan
#gr "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1)
Next
End If
'draw the second half of the triangle
y = length * slope1 + y1 : length = x3  x2
If length <> 0 Then
slope3 = (y3  y2) /(x3  x2)
For x = 0 To length
scan
#gr "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2)
Next
End If
call aline x1, y1, x2, y2
call aline x2, y2, x1, y1
call aline x2, y2, x3, y3
call aline x3, y3, x2, y2
call aline x1, y1, x3, y3
call aline x3, y3, x1, y1
End Sub
sub lButtonUp H$, mx, my 'must have handle and mouse x,y
call quit H$ '<=== H$ global window handle
end sub
sub charIn H$, c$ '<=== must have handle and get keypress$
call quit H$ '<=== H$ global window handle
end sub
'Need line: #gr "trapclose quit"
sub quit H$
close #H$ '<=== this needs Global H$ = #gr
end 'Thanks Facundo, close graphic wo error
end sub
' Thanks Richard, this one saves battery
sub pause mil
timer mil, [timesup]
wait
[timesup]
timer 0
end sub


Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1255


Re: Star Maker
« Reply #1 on: May 29^{th}, 2016, 2:00pm » 

For those who honor and are remembered on Memorial Day.
Code:'For Memorial Day.txt for Just Basic v1.01 [B+=MGA] 20160529
' notes: American Flag close to proportion standards
'
' verticals:
' Hoist Flag = 1.0 vertical height use 650 pixels because divided by 13 = 50 each stripe
'Hoist Union = 7/13 = 350
' stripe = 1/13 = 50
' star space = .054 = 350/(10 spaces) = 35 pixels 35/650 ~ .5385
'
' horizontals:
' Fly Flag length = 1.9 = 650 * 1.9 = 1235
' Fly Union length = .76 = 650 * .76 = 494
' star space = .063 494/(12 spaces) ~ 41.167 using 41 * 12 = 492 add 1 pixel before and after stars
'star outer diameter = .0616 * 650 ~ 40 (40.04) so outer radius is 20 and inner (20 / 2.5) = 8
global H$, XMAX, YMAX, PI, DEG, RAD
H$ = "gr"
XMAX = 1235 '<=== actual drawing space needed
YMAX = 650 '<=== actual drawing space needed
PI = acs(1)
DEG = 180 / PI
RAD = PI / 180
nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 31
UpperLeftX = 50
UpperLeftY = 1
open "Memorial Day Flag ...press any to quit" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
'============================== main code
call ink 179, 34, 52 'RGB Old Glory Red wiki rgb .698, .132, .203
call fbox 0, 0, XMAX, YMAX
call ink 255, 255, 255 'RGB white stripes over red background
for row = 1 to 12 step 2
call fbox 0, row * 50, XMAX, (row + 1) * 50
next
'the "Union"
call ink 60, 59, 110 'RBG Old Glory Blue wki rgb .234, .233, .430
call fbox 0, 0, 494, 350
call ink 255, 255, 255 'Star/States field
for row = 1 to 9
ystar = 35 * row
if row mod 2 = 1 then
for col = 0 to 5
xstar = 42 + col * 2 * 41
call star xstar, ystar, 8, 20, 5, 18, 1
next
else
for col = 0 to 4
xstar = 83 + col * 2 * 41
call star xstar, ystar, 8, 20, 5, 18, 1
next
end if
next
'============================== sets drawing
#gr "flush"
wait
'procedures ======================================================
sub ink r,g,b 'fore and back
#gr "color ";r;" ";g;" ";b
#gr "backcolor ";r;" ";g;" ";b
end sub
sub aline x0,y0,x1,y1
#gr "line ";x0;" ";y0;" ";x1;" ";y1
end sub
sub fbox x0,y0,x1,y1
#gr "place ";x0;" ";y0
#gr "boxfilled ";x1;" ";y1
end sub
sub fcirc x, y, radius
#gr "place ";x;" ";y;"; circlefilled ";radius
end sub
'Fast Filled Triangle Sub by AndyAmaya
Sub ftri x1, y1, x2, y2, x3, y3
'triangle coordinates must be ordered: where x1 < x2 < x3
If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
'swap x1, y1, with x3, y3
If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
'swap x2, y2 with x3, y3
If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
If x1 <> x3 Then slope1 = (y3  y1) /(x3  x1)
'draw the first half of the triangle
length = x2  x1
If length <> 0 Then
slope2 = (y2  y1)/(x2  x1)
For x = 0 To length
#gr "Line ";int(x + x1);" ";int(x * slope1 + y1);" ";int(x + x1);" ";int(x * slope2 + y1)
Next
End If
'draw the second half of the triangle
y = length * slope1 + y1 : length = x3  x2
If length <> 0 Then
slope3 = (y3  y2) /(x3  x2)
For x = 0 To length
#gr "Line ";int(x + x2);" ";int(x * slope1 + y);" ";int(x + x2);" ";int(x * slope3 + y2)
Next
End If
call aline x1, y1, x2, y2
call aline x2, y2, x1, y1
call aline x2, y2, x3, y3
call aline x3, y3, x2, y2
call aline x1, y1, x3, y3
call aline x3, y3, x1, y1
End Sub
sub star x, y, rInner, rOuter, nPoints, angleOffset, TFfill
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
' TFfill filled True or False (1 or 0)
pAngle = RAD * (360 / nPoints) : radAngleOffset = RAD * angleOffset
x1 = x + rInner * cos(radAngleOffset)
y1 = y + rInner * sin(radAngleOffset)
for i = 0 to nPoints  1
x2 = x + rOuter * cos(i * pAngle + radAngleOffset + .5 * pAngle)
y2 = y + rOuter * sin(i * pAngle + radAngleOffset + .5 * pAngle)
x3 = x + rInner * cos((i + 1) * pAngle + radAngleOffset)
y3 = y + rInner * sin((i + 1) * pAngle + radAngleOffset)
if TFfill then
call ftri x1, y1, x2, y2, x3, y3
else
call aline x1, y1, x2, y2
call aline x2, y2, x3, y3
end if
x1 = x3 : y1 = y3
next
if TFfill then call fcirc x, y, rInner
end sub
sub lButtonUp H$, mx, my 'must have handle and mouse x,y
call quit H$ '<=== H$ global window handle
end sub
sub charIn H$, c$ '<=== must have handle and get keypress$
call quit H$ '<=== H$ global window handle
end sub
'Need line: #gr "trapclose quit"
sub quit H$
close #H$ '<=== this needs Global H$ = #gr
end 'Thanks Facundo, close graphic wo error
end sub


Logged

B+



Facundo
Board Moderator
member is offline
Gender:
Posts: 1302


Re: Star Maker
« Reply #2 on: May 30^{th}, 2016, 1:33pm » 

Liked the second one even if it is not my flag.


Logged

cundo aka MSlayer



bplus
Senior Member
member is offline
Gender:
Posts: 1255


Re: Star Maker
« Reply #3 on: May 30^{th}, 2016, 4:38pm » 

It was interesting, the Internet had diagram of official layout specifications, just had to convert to pixels.
Colors were a little harder, there were conflicting reports for RGB numbers. I hope I translated correctly. It looks OK to my eye. The first set I tried, the red was too pink and blue too light.


Logged

B+



bplus
Senior Member
member is offline
Gender:
Posts: 1255


Re: Star Maker
« Reply #4 on: Jul 4^{th}, 2017, 08:01am » 

I hope reply #1 doesn't get too old to pull out and wave a little to celebrate today's (20170704) significance to USA.


Logged

B+



Rod
Administrator
member is offline
Graphics = Goosebumps!
Gender:
Posts: 3151


Re: Star Maker
« Reply #5 on: Jul 4^{th}, 2017, 09:16am » 

Wow the year flies by, have a great holiday you folks in North America. In Scotland we are just celebrating rain, rain and more rain, a washed out summer for us so far.


Logged




bplus
Senior Member
member is offline
Gender:
Posts: 1255


Re: Star Maker
« Reply #6 on: Jul 5^{th}, 2017, 11:15am » 

on Jul 4^{th}, 2017, 09:16am, Rod wrote:Wow the year flies by, have a great holiday you folks in North America. In Scotland we are just celebrating rain, rain and more rain, a washed out summer for us so far. 

Thanks Rod,
and thanks to Scotland for taking our rain, we had excellent weather over the 4th.


Logged

B+



