USA Flag

[vince]

Waving and shaded 3D US flag.  Drawn according to official specification

Code: (Select All)

deflng a-z

sw = 640
sh = 480

dim shared pi as double
pi = 4*atn(1)

screen _newimage(sw*2, sh, 32)

h = 300
w = 1.9*h
a = h/7

img = _newimage(w, h, 32)
_dest img
x0 = 0
y0 = 0

line (0, 0)-step(w, h),_rgb(255,255,255),bf
for i=0 to 6
        line (0, i*h*2/13)-step(w, h/13),_rgb(255*0.698,255*0.132,255*0.203),bf
next
line (0, 0)-step(w*2/5, h*7/13),_rgb(255*0.234,255*0.233,255*0.430),bf

for i=0 to 4
for j=0 to 5
        starf (j*2 + 1)*w*2/(5*12), (i*2 + 1)*h*7/130, h*4/(13*5*2), _rgb(255,255,255)
next
next

for i=1 to 4
for j=1 to 5
        starf (j*2)*w*2/(5*12), (i*2)*h*7/130, h*4/(13*5*2), _rgb(255,255,255)
next
next

_dest 0
_putimage (sw/2 - w/2, sh/2 - h/2), img
_source img

x0 = sw/2 - w/2 + sw
y0 = sh/2 - h/2 '+ sh

dim t as double
dim z as double

dim xx as double, yy as double
dim dx as double, dy as double
do
        t = t + 0.2

        line (sw,0)-step(sw, sh),_rgb(0,0,0),bf

        for y=0 to h + a*0.707 step 1
        for x=0 to w + a*0.707 step 1
                z = (0.1 + 0.4*(x/w))*a*sin(x/35 - y/70 - t) + 0.5*a
                dz = 50*a*cos(x/35 - y/70 - t)/35

                xx = x + z*0.707 - a*0.707
                yy = y - z*0.707

                if (int(xx) >=0 and int(xx) < w - 1 and int(yy) >= 0 and int(yy) < h - 1) then
                        tl = point(int(xx), int(yy))
                        tr = point(int(xx) + 1, int(yy))
                        bl = point(int(xx), int(yy) + 1)
                        br = point(int(xx) + 1, int(yy) + 1)

                        dx = xx - int(xx)
                        dy = yy - int(yy)

                        r =_round((1 - dy)*((1 - dx)*  _red(tl) + dx*  _red(tr)) + dy*((1 - dx)*  _red(bl) + dx*  _red(br)))
                        g = _round((1 - dy)*((1 - dx)*_green(tl) + dx*_green(tr)) + dy*((1 - dx)*_green(bl) + dx*_green(br)))
                        b = _round((1 - dy)*((1 - dx)* _blue(tl) + dx* _blue(tr)) + dy*((1 - dx)* _blue(bl) + dx* _blue(br)))

                        r = r + dz
                        g = g + dz
                        b = b + dz

                        if r<0 then r = 0
                        if r>255 then r = 255
                        if g<0 then g = 0
                        if g>255 then g = 255
                        if b<0 then b = 0
                        if b>255 then b = 255

                        pset (x0 + x, y0 - a*0.707 + y), _rgb(r,g,b)
                end if
        next
        next

        _display
        _limit 50
loop until _keyhit = 27

sleep
system

sub starf(x, y, r, c)
        pset (x + r*cos(pi/2), y - r*sin(pi/2)),c
        for i = 0 to 5
                xx = r*cos(i*4*pi/5 + pi/2)
                yy = r*sin(i*4*pi/5 + pi/2)
                line -(x + xx, y - yy),c
        next
        paint (x, y),c
        for i = 0 to 5
                xx = r*cos(i*4*pi/5 + pi/2)/2
                yy = r*sin(i*4*pi/5 + pi/2)/2
                paint (x + xx, y - yy),c
        next
end sub

[Jack]

very nice

[Pete]

Hey who let Vince FLAG Steve's forum?!  

Nice graphics. I like the waving effect.

Pete

[Dav]

Really beautiful effect. The touch of reflection as it waves makes it seem so realistic.

Nice coding!

- Dav

[Pete]

From the Archives of The QJurassic Forum, via TheBOB, 2003

Code: (Select All)

'*******************
'STARS and STRIPES
'By TheBOB / 2003
'*******************

_TITLE "Stars and Strips by Bob Seguin"
DEFINT A-Z

SCREEN 12

OUT &H3C8, 4
OUT &H3C9, 63
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C8, 5
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 25
OUT &H3C8, 8
OUT &H3C9, 60
OUT &H3C9, 60
OUT &H3C9, 63

