Author Topic: 4 Letter Word Invaders Game  (Read 7922 times)

0 Members and 1 Guest are viewing this topic.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: 4 Letter Word Invaders Game
« Reply #15 on: February 08, 2022, 02:46:41 pm »
Great rendition B+! My games do have the score in the _TITLE bar. B+, the difference between yours and mine is that on yours the player has to click the right sequence as well, mine can be any of them on the screen. That is probably what got me stuck to begin with.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: 4 Letter Word Invaders Game
« Reply #16 on: February 08, 2022, 02:54:30 pm »
Yeah I tried to figure out what you were doing but my brain got frazzled specially on that gosub.

So I tried to write a simple version with the basic game for clarity.

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: 4 Letter Word Invaders Game
« Reply #17 on: February 08, 2022, 04:48:47 pm »
B+ mod!

Code: QB64: [Select]
  1. _Title "Quick Falling Letters Game B+ mod" 'b+ 2022-02-08
  2.  
  3. const nn = 1
  4. Const twidth = 640, theight = 480, zoom = 128
  5. Dim Shared noise(nn*twidth * theight) '//the noise array
  6. Dim Shared texture(nn*twidth * theight) '//texture array
  7. Dim Shared pal(256) As _Unsigned Long '//color palette
  8.  
  9. Dim letters$(1 To 25), lx(1 To 25) As Integer ' screen 0 25 lines 80 letters across
  10. Dim hits, letterPos, i, K$, GameOver
  11.  
  12. screen _newimage(640,480,32)
  13. MakePalette 255, 155, 255, 10, 100, 180
  14. GenerateNoise
  15. buildtexture
  16.  
  17. vs = _newimage(twidth, theight, 32)
  18. drawtexture 0
  19.  
  20. ii = 0
  21. jj = -1
  22. kk = 0
  23.         kk = kk + 1
  24.         ii = ii + 1
  25.         if ii >= 640 then
  26.                 ii = 0
  27.                 jj = not jj
  28.         end if         
  29.  
  30.         if jj then
  31.                 _putimage (ii , 0)-step(640,480), vs
  32.                 _putimage (ii , 0)-step(-640,480), vs
  33.         else
  34.                 _putimage (ii + 640, 0)-step(-640,480), vs
  35.                 _putimage (ii - 640 , 0)-step(640,480), vs
  36.         end if
  37.  
  38.     'Cls
  39.         if kk mod 50 = 0 then
  40.                 letterPos = letterPos + 1 ' generate new letter at each round
  41.                 If letterPos > 24 Then GameOver = -1
  42.                 For i = letterPos - 1 To 1 Step -1 ' cycle letters and positions down
  43.                         letters$(i + 1) = letters$(i)
  44.                         lx(i + 1) = lx(i)
  45.                 Next
  46.                 letters$(1) = Chr$(Int(Rnd * 26) + 97) ' start a new letter
  47.                 lx(1) = Int(Rnd * 80) + 1 ' at a new place
  48.                 K$ = InKey$ ' check key presses for match to current letterPos
  49.                 While K$ = letters$(letterPos) ' catch up with all keypresses
  50.                         hits = hits + 1 '            add to score
  51.                         letterPos = letterPos - 1
  52.                         K$ = InKey$ '                check next keypress
  53.                 Wend
  54.         end if
  55.  
  56.         For i = 1 To letterPos 'show board what's left of letters
  57.                 Locate i, lx(i): Print letters$(i);
  58.         Next
  59.         Locate 25, 36: Print "Hits:"; hits
  60.  
  61.         _display
  62.     _Limit 50
  63. Loop Until GameOver
  64. Locate 25, 26: Print "Game Over"
  65.  
  66. '//interpolation code by rattrapmax6
  67. Sub MakePalette (sr, sg, sb, er, eg, eb) ' (b+) start and end RGB's ? yes
  68.     Dim i, istart(3), iend(3), ishow(3), rend(3), interpol(3)
  69.  
  70.     interpol(0) = 255
  71.     istart(1) = sr
  72.     istart(2) = sg
  73.     istart(3) = sb
  74.     iend(1) = er
  75.     iend(2) = eg
  76.     iend(3) = eb
  77.     interpol(1) = (istart(1) - iend(1)) / interpol(0)
  78.     interpol(2) = (istart(2) - iend(2)) / interpol(0)
  79.     interpol(3) = (istart(3) - iend(3)) / interpol(0)
  80.     rend(1) = istart(1)
  81.     rend(2) = istart(2)
  82.     rend(3) = istart(3)
  83.  
  84.     For i = 0 To 255
  85.         ishow(1) = rend(1)
  86.         ishow(2) = rend(2)
  87.         ishow(3) = rend(3)
  88.  
  89.         pal(i) = _RGB32(ishow(1), ishow(2), ishow(3))
  90.  
  91.         rend(1) = rend(1) - interpol(1)
  92.         rend(2) = rend(2) - interpol(2)
  93.         rend(3) = rend(3) - interpol(3)
  94.     Next i
  95.  
  96. '//generates random noise.
  97. Sub GenerateNoise ()
  98.     Dim As Long x, y
  99.  
  100.     For x = 0 To nn*twidth - 1
  101.         For y = 0 To theight - 1
  102.                         zz = rnd
  103.             noise(x + y * twidth) = zz
  104.         Next y
  105.     Next x
  106.  
  107.  
  108. Function SmoothNoise (x, y)
  109.     '//get fractional part of x and y
  110.     Dim fractx, fracty, x1, y1, x2, y2, value
  111.     fractx = x - Int(x)
  112.     fracty = y - Int(y)
  113.  
  114.     '//wrap around
  115.     x1 = (Int(x) + nn*twidth) Mod twidth
  116.     y1 = (Int(y) + theight) Mod theight
  117.  
  118.     '//neighbor values
  119.     x2 = (x1 + nn*twidth - 1) Mod twidth
  120.     y2 = (y1 + theight - 1) Mod theight
  121.  
  122.     '//smooth the noise with bilinear interpolation
  123.     value = 0.0
  124.     value = value + fractx * fracty * noise(x1 + y1 * twidth)
  125.     value = value + fractx * (1 - fracty) * noise(x1 + y2 * twidth)
  126.     value = value + (1 - fractx) * fracty * noise(x2 + y1 * twidth)
  127.     value = value + (1 - fractx) * (1 - fracty) * noise(x2 + y2 * twidth)
  128.  
  129.     SmoothNoise = value
  130.  
  131. Function Turbulence (x, y, size)
  132.     Dim value, initialsize
  133.  
  134.     initialsize = size
  135.     While (size >= 1)
  136.         value = value + SmoothNoise(x / size, y / size) * size
  137.         size = size / 2.0
  138.     Wend
  139.     Turbulence = (128.0 * value / initialsize)
  140.  
  141. '//builds the texture.
  142. Sub buildtexture
  143.     Dim x, y
  144.  
  145.     For x = 0 To nn*twidth - 1
  146.         For y = 0 To theight - 1
  147.             texture(x + y * nn*twidth) = Turbulence(x, y, zoom)
  148.         Next y
  149.     Next x
  150.  
  151. '//draws texture to screen.
  152. Sub drawtexture (dx )
  153.     Dim x, y
  154.         dim as long c, r, g, b
  155.  
  156.     For x = 0 To twidth - 1
  157.         For y = 0 To theight - 1
  158.                         c = pal(texture(((x + dx) + y * nn*twidth)))
  159.                         r = _red(c)
  160.                         g = _green(c)
  161.                         b = _blue(c)
  162.                         c = _rgb(r - 0.2*y, g - 0.2*y, b - 0.2*b)
  163.             PSet (x, y), c'pal(texture(((x + dx) + y * nn*twidth)))
  164.         Next y
  165.     Next x
  166.  

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: 4 Letter Word Invaders Game
« Reply #18 on: February 08, 2022, 06:11:27 pm »
LOL totally cool Vince. 1980's text game turned into mid 1990's Windows 95 type game. :)))

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: 4 Letter Word Invaders Game
« Reply #19 on: February 08, 2022, 07:11:03 pm »
And still it could be made so much better with:
Code: QB64: [Select]