Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on February 09, 2022, 12:47:16 am

Title: Ken's U.S. Flag version 4 - With moving clouds
Post by: SierraKen on February 09, 2022, 12:47:16 am
Tonight I was going over a list of my old apps I made and remembered that I made a U.S. flag. So I found one I made that is waving and has random hills in the background and decided to add the new moving clouds in the sky that Vince has been using. Just by chance the flag is moving the same direction as the clouds. :) Press the Space Bar to get different random hills. Feel free to mod mod mod. :D Thanks Vince and someone named rattrapmax6!

(Code deleted because of a memory leak, please get the one below instead.)
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: SierraKen on February 09, 2022, 01:02:30 am
I just added the U.S. National Anthem to the background with the hills changing every second or so. It was easy because I had already made this before, just without the clouds. Make sure and download the attachment mp3 song and put it in the same folder as this program. The U.S. National Anthem is played by the United States Air Force. 
I want to thank B+ also for the help he originally gave me with the hills. And I think he also used these clouds too.

EDIT: Memory leak fixed and clouds fixed. Thanks B+, OldMoses, and everyone else!

Code: QB64: [Select]
  1. 'Made to honor the U.S. Flag.
  2. 'By Sierraken
  3. 'Feel free to use any or all of this code in your own applications or games.
  4. 'Updated with better flag waving and a hills fix on June 16, 2020.
  5. 'Thank you to B+ for help on the hills!
  6.  
  7. 'Update again on Feb. 8, 2022 from B+, Vince and someone named rattrapmax6 for the clouds, thank you!
  8. 'Added: U.S. National Anthem played by the U.S. Air Force and automatic hills change.
  9.  
  10. _Title "U.S. Flag - Use space bar to change hills background."
  11. Screen _NewImage(800, 600, 32)
  13. x = 150
  14. y = 100
  15. Dim cf&(113000)
  16.  
  17. Const nn = 1
  18. Const twidth = 640, theight = 480, zoom = 128
  19. Dim Shared noise(nn * twidth * theight) '//the noise array
  20. Dim Shared texture(nn * twidth * theight) '//texture array
  21. Dim Shared pal(256) As _Unsigned Long '//color palette
  22.  
  23. Screen _NewImage(640, 480, 32)
  24. MakePalette 255, 155, 255, 10, 100, 180
  25. GenerateNoise
  26. buildtexture
  27.  
  29. vs = _NewImage(twidth, theight, 32)
  31. drawtexture 0
  33.  
  34. ii = 0
  35. jj = -1
  36. kk = 0
  37.  
  38.  
  39.  
  40. GoSub hills:
  41.  
  42. 'Stars
  43. Line (x, y)-(x + 185, y + 130), _RGB32(0, 0, 255), BF
  44. For xx = 155 To 345 Step 32
  45.     For yy = 105 To 220 Step 28
  46.         Line (xx + 2, yy + 12)-(xx + 7, yy), _RGB32(255, 255, 255)
  47.         Line (xx + 7, yy)-(xx + 13, yy + 12), _RGB32(255, 255, 255)
  48.         Line (xx + 13, yy + 12)-(xx, yy + 5), _RGB32(255, 255, 255)
  49.         Line (xx, yy + 5)-(xx + 15, yy + 5), _RGB32(255, 255, 255)
  50.         Line (xx + 15, yy + 5)-(xx + 2, yy + 12), _RGB32(255, 255, 255)
  51.         Paint (xx + 7, yy + 2), _RGB32(255, 255, 255)
  52.         Paint (xx + 7, yy + 6), _RGB32(255, 255, 255)
  53.         Paint (xx + 11, yy + 10), _RGB32(255, 255, 255)
  54.         Paint (xx + 4, yy + 10), _RGB32(255, 255, 255)
  55.         Paint (xx + 3, yy + 6), _RGB32(255, 255, 255)
  56.         Paint (xx + 12, yy + 6), _RGB32(255, 255, 255)
  57.     Next yy
  58. Next xx
  59.  
  60. For xx = 172 To 329 Step 32
  61.     For yy = 118.9 To 213.05 Step 28
  62.         Line (xx + 2, yy + 12)-(xx + 7, yy), _RGB32(255, 255, 255)
  63.         Line (xx + 7, yy)-(xx + 13, yy + 12), _RGB32(255, 255, 255)
  64.         Line (xx + 13, yy + 12)-(xx, yy + 5), _RGB32(255, 255, 255)
  65.         Line (xx, yy + 5)-(xx + 15, yy + 5), _RGB32(255, 255, 255)
  66.         Line (xx + 15, yy + 5)-(xx + 2, yy + 12), _RGB32(255, 255, 255)
  67.         Paint (xx + 7, yy + 2), _RGB32(255, 255, 255)
  68.         Paint (xx + 7, yy + 6), _RGB32(255, 255, 255)
  69.         Paint (xx + 11, yy + 10), _RGB32(255, 255, 255)
  70.         Paint (xx + 4, yy + 10), _RGB32(255, 255, 255)
  71.         Paint (xx + 3, yy + 6), _RGB32(255, 255, 255)
  72.         Paint (xx + 12, yy + 6), _RGB32(255, 255, 255)
  73.     Next yy
  74. Next xx
  75.  
  76. 'Stripes
  77. For rs = 100 To 230 Step 37.2
  78.     w = w + 1
  79.     Line (335, rs)-(612.5, rs + 18.6), _RGB32(255, 0, 0), BF
  80.     If w > 3 Then GoTo nex:
  81.     Line (335, rs + 18.6)-(612.5, rs + 37.2), _RGB32(255, 255, 255), BF
  82. Next rs
  83. nex:
  84. w = 0
  85. For rs = 230 To 341.6 Step 37.2
  86.     r = r + 1
  87.     Line (150, rs)-(612.5, rs + 18.6), _RGB32(255, 255, 255), BF
  88.     If r > 3 Then GoTo nex2:
  89.     Line (150, rs + 18.6)-(612.5, rs + 37.2), _RGB32(255, 0, 0), BF
  90. Next rs
  91. nex2:
  92. r = 0
  93. For fy = 100 To 341.6
  94.     For fx = 150 To 612.5
  95.         t5 = t5 + 1
  96.         cf&(t5) = Point(fx, fy)
  97.     Next fx
  98. Next fy
  99. t = 20
  100. song& = _SndOpen("USAFBTheStarSpangledBannerChoral.mp3")
  101. _SndPlay song&
  102. On Timer(7) GoSub hills:
  104.  
  106.     _Limit 10
  107.  
  108.     kk = kk + 1
  109.     ii = ii + 1
  110.     If ii >= 640 Then
  111.         ii = 0
  112.         jj = Not jj
  113.     End If
  114.  
  115.     If jj Then
  116.         _PutImage (ii, 0)-Step(640, 480), vs
  117.         _PutImage (ii, 0)-Step(-640, 480), vs
  118.     Else
  119.         _PutImage (ii + 640, 0)-Step(-640, 480), vs
  120.         _PutImage (ii - 640, 0)-Step(640, 480), vs
  121.     End If
  122.  
  123.     'Sky
  124.     ' ========================================= this code is blocking out the clouds
  125.     'hour$ = Left$(Time$, 2)
  126.     'hour = Val(hour$)
  127.     'If hour < 21 And hour >= 6 Then
  128.     '    Paint (2, 2), _RGB32(0, 205, 255)
  129.     'End If
  130.     ' ============================================================================
  131.     _PutImage , hills&, 0
  132.     'Flag Pole
  133.     For sz = .25 To 10 Step .25
  134.         Circle (145, 80), sz, _RGB32(122, 128, 166)
  135.     Next sz
  136.     Line (142, 80)-(147, 600), _RGB32(122, 128, 166), BF
  137.     fx2 = fx2 + 1.2
  138.     If fx2 > 5 Then fx2 = 1.2
  139.     For fy = 100 To 341.6
  140.         For fx = 150 To 612.5
  141.             t6 = t6 + 1
  142.             PSet ((Sin(fy * 0.017453 / fx2) * t) + fx, (Sin(fx * 0.017453 / fx2) * t) + fy), cf&(t6)
  143.         Next fx
  144.     Next fy
  145.     t6 = 0
  146.     If tt = 0 Then t = t + 1
  147.     If t > 10 Then tt = 1
  148.     If tt = 1 Then t = t - 1
  149.     If t < -10 Then tt = 0
  150.     a$ = InKey$
  151.     If a$ = Chr$(27) Then End
  152.     If a$ = " " Then GoSub hills:
  153.     _Display
  154.     Cls
  156.  
  157. hills:
  158. 'Random Hills
  159. If hills& <> 0 Then _FreeImage hills&
  160. hills& = _NewImage(_Width, _Height, 32)
  161. _Dest hills&
  163. hills = Int(Rnd * 40) + 3
  164. For h = 1 To hills
  166.     hx = Int(Rnd * 800) + 1
  167.     size = Int(Rnd * 450) + 75
  168.     cl = Int(Rnd * 55)
  169.     shape = Rnd
  170.     For sz = .25 To size Step .25
  171.         cl = cl + .05
  172.         Circle (hx, 599), sz, _RGB32(10, cl, 20), , , shape
  173.     Next sz
  177.  
  178. '//interpolation code by rattrapmax6
  179. Sub MakePalette (sr, sg, sb, er, eg, eb) ' (b+) start and end RGB's ? yes
  180.     Dim i, istart(3), iend(3), ishow(3), rend(3), interpol(3)
  181.  
  182.     interpol(0) = 255
  183.     istart(1) = sr
  184.     istart(2) = sg
  185.     istart(3) = sb
  186.     iend(1) = er
  187.     iend(2) = eg
  188.     iend(3) = eb
  189.     interpol(1) = (istart(1) - iend(1)) / interpol(0)
  190.     interpol(2) = (istart(2) - iend(2)) / interpol(0)
  191.     interpol(3) = (istart(3) - iend(3)) / interpol(0)
  192.     rend(1) = istart(1)
  193.     rend(2) = istart(2)
  194.     rend(3) = istart(3)
  195.  
  196.     For i = 0 To 255
  197.         ishow(1) = rend(1)
  198.         ishow(2) = rend(2)
  199.         ishow(3) = rend(3)
  200.  
  201.         pal(i) = _RGB32(ishow(1), ishow(2), ishow(3))
  202.  
  203.         rend(1) = rend(1) - interpol(1)
  204.         rend(2) = rend(2) - interpol(2)
  205.         rend(3) = rend(3) - interpol(3)
  206.     Next i
  208.  
  209. '//generates random noise.
  210. Sub GenerateNoise ()
  211.     Dim As Long x, y
  212.  
  213.     For x = 0 To nn * twidth - 1
  214.         For y = 0 To theight - 1
  215.             zz = Rnd
  216.             noise(x + y * twidth) = zz
  217.         Next y
  218.     Next x
  219.  
  221.  
  222. Function SmoothNoise (x, y)
  223.     '//get fractional part of x and y
  224.     Dim fractx, fracty, x1, y1, x2, y2, value
  225.     fractx = x - Int(x)
  226.     fracty = y - Int(y)
  227.  
  228.     '//wrap around
  229.     x1 = (Int(x) + nn * twidth) Mod twidth
  230.     y1 = (Int(y) + theight) Mod theight
  231.  
  232.     '//neighbor values
  233.     x2 = (x1 + nn * twidth - 1) Mod twidth
  234.     y2 = (y1 + theight - 1) Mod theight
  235.  
  236.     '//smooth the noise with bilinear interpolation
  237.     value = 0.0
  238.     value = value + fractx * fracty * noise(x1 + y1 * twidth)
  239.     value = value + fractx * (1 - fracty) * noise(x1 + y2 * twidth)
  240.     value = value + (1 - fractx) * fracty * noise(x2 + y1 * twidth)
  241.     value = value + (1 - fractx) * (1 - fracty) * noise(x2 + y2 * twidth)
  242.  
  243.     SmoothNoise = value
  245.  
  246. Function Turbulence (x, y, size)
  247.     Dim value, initialsize
  248.  
  249.     initialsize = size
  250.     While (size >= 1)
  251.         value = value + SmoothNoise(x / size, y / size) * size
  252.         size = size / 2.0
  253.     Wend
  254.     Turbulence = (128.0 * value / initialsize)
  256.  
  257. '//builds the texture.
  258. Sub buildtexture
  259.     Dim x, y
  260.  
  261.     For x = 0 To nn * twidth - 1
  262.         For y = 0 To theight - 1
  263.             texture(x + y * nn * twidth) = Turbulence(x, y, zoom)
  264.         Next y
  265.     Next x
  267.  
  268. '//draws texture to screen.
  269. Sub drawtexture (dx)
  270.     Dim x, y
  271.     Dim As Long c, r, g, b
  272.  
  273.     For x = 0 To twidth - 1
  274.         For y = 0 To theight - 1
  275.             c = pal(texture(((x + dx) + y * nn * twidth)))
  276.             r = _Red(c)
  277.             g = _Green(c)
  278.             b = _Blue(c)
  279.             c = _RGB(r - 0.2 * y, g - 0.2 * y, b - 0.2 * b)
  280.             PSet (x, y), c 'pal(texture(((x + dx) + y * nn*twidth)))
  281.         Next y
  282.     Next x
  284.  
  285.  

Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: DANILIN on February 09, 2022, 06:10:00 am
Realistic Flag Logo
https://renderforest.com/en/template/Realistic-flag-logo-bonus-version
renderforest.com/en/template/Realistic-flag-logo-bonus-version
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: FellippeHeitor on February 09, 2022, 11:31:18 am
That was clever @SierraKen! It's cool how you generate it all with line/paint and then store it to "wave" it later on.
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: bplus on February 09, 2022, 12:08:35 pm
I am not seeing all that cloud making code being activated which BTW came from here:
https://qb64forum.alephc.xyz/index.php?topic=4615.msg140454#msg140454
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: _vince on February 09, 2022, 12:30:54 pm
Quote from: bplus on February 09, 2022, 12:08:35 pm
I am not seeing all that cloud making code being activated which BTW came from here:
https://qb64forum.alephc.xyz/index.php?topic=4615.msg140454#msg140454