PSET (113, 98), 15
DRAW "ta216 r18 ta72 r18 ta288 r18 ta144 r18 ta0 r18"
PAINT (0, 0), 4, 15
PAINT (105, 105), 14, 4
PAINT (0, 0), 0, 14
PSET (98, 109), 14
PSET (100, 108), 14
FOR x = 97 TO 114
    FOR y = 102 TO 109
        IF POINT(x, y) = 14 THEN PSET (x, y), 6
    NEXT y
NEXT x
DIM StarBOX(140)
GET (95, 90)-(115, 110), StarBOX()
PAINT (0, 0), 5
FOR y = 60 TO 372 STEP 52
    LINE (50, y)-(589, y + 24), 4, BF
    IF y < 372 THEN LINE (50, y + 25)-(589, y + 51), 15, BF
NEXT y
LINE (50, 60)-(290, 240), 1, BF
FOR x = 64 TO 254 STEP 38
    FOR y = 70 TO 206 STEP 34
        PUT (x, y), StarBOX()
        IF x < 254 AND y < 206 THEN PUT (x + 19, y + 17), StarBOX()
    NEXT y
NEXT x

'Initialize "wave" variables
x1 = 0
x3 = 215
x5 = 430

DO
    Count = Count + 1
    x = INT(RND * 6)
    y = INT(RND * 5)
    x = x * 38 + 64
    y = y * 34 + 70
    IF x < 254 AND y < 206 AND Count MOD 2 THEN x = x + 19: y = y + 17
    LINE (x, y)-(x + 18, y + 19), 1, BF
    StartTIME# = TIMER
    DO: LOOP WHILE TIMER < StartTIME# + 0
    PUT (x, y), StarBOX()

    'Add extra twinkle effect
    IF Count MOD 3 THEN
        PAINT (x + 9, y + 14), 11, 1
        WAIT &H3DA, 8
        WAIT &H3DA, 8, 8
        PAINT (x + 9, y + 14), 15, 1
        WAIT &H3DA, 8
        WAIT &H3DA, 8, 8
        PAINT (x + 9, y + 14), 1, 1
        PUT (x, y), StarBOX()
    END IF

    'Increment 'wave' variables
    x1 = x1 + 1
    x2 = x1 + 80
    x3 = x3 + 1
    x4 = x3 + 80
    x5 = x5 + 1
    x6 = x5 + 80

    'reset "wave" variables to left of screen when indicated
    IF x1 = 600 THEN x1 = -45
    IF x3 = 600 THEN x3 = -45
    IF x5 = 600 THEN x5 = -45

    'Draw "waves"
    FOR y = 60 TO 372
        IF POINT(x1, y) = 8 THEN PSET (x1, y), 15
        IF POINT(x2, y) = 15 THEN PSET (x2, y), 8
        IF POINT(x3, y) = 8 THEN PSET (x3, y), 15
        IF POINT(x4, y) = 15 THEN PSET (x4, y), 8
        IF POINT(x5, y) = 8 THEN PSET (x5, y), 15
        IF POINT(x6, y) = 15 THEN PSET (x6, y), 8
    NEXT y

    IF Count = 32767 THEN Count = 1

LOOP WHILE INKEY$ = ""

SYSTEM

[Dimster]

Star for the District of Columbia is likely on the back of the flag???

[Pete]

Star for the District of Columbia is likely on the back of the flag???

Right, cozzied up nicely next to the star for Purto Rico!

Pete

[SierraKen]

Very cool Vince. I still have your older one, but this one is side to side, not top and bottom. The shading is perfect.

---

Very neat Pete. I like the glimmer effect.

---

Here is my U.S. Flag from 2020, and also code by someone named rattrapmax6.

Code: (Select All)

'Made to honor the U.S. Flag.
'By Sierraken
'Feel free to use any or all of this code in your own applications or games.
'Updated with better flag waving and a hills fix on June 16, 2020.
'Thank you to B+ for a little help on the hills!
'Thank you also to someone named rattrapmax6 for the waving code.

_Title "U.S. Flag - Use space bar to change hills background."
Screen _NewImage(800, 600, 32)
Cls
x = 150
y = 100
Dim cf&(113000)

Const nn = 1
Const twidth = 640, theight = 480, zoom = 128
Dim Shared noise(nn * twidth * theight) '//the noise array
Dim Shared texture(nn * twidth * theight) '//texture array
Dim Shared pal(256) As _Unsigned Long '//color palette

Screen _NewImage(640, 480, 32)
MakePalette 255, 155, 255, 10, 100, 180
GenerateNoise
buildtexture

Dim vs As Long
vs = _NewImage(twidth, theight, 32)
_Dest vs
drawtexture 0
_Dest 0

ii = 0
jj = -1
kk = 0



GoSub hills:

'Stars
Line (x, y)-(x + 185, y + 130), _RGB32(0, 0, 255), BF
For xx = 155 To 345 Step 32
    For yy = 105 To 220 Step 28
        Line (xx + 2, yy + 12)-(xx + 7, yy), _RGB32(255, 255, 255)
        Line (xx + 7, yy)-(xx + 13, yy + 12), _RGB32(255, 255, 255)
        Line (xx + 13, yy + 12)-(xx, yy + 5), _RGB32(255, 255, 255)
        Line (xx, yy + 5)-(xx + 15, yy + 5), _RGB32(255, 255, 255)
        Line (xx + 15, yy + 5)-(xx + 2, yy + 12), _RGB32(255, 255, 255)
        Paint (xx + 7, yy + 2), _RGB32(255, 255, 255)
        Paint (xx + 7, yy + 6), _RGB32(255, 255, 255)
        Paint (xx + 11, yy + 10), _RGB32(255, 255, 255)
        Paint (xx + 4, yy + 10), _RGB32(255, 255, 255)
        Paint (xx + 3, yy + 6), _RGB32(255, 255, 255)
        Paint (xx + 12, yy + 6), _RGB32(255, 255, 255)
    Next yy
Next xx

For xx = 172 To 329 Step 32
    For yy = 118.9 To 213.05 Step 28
        Line (xx + 2, yy + 12)-(xx + 7, yy), _RGB32(255, 255, 255)
        Line (xx + 7, yy)-(xx + 13, yy + 12), _RGB32(255, 255, 255)
        Line (xx + 13, yy + 12)-(xx, yy + 5), _RGB32(255, 255, 255)
        Line (xx, yy + 5)-(xx + 15, yy + 5), _RGB32(255, 255, 255)
        Line (xx + 15, yy + 5)-(xx + 2, yy + 12), _RGB32(255, 255, 255)
        Paint (xx + 7, yy + 2), _RGB32(255, 255, 255)
        Paint (xx + 7, yy + 6), _RGB32(255, 255, 255)
        Paint (xx + 11, yy + 10), _RGB32(255, 255, 255)
        Paint (xx + 4, yy + 10), _RGB32(255, 255, 255)
        Paint (xx + 3, yy + 6), _RGB32(255, 255, 255)
        Paint (xx + 12, yy + 6), _RGB32(255, 255, 255)
    Next yy
Next xx

'Stripes
For rs = 100 To 230 Step 37.2
    w = w + 1
    Line (335, rs)-(612.5, rs + 18.6), _RGB32(255, 0, 0), BF
    If w > 3 Then GoTo nex:
    Line (335, rs + 18.6)-(612.5, rs + 37.2), _RGB32(255, 255, 255), BF
Next rs
nex:
w = 0
For rs = 230 To 341.6 Step 37.2
    r = r + 1
    Line (150, rs)-(612.5, rs + 18.6), _RGB32(255, 255, 255), BF
    If r > 3 Then GoTo nex2:
    Line (150, rs + 18.6)-(612.5, rs + 37.2), _RGB32(255, 0, 0), BF
Next rs
nex2:
r = 0
For fy = 100 To 341.6
    For fx = 150 To 612.5
        t5 = t5 + 1
        cf&(t5) = Point(fx, fy)
    Next fx
Next fy
t = 20
Do
    _Limit 10

    kk = kk + 1
    ii = ii + 1
    If ii >= 640 Then
        ii = 0
        jj = Not jj
    End If

    If jj Then
        _PutImage (ii, 0)-Step(640, 480), vs
        _PutImage (ii, 0)-Step(-640, 480), vs
    Else
        _PutImage (ii + 640, 0)-Step(-640, 480), vs
        _PutImage (ii - 640, 0)-Step(640, 480), vs
    End If

    'Sky
    hour$ = Left$(Time$, 2)
    hour = Val(hour$)
    If hour < 21 And hour >= 6 Then
        Paint (2, 2), _RGB32(0, 205, 255)
    End If
    _PutImage , hills&, 0
    'Flag Pole
    For sz = .25 To 10 Step .25
        Circle (145, 80), sz, _RGB32(122, 128, 166)
    Next sz
    Line (142, 80)-(147, 600), _RGB32(122, 128, 166), BF
    fx2 = fx2 + 1.2
    If fx2 > 5 Then fx2 = 1.2
    For fy = 100 To 341.6
        For fx = 150 To 612.5
            t6 = t6 + 1
            PSet ((Sin(fy * 0.017453 / fx2) * t) + fx, (Sin(fx * 0.017453 / fx2) * t) + fy), cf&(t6)
        Next fx
    Next fy
    t6 = 0
    If tt = 0 Then t = t + 1
    If t > 10 Then tt = 1
    If tt = 1 Then t = t - 1
    If t < -10 Then tt = 0
    a$ = InKey$
    If a$ = Chr$(27) Then End
    If a$ = " " Then GoSub hills:
    _Display
    Cls
