Author Topic: For those honoring Memorial Day  (Read 1280 times)

B+

  • Guest
For those honoring Memorial Day
« on: May 30, 2016, 12:46:52 AM »
Here is one in Just Basic:
Code: [Select]
'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

« Last Edit: May 30, 2016, 12:11:30 PM by B+ »