Board Logo
« Star Maker »

Welcome Guest. Please Login or Register.
Jan 16th, 2018, 3:41pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Star Maker  (Read 922 times)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Star Maker
« Thread started on: May 29th, 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] 2016-05-29

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
 
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Star Maker
« Reply #1 on: May 29th, 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] 2016-05-29

' 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

 
User IP Logged

B+
Facundo
Board Moderator


member is offline

Avatar




PM

Gender: Male
Posts: 1302
xx Re: Star Maker
« Reply #2 on: May 30th, 2016, 1:33pm »

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

cundo aka MSlayer
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Star Maker
« Reply #3 on: May 30th, 2016, 4:38pm »

smiley 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.
User IP Logged

B+
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Star Maker
« Reply #4 on: Jul 4th, 2017, 08:01am »

I hope reply #1 doesn't get too old to pull out and wave a little to celebrate today's (2017-07-04) significance to USA. smiley
User IP Logged

B+
Rod
Administrator
ImageImageImageImageImage


member is offline

Avatar

Graphics = Goosebumps!


PM

Gender: Male
Posts: 3151
xx Re: Star Maker
« Reply #5 on: Jul 4th, 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.
User IP Logged

bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx Re: Star Maker
« Reply #6 on: Jul 5th, 2017, 11:15am »

on Jul 4th, 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.


smiley Thanks Rod,

and thanks to Scotland for taking our rain, we had excellent weather over the 4th. wink
User IP Logged

B+
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls