« previous next »
Pages: [1] 2   Go Down

Author Topic: Ken's U.S. Flag version 4 - With moving clouds  (Read 7089 times)

0 Members and 1 Guest are viewing this topic.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Ken's U.S. Flag version 4 - With moving clouds
« 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.)
« Last Edit: February 09, 2022, 01:10:40 pm by SierraKen »
Logged

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #1 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.  

* USAFBTheStarSpangledBannerChoral.mp3 (Filesize: 1.03 MB, Downloads: 183)
« Last Edit: February 09, 2022, 01:13:23 pm by SierraKen »
Logged

Offline DANILIN

  • Forum Regular
  • Posts: 128
    • View Profile
    • Danilin youtube
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #2 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
Logged
Russia looks world from future. big data is peace data.
https://youtube.com/playlist?list=PLBBTP9oVY7IagpH0g9FNUQ8JqmHwxDDDB
i never recommend anything to anyone and always write only about myself

FellippeHeitor

  • Guest
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #3 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.
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #4 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
Logged

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #5 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
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #6 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.  
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #7 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.  
Logged

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #8 on: February 09, 2022, 12:58:19 pm »
When I change hills the memory does tick upward in Task Manager.
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #9 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.  
Logged

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #10 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.
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #11 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?
Logged

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #12 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
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #13 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.
Logged

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Ken's U.S. Flag version 4 - With moving clouds
« Reply #14 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
Logged
Pages: [1] 2   Go Up
« previous next »