_Title "U.S. Flag - Use space bar to change hills background." x = 150
y = 100
Const twidth
= sw
, theight
= sh
, zoom
= 128 Dim Shared noise
(nn
* twidth
* theight
) '//the noise array Dim Shared texture
(nn
* twidth
* theight
) '//texture array
MakePalette 255, 155, 255, 10, 100, 180
GenerateNoise
buildtexture
drawtexture 0
'Stars
Line (x
, y
)-(x
+ 185, y
+ 130), _RGB32(0, 0, 255), BF
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)
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)
'Stripes
w = w + 1
Line (335, rs
)-(612.5, rs
+ 18.6), _RGB32(255, 0, 0), BF
Line (335, rs
+ 18.6)-(612.5, rs
+ 37.2), _RGB32(255, 255, 255), BF
nex:
w = 0
z(0)=&h3000000~&&:z(1)=&hFFF8~&&:z(2)=&h0~&&:z(3)=&h830E000000000000~&&
z(4)=&h47FF080000000~&&:z(5)=&h1BFFFE6000~&&:z(6)=&h37FFFE~&&
z(7)=&h900000000000006E~&&:z(8)=&hFFFFC80000000000~&&:z(9)=&h5FFFFFE8000000~&&
z(10)=&hBFFFFFF400~&&:z(11)=&h17FFFFE~&&:z(12)=&hF80000000000017A~&&
z(13)=&hFFFFFA0000000000~&&:z(14)=&h2F7FFFFFA000000~&&:z(15)=&h2EDFFFFFF00~&&
z(16)=&h2DBFFFE~&&:z(17)=&hFD000000000002D6~&&:z(18)=&hFFFFED0000000000~&&
z(19)=&h2B7FFFFAD000000~&&:z(20)=&h6B41FC7AD00~&&:z(21)=&h6E3EFB8~&&
z(22)=&hAD0000000000066C~&&:z(23)=&h17463D0000000000~&&:z(24)=&h2D016C0B5000000~&&
z(25)=&h2B00A805900~&&:z(26)=&h2A00A80~&&:z(27)=&h1B000000000002A0~&&
z(28)=&h9801A0000000000~&&:z(29)=&h3A00A801A000000~&&:z(30)=&hA008805A00~&&
z(31)=&h901660~&&:z(32)=&h580000000000026E~&&:z(33)=&hEC90D00000000000~&&
z(34)=&h2F0096F2F000000~&&:z(35)=&h6FFE9B0F100~&&:z(36)=&h2FFD0BE~&&
z(37)=&hFD000000000002C6~&&:z(38)=&hD2DFFD0000000000~&&:z(39)=&h33BD55F1B000000~&&
z(40)=&h16DEDBDEA00~&&:z(41)=&h54F27A~&&:z(42)=&hF400000000000046~&&
z(43)=&hEEFAA80000000000~&&:z(44)=&h4B5D5EA0000000~&&:z(45)=&h6BD1AFA000~&&
z(46)=&h69FFFA~&&:z(47)=&h64~&&:z(48)=&h57AB400000000000~&&:z(49)=&h25D7AF40000000~&&
z(50)=&h2BF3BF4000~&&:z(51)=&h2B7FEE~&&:z(52)=&h4000000000000024~&&
z(53)=&h6EAEC00000000000~&&:z(54)=&h19FEBC80000000~&&:z(55)=&h4FFBC8000~&&
z(56)=&hE000003C0002AFC8~&&:z(57)=&h1080000420000~&&:z(58)=&h7032000204000040~&&
z(59)=&hBFEC00020400~&&:z(60)=&h8080009FC80004~&&:z(61)=&h400004060004010~&&
z(62)=&h18040000C19C00~&&:z(63)=&h3FE0007604000080~&&:z(64)=&h8700000003860400~&&
z(65)=&h100F0E000000C1E~&&:z(66)=&h2000100E61C0000~&&:z(67)=&hE1CC010001009FC2~&&
z(68)=&hC0078FF601000100~&&:z(69)=&h3B8703837020200~&&:z(70)=&h101803F2FC3B002~&&
z(71)=&h2000101FC07F83E~&&:z(72)=&h80FE0200008207C0~&&:z(73)=&hF01C0F810600005C~&&
z(74)=&h3C00007800E800~&&:z(75)=&h1F00036000~&&:z(76)=&h1DFE01E~&&
z(77)=&hEE00000000001E7E~&&:z(78)=&h8307F9E000000000~&&:z(79)=&hE3FC1CE07F1C0000~&&
z(80)=&h381E3FC1C00E0FF0~&&:z(81)=&hC03047F1FF0F0002~&&:z(82)=&hC3FE3FC8C31E7078~&&
z(83)=&h3839C10C83E2~&&:z(84)=&h8180000006071B04~&&:z(85)=&hC2180C00000000C0~&&
z(86)=&h610442E070000000~&&:z(87)=&h381D085B018000~&&:z(88)=&h60348360C~&&:z(89)=&h181B0~&&
z(90)=&h2430000000000000~&&:z(91)=&h30D0C04000000000~&&:z(92)=&h80D00800000~&&
z(93)=&h4070100~&&:z(94)=&h202~&&:z(95)=&h8200000000000000~&&:z(96)=&h1045C0000000000~&&
z(97)=&hEC60000000~&&
fr = 240*i/100 + 15
p
(i
+ 100) = _rgb(255, fr
, 0) p
(i
+ 200) = _rgb(255, 255, fr
) r = r + 1
Line (150, rs
)-(612.5, rs
+ 18.6), _RGB32(255, 255, 255), BF
Line (150, rs
+ 18.6)-(612.5, rs
+ 37.2), _RGB32(255, 0, 0), BF
i = 0
n = 0
b = z(n)
xstep = 3
ystep = 2
line (280 + x
*xstep
, 150 + y
*ystep
)-step(xstep
,ystep
),_rgb(0,0,0),bf
f (x + 120, y + 80) = 300
ff(x + 120, y + 80) = 300
i=i+1
n = n + 1
b = z(n)
i = 0
nex2:
r = 0
t5 = t5 + 1
t = 20
'On Timer(2) GoSub hills:
'Timer On
ii = 0
jj = -1
'Sky
ii = ii + 1
ii = 0
'hour$ = Left$(Time$, 2)
'hour = Val(hour$)
'If hour < 21 And hour >= 6 Then
'Paint (2, 2), _RGB32(0, 205, 255)
'End If
'Flag Pole
Line (142, 80)-(147, 600), _RGB32(122, 128, 166), BF
if r
> 0.65 then f
(x
,y
) = ff
(x
,y
) f(x,y) = max((f(x-1,y+1) + f(x,y+1) + f(x+1,y+1) + f(x-1,y+2))/4 - 5, 0)
line (x
*xstep
- 81, y
*ystep
- 6)-step(xstep
, ystep
), p
(f
(x
,y
)),bf
r = 0
t5 = 0
t5 = t5 + 1
t = 20
fx2 = fx2 + 1.2
t6 = t6 + 1
PSet ((Sin(fy
* 0.017453 / fx2
) * t
) + fx
, (Sin(fx
* 0.017453 / fx2
) * t
) + fy
), cf&
(t6
)
t6 = 0
'If a$ = " " Then
hills:
'Random Hills
hills = 8'Int(Rnd * 40) + 3
hx
= 800*h
/hills
+ (ii
*8 mod 300) 'Int(Rnd * 800) + 1 size = 300'Int(Rnd * 450) + 75
cl = 15'Int(Rnd * 55)
shape = 0.7'Rnd
cl = cl + .05
hills = 5'Int(Rnd * 40) + 3
hx
= 800*h
/hills
+ (ii
*5 mod 300) 'Int(Rnd * 800) + 1 size = 250'Int(Rnd * 450) + 75
cl = 35'Int(Rnd * 55)
shape = 0.7'Rnd
cl = cl + .05
hills = 3'Int(Rnd * 40) + 3
hx
= 800*h
/hills
+ (ii
mod 300) 'Int(Rnd * 800) + 1 size = 180'Int(Rnd * 450) + 75
cl = 55'Int(Rnd * 55)
shape = 0.7'Rnd
cl = cl + .05
'//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)
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)
'//generates random noise.
For x
= 0 To nn
* twidth
- 1 noise(x + y * twidth) = zz
'//get fractional part of x and y
Dim fractx
, fracty
, x1
, y1
, x2
, y2
, value
'//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
initialsize = size
value = value + SmoothNoise(x / size, y / size) * size
size = size / 2.0
Turbulence = (128.0 * value / initialsize)
'//builds the texture.
For x
= 0 To nn
* twidth
- 1 texture(x + y * nn * twidth) = Turbulence(x, y, zoom)
'//draws texture to screen.
c = pal(texture(((x + dx) + y * nn * twidth)))
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)))