Because it happens to be daytime with clear sunny skies
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: bplus on February 09, 2022, 12:41:29 pm
Shouldn't this be causing a memory leak?

Code: QB64: [Select]
  1. hills:
  2. 'Random Hills
  3. hills& = _NewImage(_Width, _Height, 32)
  4. _Dest hills&
  5.  
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: bplus on February 09, 2022, 12:54:56 pm
Well this gets the clouds shown and moving:
Code: QB64: [Select]
  1. 'Made to honor the U.S. Flag.
  2. 'By Sierraken
  3. 'Feel free to use any or all of this code in your own applications or games.
  4. 'Updated with better flag waving and a hills fix on June 16, 2020.
  5. 'Thank you to B+ for help on the hills!
  6.  
  7. 'Update again on Feb. 8, 2022 from B+, Vince and someone named rattrapmax6 for the clouds, thank you!
  8. 'Added: U.S. National Anthem played by the U.S. Air Force and automatic hills change.
  9.  
  10. _Title "U.S. Flag - Use space bar to change hills background."
  11. Screen _NewImage(800, 600, 32)
  13. x = 150
  14. y = 100
  15. Dim cf&(113000)
  16.  
  17. Const nn = 1
  18. Const twidth = 640, theight = 480, zoom = 128
  19. Dim Shared noise(nn * twidth * theight) '//the noise array
  20. Dim Shared texture(nn * twidth * theight) '//texture array
  21. Dim Shared pal(256) As _Unsigned Long '//color palette
  22.  
  23. Screen _NewImage(640, 480, 32)
  24. MakePalette 255, 155, 255, 10, 100, 180
  25. GenerateNoise
  26. buildtexture
  27.  
  29. vs = _NewImage(twidth, theight, 32)
  31. drawtexture 0
  33.  
  34. ii = 0
  35. jj = -1
  36. kk = 0
  37.  
  38.  
  39.  
  40. GoSub hills:
  41.  
  42. 'Stars
  43. Line (x, y)-(x + 185, y + 130), _RGB32(0, 0, 255), BF
  44. For xx = 155 To 345 Step 32
  45.     For yy = 105 To 220 Step 28
  46.         Line (xx + 2, yy + 12)-(xx + 7, yy), _RGB32(255, 255, 255)
  47.         Line (xx + 7, yy)-(xx + 13, yy + 12), _RGB32(255, 255, 255)
  48.         Line (xx + 13, yy + 12)-(xx, yy + 5), _RGB32(255, 255, 255)
  49.         Line (xx, yy + 5)-(xx + 15, yy + 5), _RGB32(255, 255, 255)
  50.         Line (xx + 15, yy + 5)-(xx + 2, yy + 12), _RGB32(255, 255, 255)
  51.         Paint (xx + 7, yy + 2), _RGB32(255, 255, 255)
  52.         Paint (xx + 7, yy + 6), _RGB32(255, 255, 255)
  53.         Paint (xx + 11, yy + 10), _RGB32(255, 255, 255)
  54.         Paint (xx + 4, yy + 10), _RGB32(255, 255, 255)
  55.         Paint (xx + 3, yy + 6), _RGB32(255, 255, 255)
  56.         Paint (xx + 12, yy + 6), _RGB32(255, 255, 255)
  57.     Next yy
  58. Next xx
  59.  
  60. For xx = 172 To 329 Step 32
  61.     For yy = 118.9 To 213.05 Step 28
  62.         Line (xx + 2, yy + 12)-(xx + 7, yy), _RGB32(255, 255, 255)
  63.         Line (xx + 7, yy)-(xx + 13, yy + 12), _RGB32(255, 255, 255)
  64.         Line (xx + 13, yy + 12)-(xx, yy + 5), _RGB32(255, 255, 255)
  65.         Line (xx, yy + 5)-(xx + 15, yy + 5), _RGB32(255, 255, 255)
  66.         Line (xx + 15, yy + 5)-(xx + 2, yy + 12), _RGB32(255, 255, 255)
  67.         Paint (xx + 7, yy + 2), _RGB32(255, 255, 255)
  68.         Paint (xx + 7, yy + 6), _RGB32(255, 255, 255)
  69.         Paint (xx + 11, yy + 10), _RGB32(255, 255, 255)
  70.         Paint (xx + 4, yy + 10), _RGB32(255, 255, 255)
  71.         Paint (xx + 3, yy + 6), _RGB32(255, 255, 255)
  72.         Paint (xx + 12, yy + 6), _RGB32(255, 255, 255)
  73.     Next yy
  74. Next xx
  75.  
  76. 'Stripes
  77. For rs = 100 To 230 Step 37.2
  78.     w = w + 1
  79.     Line (335, rs)-(612.5, rs + 18.6), _RGB32(255, 0, 0), BF
  80.     If w > 3 Then GoTo nex:
  81.     Line (335, rs + 18.6)-(612.5, rs + 37.2), _RGB32(255, 255, 255), BF
  82. Next rs
  83. nex:
  84. w = 0
  85. For rs = 230 To 341.6 Step 37.2
  86.     r = r + 1
  87.     Line (150, rs)-(612.5, rs + 18.6), _RGB32(255, 255, 255), BF
  88.     If r > 3 Then GoTo nex2:
  89.     Line (150, rs + 18.6)-(612.5, rs + 37.2), _RGB32(255, 0, 0), BF
  90. Next rs
  91. nex2:
  92. r = 0
  93. For fy = 100 To 341.6
  94.     For fx = 150 To 612.5
  95.         t5 = t5 + 1
  96.         cf&(t5) = Point(fx, fy)
  97.     Next fx
  98. Next fy
  99. t = 20
  100. song& = _SndOpen("USAFBTheStarSpangledBannerChoral.mp3")
  101. _SndPlay song&
  102. On Timer(7) GoSub hills:
  104.  
  106.     _Limit 10
  107.  
  108.     kk = kk + 1
  109.     ii = ii + 1
  110.     If ii >= 640 Then
  111.         ii = 0
  112.         jj = Not jj
  113.     End If
  114.  
  115.     If jj Then
  116.         _PutImage (ii, 0)-Step(640, 480), vs
  117.         _PutImage (ii, 0)-Step(-640, 480), vs
  118.     Else
  119.         _PutImage (ii + 640, 0)-Step(-640, 480), vs
  120.         _PutImage (ii - 640, 0)-Step(640, 480), vs
  121.     End If
  122.  
  123.     'Sky
  124.     ' ========================================= this code is blocking out the clouds
  125.     'hour$ = Left$(Time$, 2)
  126.     'hour = Val(hour$)
  127.     'If hour < 21 And hour >= 6 Then
  128.     '    Paint (2, 2), _RGB32(0, 205, 255)
  129.     'End If
  130.     ' ============================================================================
  131.     _PutImage , hills&, 0
  132.     'Flag Pole
  133.     For sz = .25 To 10 Step .25
  134.         Circle (145, 80), sz, _RGB32(122, 128, 166)
  135.     Next sz
  136.     Line (142, 80)-(147, 600), _RGB32(122, 128, 166), BF
  137.     fx2 = fx2 + 1.2
  138.     If fx2 > 5 Then fx2 = 1.2
  139.     For fy = 100 To 341.6
  140.         For fx = 150 To 612.5
  141.             t6 = t6 + 1
  142.             PSet ((Sin(fy * 0.017453 / fx2) * t) + fx, (Sin(fx * 0.017453 / fx2) * t) + fy), cf&(t6)
  143.         Next fx
  144.     Next fy
  145.     t6 = 0
  146.     If tt = 0 Then t = t + 1
  147.     If t > 10 Then tt = 1
  148.     If tt = 1 Then t = t - 1
  149.     If t < -10 Then tt = 0
  150.     a$ = InKey$
  151.     If a$ = Chr$(27) Then End
  152.     If a$ = " " Then GoSub hills:
  153.     _Display
  154.     Cls
  156.  
  157. hills:
  158. 'Random Hills
  159. hills& = _NewImage(_Width, _Height, 32)
  160. _Dest hills&
  162. hills = Int(Rnd * 40) + 3
  163. For h = 1 To hills
  165.     hx = Int(Rnd * 800) + 1
  166.     size = Int(Rnd * 450) + 75
  167.     cl = Int(Rnd * 55)
  168.     shape = Rnd
  169.     For sz = .25 To size Step .25
  170.         cl = cl + .05
  171.         Circle (hx, 599), sz, _RGB32(10, cl, 20), , , shape
  172.     Next sz
  176.  
  177. '//interpolation code by rattrapmax6
  178. Sub MakePalette (sr, sg, sb, er, eg, eb) ' (b+) start and end RGB's ? yes
  179.     Dim i, istart(3), iend(3), ishow(3), rend(3), interpol(3)
  180.  
  181.     interpol(0) = 255
  182.     istart(1) = sr
  183.     istart(2) = sg
  184.     istart(3) = sb
  185.     iend(1) = er
  186.     iend(2) = eg
  187.     iend(3) = eb
  188.     interpol(1) = (istart(1) - iend(1)) / interpol(0)
  189.     interpol(2) = (istart(2) - iend(2)) / interpol(0)
  190.     interpol(3) = (istart(3) - iend(3)) / interpol(0)
  191.     rend(1) = istart(1)
  192.     rend(2) = istart(2)
  193.     rend(3) = istart(3)
  194.  
  195.     For i = 0 To 255
  196.         ishow(1) = rend(1)
  197.         ishow(2) = rend(2)
  198.         ishow(3) = rend(3)
  199.  
  200.         pal(i) = _RGB32(ishow(1), ishow(2), ishow(3))
  201.  
  202.         rend(1) = rend(1) - interpol(1)
  203.         rend(2) = rend(2) - interpol(2)
  204.         rend(3) = rend(3) - interpol(3)
  205.     Next i
  207.  
  208. '//generates random noise.
  209. Sub GenerateNoise ()
  210.     Dim As Long x, y
  211.  
  212.     For x = 0 To nn * twidth - 1
  213.         For y = 0 To theight - 1
  214.             zz = Rnd
  215.             noise(x + y * twidth) = zz
  216.         Next y
  217.     Next x
  218.  
  220.  
  221. Function SmoothNoise (x, y)
  222.     '//get fractional part of x and y
  223.     Dim fractx, fracty, x1, y1, x2, y2, value
  224.     fractx = x - Int(x)
  225.     fracty = y - Int(y)
  226.  
  227.     '//wrap around
  228.     x1 = (Int(x) + nn * twidth) Mod twidth
  229.     y1 = (Int(y) + theight) Mod theight
  230.  
  231.     '//neighbor values
  232.     x2 = (x1 + nn * twidth - 1) Mod twidth
  233.     y2 = (y1 + theight - 1) Mod theight
  234.  
  235.     '//smooth the noise with bilinear interpolation
  236.     value = 0.0
  237.     value = value + fractx * fracty * noise(x1 + y1 * twidth)
  238.     value = value + fractx * (1 - fracty) * noise(x1 + y2 * twidth)
  239.     value = value + (1 - fractx) * fracty * noise(x2 + y1 * twidth)
  240.     value = value + (1 - fractx) * (1 - fracty) * noise(x2 + y2 * twidth)
  241.  
  242.     SmoothNoise = value
  244.  
  245. Function Turbulence (x, y, size)
  246.     Dim value, initialsize
  247.  
  248.     initialsize = size
  249.     While (size >= 1)
  250.         value = value + SmoothNoise(x / size, y / size) * size
  251.         size = size / 2.0
  252.     Wend
  253.     Turbulence = (128.0 * value / initialsize)
  255.  
  256. '//builds the texture.
  257. Sub buildtexture
  258.     Dim x, y
  259.  
  260.     For x = 0 To nn * twidth - 1
  261.         For y = 0 To theight - 1
  262.             texture(x + y * nn * twidth) = Turbulence(x, y, zoom)
  263.         Next y
  264.     Next x
  266.  
  267. '//draws texture to screen.
  268. Sub drawtexture (dx)
  269.     Dim x, y
  270.     Dim As Long c, r, g, b
  271.  
  272.     For x = 0 To twidth - 1
  273.         For y = 0 To theight - 1
  274.             c = pal(texture(((x + dx) + y * nn * twidth)))
  275.             r = _Red(c)
  276.             g = _Green(c)
  277.             b = _Blue(c)
  278.             c = _RGB(r - 0.2 * y, g - 0.2 * y, b - 0.2 * b)
  279.             PSet (x, y), c 'pal(texture(((x + dx) + y * nn*twidth)))
  280.         Next y
  281.     Next x
  283.  
  284.  
  285.  
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: OldMoses on February 09, 2022, 12:58:19 pm
When I change hills the memory does tick upward in Task Manager.
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: bplus on February 09, 2022, 01:04:46 pm
I'm not seeing it my CPU is going back and forth but this might stop an uptick:
Code: QB64: [Select]
  1. hills:
  2. 'Random Hills
  3. If hills& Then _FreeImage (hills&)  ' <<<<<<<<<<<<<<<<<< insert
  4. hills& = _NewImage(_Width, _Height, 32)
  5. _Dest hills&
  6.  
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: SierraKen on February 09, 2022, 01:09:04 pm
Wow I am so embarrassed. I don't know what happened last night to make the clouds not move. I'm guessing I left out some code and put the wrong code here, sorry about that everyone. B+, as always I want to thank you for fixing it. I would have had to start from where started yesterday. Also, thanks for telling me about the memory leak, you too OldMoses. I fixed it by adding a
IF hills&<>0 then _FREEIMAGE hills& right before it makes a new one. I'll post the update over the original ones above because I don't want anyone trying that.
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: bplus on February 09, 2022, 02:48:28 pm
Hey Ken, I could see you did have clouds working after I found what was preventing then from being shown. Not sure what you were thinking with the time thing?
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: SierraKen on February 09, 2022, 02:50:01 pm
The only time thing I can remember is the switching between different hills, using a TIMER. Maybe I put it in the wrong place. But I know it was working last night at some point.  lol
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: bplus on February 09, 2022, 02:51:53 pm
It was here drawing sky:
Code: QB64: [Select]
  1.     'Sky
  2.     ' ========================================= this code is blocking out the clouds
  3.     'hour$ = Left$(Time$, 2)
  4.     'hour = Val(hour$)
  5.     'If hour < 21 And hour >= 6 Then
  6.     '    Paint (2, 2), _RGB32(0, 205, 255)
  7.     'End If
  8.     ' ============================================================================
  9.  

I commented out the code and the moving clouds worked fine.
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: SierraKen on February 09, 2022, 02:59:08 pm
Wow OK, I see that also in an older version of the flag. What it was for is changing the sky to a blue daytime when it was daytime in the real world using the clock. Yeah it wouldn't work anyway with the clouds, thanks for pointing that out. The reason why it worked for me last night was because in the real world it was night time therefore it didn't change the sky color. LOL
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: SMcNeill on February 09, 2022, 03:05:04 pm
Wouldn't you just draw the clouds on top of the sky?  A simple change in order of operations might be all you need.
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: SierraKen on February 09, 2022, 03:11:55 pm
Steve, no reason to if you would never see it. The clouds are there 24/7 unless I want to change it. But I would rather not because the clouds are so cool to watch.
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: bplus on February 09, 2022, 03:24:51 pm
@SMcNeill  the clouds are sky and cloud generated by a noise texture routine first discussed here:
https://qb64forum.alephc.xyz/index.php?topic=4615.msg140454#msg140454

Vince made a good mod of some code I translated from Yabasic.

Then Ken probably picked up here:
https://qb64forum.alephc.xyz/index.php?topic=4638.msg140509#msg140509
Where vince included the sky cloud code without labels in Falling letters game.
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: _vince on February 12, 2022, 05:55:44 pm
B+ mod time, you know the drill