Loop

hills:
'Random Hills
hills& = _NewImage(_Width, _Height, 32)
_Dest hills&
Randomize Timer
hills = Int(Rnd * 40) + 3
For h = 1 To hills
    Randomize Timer
    hx = Int(Rnd * 800) + 1
    size = Int(Rnd * 450) + 75
    cl = Int(Rnd * 55)
    shape = Rnd
    For sz = .25 To size Step .25
        cl = cl + .05
        Circle (hx, 599), sz, _RGB32(10, cl, 20), , , shape
    Next sz
Next h
_Dest 0
Return

'//interpolation code by rattrapmax6
Sub MakePalette (sr, sg, sb, er, eg, eb) ' (b+) start and end RGB's ? yes
    Dim i, istart(3), iend(3), ishow(3), rend(3), interpol(3)

    interpol(0) = 255
    istart(1) = sr
    istart(2) = sg
    istart(3) = sb
    iend(1) = er
    iend(2) = eg
    iend(3) = eb
    interpol(1) = (istart(1) - iend(1)) / interpol(0)
    interpol(2) = (istart(2) - iend(2)) / interpol(0)
    interpol(3) = (istart(3) - iend(3)) / interpol(0)
    rend(1) = istart(1)
    rend(2) = istart(2)
    rend(3) = istart(3)

    For i = 0 To 255
        ishow(1) = rend(1)
        ishow(2) = rend(2)
        ishow(3) = rend(3)

        pal(i) = _RGB32(ishow(1), ishow(2), ishow(3))

        rend(1) = rend(1) - interpol(1)
        rend(2) = rend(2) - interpol(2)
        rend(3) = rend(3) - interpol(3)
    Next i
End Sub

'//generates random noise.
Sub GenerateNoise ()
    Dim As Long x, y

    For x = 0 To nn * twidth - 1
        For y = 0 To theight - 1
            zz = Rnd
            noise(x + y * twidth) = zz
        Next y
    Next x

End Sub

Function SmoothNoise (x, y)
    '//get fractional part of x and y
    Dim fractx, fracty, x1, y1, x2, y2, value
    fractx = x - Int(x)
    fracty = y - Int(y)

    '//wrap around
    x1 = (Int(x) + nn * twidth) Mod twidth
    y1 = (Int(y) + theight) Mod theight

    '//neighbor values
    x2 = (x1 + nn * twidth - 1) Mod twidth
    y2 = (y1 + theight - 1) Mod theight

    '//smooth the noise with bilinear interpolation
    value = 0.0
    value = value + fractx * fracty * noise(x1 + y1 * twidth)
    value = value + fractx * (1 - fracty) * noise(x1 + y2 * twidth)
    value = value + (1 - fractx) * fracty * noise(x2 + y1 * twidth)
    value = value + (1 - fractx) * (1 - fracty) * noise(x2 + y2 * twidth)

    SmoothNoise = value
End Function

Function Turbulence (x, y, size)
    Dim value, initialsize

    initialsize = size
    While (size >= 1)
        value = value + SmoothNoise(x / size, y / size) * size
        size = size / 2.0
    Wend
    Turbulence = (128.0 * value / initialsize)
End Function

'//builds the texture.
Sub buildtexture
    Dim x, y

    For x = 0 To nn * twidth - 1
        For y = 0 To theight - 1
            texture(x + y * nn * twidth) = Turbulence(x, y, zoom)
        Next y
    Next x
End Sub

'//draws texture to screen.
Sub drawtexture (dx)
    Dim x, y
    Dim As Long c, r, g, b

    For x = 0 To twidth - 1
        For y = 0 To theight - 1
            c = pal(texture(((x + dx) + y * nn * twidth)))
            r = _Red(c)
            g = _Green(c)
            b = _Blue(c)
            c = _RGB(r - 0.2 * y, g - 0.2 * y, b - 0.2 * b)
            PSet (x, y), c 'pal(texture(((x + dx) + y * nn*twidth)))
        Next y
    Next x
End Sub