Code: QB64: [Select]
  1. _Title "U.S. Flag - Use space bar to change hills background."
  2. const sw = 800
  3. const sh = 600
  4. Screen _NewImage(sw, sh, 32)
  6. x = 150
  7. y = 100
  8. Dim cf&(113000)
  9.  
  10. Const nn = 1
  11. Const twidth = sw, theight = sh, zoom = 128
  12. Dim Shared noise(nn * twidth * theight) '//the noise array
  13. Dim Shared texture(nn * twidth * theight) '//texture array
  14. Dim Shared pal(256) As _Unsigned Long '//color palette
  15.  
  16. MakePalette 255, 155, 255, 10, 100, 180
  17. GenerateNoise
  18. buildtexture
  19.  
  21. vs = _NewImage(twidth, theight, 32)
  23. drawtexture 0
  25.  
  26. GoSub hills:
  27.  
  28. dim vvs as long
  29. vvs = _newimage(sw, sh, 32)
  30. vvs2 = _newimage(sw, sh, 32)
  31. _dest vvs
  32.  
  33. 'Stars
  34. Line (x, y)-(x + 185, y + 130), _RGB32(0, 0, 255), BF
  35. For xx = 155 To 345 Step 32
  36.     For yy = 105 To 220 Step 28
  37.         Line (xx + 2, yy + 12)-(xx + 7, yy), _RGB32(255, 255, 255)
  38.         Line (xx + 7, yy)-(xx + 13, yy + 12), _RGB32(255, 255, 255)
  39.         Line (xx + 13, yy + 12)-(xx, yy + 5), _RGB32(255, 255, 255)
  40.         Line (xx, yy + 5)-(xx + 15, yy + 5), _RGB32(255, 255, 255)
  41.         Line (xx + 15, yy + 5)-(xx + 2, yy + 12), _RGB32(255, 255, 255)
  42.         Paint (xx + 7, yy + 2), _RGB32(255, 255, 255)
  43.         Paint (xx + 7, yy + 6), _RGB32(255, 255, 255)
  44.         Paint (xx + 11, yy + 10), _RGB32(255, 255, 255)
  45.         Paint (xx + 4, yy + 10), _RGB32(255, 255, 255)
  46.         Paint (xx + 3, yy + 6), _RGB32(255, 255, 255)
  47.         Paint (xx + 12, yy + 6), _RGB32(255, 255, 255)
  48.     Next yy
  49. Next xx
  50.  
  51. For xx = 172 To 329 Step 32
  52.     For yy = 118.9 To 213.05 Step 28
  53.         Line (xx + 2, yy + 12)-(xx + 7, yy), _RGB32(255, 255, 255)
  54.         Line (xx + 7, yy)-(xx + 13, yy + 12), _RGB32(255, 255, 255)
  55.         Line (xx + 13, yy + 12)-(xx, yy + 5), _RGB32(255, 255, 255)
  56.         Line (xx, yy + 5)-(xx + 15, yy + 5), _RGB32(255, 255, 255)
  57.         Line (xx + 15, yy + 5)-(xx + 2, yy + 12), _RGB32(255, 255, 255)
  58.         Paint (xx + 7, yy + 2), _RGB32(255, 255, 255)
  59.         Paint (xx + 7, yy + 6), _RGB32(255, 255, 255)
  60.         Paint (xx + 11, yy + 10), _RGB32(255, 255, 255)
  61.         Paint (xx + 4, yy + 10), _RGB32(255, 255, 255)
  62.         Paint (xx + 3, yy + 6), _RGB32(255, 255, 255)
  63.         Paint (xx + 12, yy + 6), _RGB32(255, 255, 255)
  64.     Next yy
  65. Next xx
  66.  
  67. 'Stripes
  68. For rs = 100 To 230 Step 37.2
  69.     w = w + 1
  70.     Line (335, rs)-(612.5, rs + 18.6), _RGB32(255, 0, 0), BF
  71.     If w > 3 Then GoTo nex:
  72.     Line (335, rs + 18.6)-(612.5, rs + 37.2), _RGB32(255, 255, 255), BF
  73. Next rs
  74. nex:
  75. w = 0
  76. dim z(98) as _unsigned _integer64 'Marshawn polynomial coefficients of the nth order
  77. z(0)=&h3000000~&&:z(1)=&hFFF8~&&:z(2)=&h0~&&:z(3)=&h830E000000000000~&&
  78. z(4)=&h47FF080000000~&&:z(5)=&h1BFFFE6000~&&:z(6)=&h37FFFE~&&
  79. z(7)=&h900000000000006E~&&:z(8)=&hFFFFC80000000000~&&:z(9)=&h5FFFFFE8000000~&&
  80. z(10)=&hBFFFFFF400~&&:z(11)=&h17FFFFE~&&:z(12)=&hF80000000000017A~&&
  81. z(13)=&hFFFFFA0000000000~&&:z(14)=&h2F7FFFFFA000000~&&:z(15)=&h2EDFFFFFF00~&&
  82. z(16)=&h2DBFFFE~&&:z(17)=&hFD000000000002D6~&&:z(18)=&hFFFFED0000000000~&&
  83. z(19)=&h2B7FFFFAD000000~&&:z(20)=&h6B41FC7AD00~&&:z(21)=&h6E3EFB8~&&
  84. z(22)=&hAD0000000000066C~&&:z(23)=&h17463D0000000000~&&:z(24)=&h2D016C0B5000000~&&
  85. z(25)=&h2B00A805900~&&:z(26)=&h2A00A80~&&:z(27)=&h1B000000000002A0~&&
  86. z(28)=&h9801A0000000000~&&:z(29)=&h3A00A801A000000~&&:z(30)=&hA008805A00~&&
  87. z(31)=&h901660~&&:z(32)=&h580000000000026E~&&:z(33)=&hEC90D00000000000~&&
  88. z(34)=&h2F0096F2F000000~&&:z(35)=&h6FFE9B0F100~&&:z(36)=&h2FFD0BE~&&
  89. z(37)=&hFD000000000002C6~&&:z(38)=&hD2DFFD0000000000~&&:z(39)=&h33BD55F1B000000~&&
  90. z(40)=&h16DEDBDEA00~&&:z(41)=&h54F27A~&&:z(42)=&hF400000000000046~&&
  91. z(43)=&hEEFAA80000000000~&&:z(44)=&h4B5D5EA0000000~&&:z(45)=&h6BD1AFA000~&&
  92. z(46)=&h69FFFA~&&:z(47)=&h64~&&:z(48)=&h57AB400000000000~&&:z(49)=&h25D7AF40000000~&&
  93. z(50)=&h2BF3BF4000~&&:z(51)=&h2B7FEE~&&:z(52)=&h4000000000000024~&&
  94. z(53)=&h6EAEC00000000000~&&:z(54)=&h19FEBC80000000~&&:z(55)=&h4FFBC8000~&&
  95. z(56)=&hE000003C0002AFC8~&&:z(57)=&h1080000420000~&&:z(58)=&h7032000204000040~&&
  96. z(59)=&hBFEC00020400~&&:z(60)=&h8080009FC80004~&&:z(61)=&h400004060004010~&&
  97. z(62)=&h18040000C19C00~&&:z(63)=&h3FE0007604000080~&&:z(64)=&h8700000003860400~&&
  98. z(65)=&h100F0E000000C1E~&&:z(66)=&h2000100E61C0000~&&:z(67)=&hE1CC010001009FC2~&&
  99. z(68)=&hC0078FF601000100~&&:z(69)=&h3B8703837020200~&&:z(70)=&h101803F2FC3B002~&&
  100. z(71)=&h2000101FC07F83E~&&:z(72)=&h80FE0200008207C0~&&:z(73)=&hF01C0F810600005C~&&
  101. z(74)=&h3C00007800E800~&&:z(75)=&h1F00036000~&&:z(76)=&h1DFE01E~&&
  102. z(77)=&hEE00000000001E7E~&&:z(78)=&h8307F9E000000000~&&:z(79)=&hE3FC1CE07F1C0000~&&
  103. z(80)=&h381E3FC1C00E0FF0~&&:z(81)=&hC03047F1FF0F0002~&&:z(82)=&hC3FE3FC8C31E7078~&&
  104. z(83)=&h3839C10C83E2~&&:z(84)=&h8180000006071B04~&&:z(85)=&hC2180C00000000C0~&&
  105. z(86)=&h610442E070000000~&&:z(87)=&h381D085B018000~&&:z(88)=&h60348360C~&&:z(89)=&h181B0~&&
  106. z(90)=&h2430000000000000~&&:z(91)=&h30D0C04000000000~&&:z(92)=&h80D00800000~&&
  107. z(93)=&h4070100~&&:z(94)=&h202~&&:z(95)=&h8200000000000000~&&:z(96)=&h1045C0000000000~&&
  108. z(97)=&hEC60000000~&&
  109. dim as _unsigned _integer64 b, i, n, j,d
  110. redim f(320, 240) as double
  111. redim ff(320, 240) as double
  112. dim p(300) as long
  113. for i=1 to 100
  114.         fr = 240*i/100 + 15
  115.         p(i) = _rgb(fr,0,0)
  116.         p(i + 100) = _rgb(255, fr, 0)
  117.         p(i + 200) = _rgb(255, 255, fr)
  119. For rs = 230 To 341.6 Step 37.2
  120.     r = r + 1
  121.     Line (150, rs)-(612.5, rs + 18.6), _RGB32(255, 255, 255), BF
  122.     If r > 3 Then GoTo nex2:
  123.     Line (150, rs + 18.6)-(612.5, rs + 37.2), _RGB32(255, 0, 0), BF
  124. Next rs
  125. i = 0
  126. n = 0
  127. b = z(n)
  128. xstep = 3
  129. ystep = 2
  130. for y=0 to 79-1
  131. for x=0 to 80-1
  132.         if (b and _shl(1~&&, 63)) then
  133.                 line (280 + x*xstep, 150 + y*ystep)-step(xstep,ystep),_rgb(0,0,0),bf
  134.                 f (x + 120, y + 80) = 300
  135.                 ff(x + 120, y + 80) = 300
  136.         end if
  137.         b = _shl(b, 1~&&)
  138.         i=i+1
  139.         if i = 64 then
  140.                 n = n + 1
  141.                 b = z(n)
  142.                 i = 0
  143.         end if
  146. paint (370,190),_rgb(0,0,0)
  147. paint (420,190),_rgb(0,0,0)
  149. _source vvs2
  150. nex2:
  151. r = 0
  152. For fy = 100 To 341.6
  153.     For fx = 150 To 612.5
  154.         t5 = t5 + 1
  155.         cf&(t5) = Point(fx, fy)
  156.     Next fx
  157. Next fy
  158. t = 20
  160.  
  161. 'On Timer(2) GoSub hills:
  162. 'Timer On
  163.  
  164. ii = 0
  165. jj = -1
  167.  
  168.     'Sky
  169.     ii = ii + 1
  170.     If ii >= sw Then
  171.         ii = 0
  172.         jj = Not jj
  173.     End If
  174.  
  175.     If jj Then
  176.         _PutImage (ii, 0)-Step(sw, sh), vs
  177.         _PutImage (ii, 0)-Step(-sw, sh), vs
  178.     Else
  179.         _PutImage (ii + sw, 0)-Step(-sw, sh), vs
  180.         _PutImage (ii - sw, 0)-Step(sw, sh), vs
  181.     End If
  182.  
  183.     'hour$ = Left$(Time$, 2)
  184.     'hour = Val(hour$)
  185.     'If hour < 21 And hour >= 6 Then
  186.         'Paint (2, 2), _RGB32(0, 205, 255)
  187.     'End If
  188.     _PutImage , hills&, 0
  189.     'Flag Pole
  190.     For sz = .25 To 10 Step .25
  191.         Circle (145, 80), sz, _RGB32(122, 128, 166)
  192.     Next sz
  193.     Line (142, 80)-(147, 600), _RGB32(122, 128, 166), BF
  194.  
  195.         _dest vvs2
  196.         _putimage ,vvs
  197.         for y=1 to 240-1
  198.         for x=1 to 320-1
  199.                 dim r as double
  200.                 r = rnd
  201.                 if r > 0.65 then f(x,y) = ff(x,y)
  202.         next
  203.         next
  204.         for y=0 to 240-2
  205.         for x=1 to 320-1
  206.                 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)
  207.                 line (x*xstep - 81, y*ystep - 6)-step(xstep, ystep), p(f(x,y)),bf
  208.         next
  209.         next
  210.  
  211.         _source vvs2
  212.         r = 0
  213.         t5 = 0
  214.         For fy = 100 To 341.6
  215.                 For fx = 150 To 612.5
  216.                         t5 = t5 + 1
  217.                         cf&(t5) = Point(fx, fy)
  218.                 Next fx
  219.         Next fy
  220.         t = 20
  221.         _source 0
  222.         _dest 0
  223.  
  224.     fx2 = fx2 + 1.2
  225.     If fx2 > 5 Then fx2 = 1.2
  226.     For fy = 100 To 341.6
  227.         For fx = 150 To 612.5
  228.             t6 = t6 + 1
  229.                         if cf&(t6) <> _rgb(0,0,0) then
  230.                         PSet ((Sin(fy * 0.017453 / fx2) * t) + fx, (Sin(fx * 0.017453 / fx2) * t) + fy), cf&(t6)
  231.                         end if
  232.         Next fx
  233.     Next fy
  234.  
  235.     t6 = 0
  236.     If tt = 0 Then t = t + 1
  237.     If t > 10 Then tt = 1
  238.     If tt = 1 Then t = t - 1
  239.     If t < -10 Then tt = 0
  240.     a$ = InKey$
  241.     If a$ = Chr$(27) Then End
  242.     'If a$ = " " Then
  243.         GoSub hills:
  244.  
  245.     _Display
  246.     _Limit 50
  248.  
  249. hills:
  250. 'Random Hills
  251. hills& = _NewImage(_Width, _Height, 32)
  252. _Dest hills&
  254. hills = 8'Int(Rnd * 40) + 3
  255. For h = -3 To hills + 1
  256.     hx = 800*h/hills + (ii*8 mod 300) 'Int(Rnd * 800) + 1
  257.     size = 300'Int(Rnd * 450) + 75
  258.     cl = 15'Int(Rnd * 55)
  259.     shape = 0.7'Rnd
  260.     For sz = .25 To size Step .25
  261.         cl = cl + .05
  262.         Circle (hx, 599), sz, _RGB32(10, cl, 20), , , shape
  263.     Next sz
  265. hills = 5'Int(Rnd * 40) + 3
  266. For h = -3 To hills + 1
  267.     hx = 800*h/hills + (ii*5 mod 300) 'Int(Rnd * 800) + 1
  268.     size = 250'Int(Rnd * 450) + 75
  269.     cl = 35'Int(Rnd * 55)
  270.     shape = 0.7'Rnd
  271.     For sz = .25 To size Step .25
  272.         cl = cl + .05
  273.         Circle (hx, 599), sz, _RGB32(10, cl, 20), , , shape
  274.     Next sz
  276. hills = 3'Int(Rnd * 40) + 3
  277. For h = -3 To hills + 1
  278.     hx = 800*h/hills + (ii mod 300) 'Int(Rnd * 800) + 1
  279.     size = 180'Int(Rnd * 450) + 75
  280.     cl = 55'Int(Rnd * 55)
  281.     shape = 0.7'Rnd
  282.     For sz = .25 To size Step .25
  283.         cl = cl + .05
  284.         Circle (hx, 599), sz, _RGB32(10, cl, 20), , , shape
  285.     Next sz
  289.  
  290. function max(a, b)
  291.         if a > b then max = a else max = b'+
  293.  
  294. '//interpolation code by rattrapmax6
  295. Sub MakePalette (sr, sg, sb, er, eg, eb) ' (b+) start and end RGB's ? yes
  296.     Dim i, istart(3), iend(3), ishow(3), rend(3), interpol(3)
  297.  
  298.     interpol(0) = 255
  299.     istart(1) = sr
  300.     istart(2) = sg
  301.     istart(3) = sb
  302.     iend(1) = er
  303.     iend(2) = eg
  304.     iend(3) = eb
  305.     interpol(1) = (istart(1) - iend(1)) / interpol(0)
  306.     interpol(2) = (istart(2) - iend(2)) / interpol(0)
  307.     interpol(3) = (istart(3) - iend(3)) / interpol(0)
  308.     rend(1) = istart(1)
  309.     rend(2) = istart(2)
  310.     rend(3) = istart(3)
  311.  
  312.     For i = 0 To 255
  313.         ishow(1) = rend(1)
  314.         ishow(2) = rend(2)
  315.         ishow(3) = rend(3)
  316.  
  317.         pal(i) = _RGB32(ishow(1), ishow(2), ishow(3))
  318.  
  319.         rend(1) = rend(1) - interpol(1)
  320.         rend(2) = rend(2) - interpol(2)
  321.         rend(3) = rend(3) - interpol(3)
  322.     Next i
  324.  
  325. '//generates random noise.
  326. Sub GenerateNoise ()
  327.     Dim As Long x, y
  328.  
  329.     For x = 0 To nn * twidth - 1
  330.         For y = 0 To theight - 1
  331.             zz = Rnd
  332.             noise(x + y * twidth) = zz
  333.         Next y
  334.     Next x
  335.  
  337.  
  338. Function SmoothNoise (x, y)
  339.     '//get fractional part of x and y
  340.     Dim fractx, fracty, x1, y1, x2, y2, value
  341.     fractx = x - Int(x)
  342.     fracty = y - Int(y)
  343.  
  344.     '//wrap around
  345.     x1 = (Int(x) + nn * twidth) Mod twidth
  346.     y1 = (Int(y) + theight) Mod theight
  347.  
  348.     '//neighbor values
  349.     x2 = (x1 + nn * twidth - 1) Mod twidth
  350.     y2 = (y1 + theight - 1) Mod theight
  351.  
  352.     '//smooth the noise with bilinear interpolation
  353.     value = 0.0
  354.     value = value + fractx * fracty * noise(x1 + y1 * twidth)
  355.     value = value + fractx * (1 - fracty) * noise(x1 + y2 * twidth)
  356.     value = value + (1 - fractx) * fracty * noise(x2 + y1 * twidth)
  357.     value = value + (1 - fractx) * (1 - fracty) * noise(x2 + y2 * twidth)
  358.  
  359.     SmoothNoise = value
  361.  
  362. Function Turbulence (x, y, size)
  363.     Dim value, initialsize
  364.  
  365.     initialsize = size
  366.     While (size >= 1)
  367.         value = value + SmoothNoise(x / size, y / size) * size
  368.         size = size / 2.0
  369.     Wend
  370.     Turbulence = (128.0 * value / initialsize)
  372.  
  373. '//builds the texture.
  374. Sub buildtexture
  375.     Dim x, y
  376.  
  377.     For x = 0 To nn * twidth - 1
  378.         For y = 0 To theight - 1
  379.             texture(x + y * nn * twidth) = Turbulence(x, y, zoom)
  380.         Next y
  381.     Next x
  383.  
  384. '//draws texture to screen.
  385. Sub drawtexture (dx)
  386.     Dim x, y
  387.     Dim As Long c, r, g, b
  388.  
  389.     For x = 0 To twidth - 1
  390.         For y = 0 To theight - 1
  391.             c = pal(texture(((x + dx) + y * nn * twidth)))
  392.             r = _Red(c)
  393.             g = _Green(c)
  394.             b = _Blue(c)
  395.             c = _RGB(r - 0.2 * y, g - 0.2 * y, b - 0.2 * b)
  396.             PSet (x, y), c 'pal(texture(((x + dx) + y * nn*twidth)))
  397.         Next y
  398.     Next x
  400.  
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: SierraKen on February 12, 2022, 06:10:20 pm
LOL Vince, looks like a Pirates Flag in the U.S. I like how the hills also move.
Title: Re: Ken's U.S. Flag version 4 - With moving clouds
Post by: bplus on February 12, 2022, 06:43:44 pm
@vince I offer a different way to move the hills:
Code: QB64: [Select]
  1. _Title "Drawlandscape Parallax test" 'started 2019-03-27
  2. 'test if can get end of landscape level to start for big looping background
  3. '2019-03-27 a more gentle adjustment back to Mountain starting height for
  4. 'more seamless connect of back end to front
  5. '2019-03-27 start this file with parallax drawing test
  6.  
  7.  
  9. Screen _NewImage(800, 600, 32)
  10. _ScreenMove 100, 20
  11. Type parallaxType
  12.     handle As Long
  13.     rate As Single 'number of pixels per frame added to le (leading edge)
  14.     le As Single
  17. nLevels = 6
  18. Dim Shared para(1 To nLevels) As parallaxType
  19.  
  20. Dim Shared scape&
  21. LoadLandscape
  22. scapeWidth = _Width(para(1).handle)
  23. scapeHeight = _Height(para(1).handle)
  24.  
  25. While t < 6000
  26.     Cls
  27.     For i = 1 To nLevels
  28.         If para(i).le + 800 > scapeWidth Then
  29.             te = scapeWidth - para(i).le
  30.             _PutImage (0, 0)-(te, scapeHeight), para(i).handle, 0, (scapeWidth - te, 0)-(scapeWidth, scapeHeight)
  31.             _PutImage (te, 0)-(800, scapeHeight), para(i).handle, 0, (0, 0)-(800 - te, scapeHeight)
  32.  
  33.         Else
  34.             _PutImage (0, 0)-(800, scapeHeight), para(i).handle, 0, (para(i).le, 0)-(para(i).le + 800, scapeHeight)
  35.         End If
  36.  
  37.         para(i).le = para(i).le - para(i).rate
  38.         If para(i).le < 0 Then para(i).le = scapeWidth
  39.     Next
  40.     t = t + 1
  41.     _Display
  42.     _Limit 120
  44.  
  45. Sub LoadLandscape
  46.     cur& = _Dest
  47.     xmax = 800 * 3.25: ymax = 600
  48.     hdl& = 1
  49.     para(hdl&).handle = _NewImage(xmax, ymax, 32)
  50.     _Dest para(hdl&).handle
  51.  
  52.     For i = 0 To ymax
  53.         midInk 0, 0, 128, 128, 128, 200, i / ymax
  54.         Line (0, i)-(xmax, i)
  55.     Next
  56.     'the land
  57.     startH = ymax - 200
  58.     rr = 70: gg = 70: bb = 90
  59.     For mountain = 1 To nLevels
  60.         If mountain > 1 Then
  61.             para(mountain).handle = _NewImage(xmax, ymax, 32)
  62.             _Dest para(mountain).handle
  63.         End If
  64.         Xright = 0
  65.         y = startH
  66.         Color _RGB(rr, gg, bb)
  67.         While Xright < xmax - 50
  68.             ' upDown = local up / down over range, change along Y
  69.             ' range = how far up / down, along X
  70.             upDown = (Rnd * .8 - .4) * (mountain * .5)
  71.             range = Xright + rand%(15, 25) * 2.5 / mountain
  72.             If range > xmax - 50 Then range = xmax - 50
  73.             lastx = Xright - 1
  74.             For x = Xright To range 'need less flat tops
  75.                 test = y + upDown
  76.                 test2 = y - upDown
  77.                 If Abs(test - startH) < .13 * startH Then y = test Else y = test2: upDown = -upDown
  78.                 Line (lastx, y)-(x, ymax), , BF 'just lines weren't filling right
  79.                 lastx = x
  80.             Next
  81.             Xright = range
  82.         Wend
  83.         x = lastx + 1
  84.         dy = (startH - y) / 50 'more gentle adjustment back to start of screen
  85.         While x <= xmax
  86.             y = y + dy
  87.             Line (lastx, y)-(x, ymax), , BF 'just lines weren't filling right
  88.             lastx = x
  89.             x = x + 1
  90.         Wend
  91.         rr = rand%(rr - 15, rr): gg = rand%(gg - 15, gg): bb = rand%(bb - 25, bb)
  92.         If rr < 0 Then rr = 0
  93.         If gg < 0 Then gg = 0
  94.         If bb < 0 Then bb = 0
  95.         startH = startH + mountain * rand%(2, 10)
  96.         para(mountain).le = xmax - 800
  97.         para(mountain).rate = mountain * .5
  98.     Next
  99.     _Dest cur&
  101.  
  102. Function rand% (lo%, hi%)
  103.     rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
  105.  
  106. Sub midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
  107.     Color _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
  109.  
  110.  
Text Only | Text with Attachments