Author Topic: Tetris by _vince  (Read 19335 times)

0 Members and 1 Guest are viewing this topic.

Offline The Librarian

  • Moderator
  • Newbie
  • Posts: 39
Tetris by _vince
« on: September 27, 2018, 10:37:42 pm »
Tetris

Author: @_vince
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=626.0
Version: 2018
Tags: [2d], [game], [tetris]

Description:
clean and simple tetris implementation. you can change variables size, sw, and sh for custom board sizes.

20:55 < _vince> ive said it before but i think tetris is the ultimate test of a
                programmer
20:55 < _vince> as it combines all programming concepts but doesnt demand any
                specialized knowledge


controls:
* arrow keys: movement, up: rotate
* shift + left/right/down: hard left/right/drop
* spacebar: hard drop
* +/-: change speed
* p: pause
* Enter: restart
* Esc: quit


Source Code:
Code: QB64: [Select]
  1. deflng a-z
  2.  
  3. dim shared piece(6, 3, 1)
  4. dim shared piece_color(6)
  5. dim shared size, sw, sh
  6.  
  7. size = 35
  8. sw = 10
  9. sh = 20
  10.  
  11. redim shared board(sw - 1, sh - 1)
  12.  
  13. piece(0,0,0)=0: piece(0,1,0)=1: piece(0,2,0)=1: piece(0,3,0)=0
  14. piece(0,0,1)=0: piece(0,1,1)=1: piece(0,2,1)=1: piece(0,3,1)=0
  15. piece(1,0,0)=1: piece(1,1,0)=1: piece(1,2,0)=1: piece(1,3,0)=1
  16. piece(1,0,1)=0: piece(1,1,1)=0: piece(1,2,1)=0: piece(1,3,1)=0
  17. piece(2,0,0)=0: piece(2,1,0)=0: piece(2,2,0)=1: piece(2,3,0)=1
  18. piece(2,0,1)=0: piece(2,1,1)=1: piece(2,2,1)=1: piece(2,3,1)=0
  19. piece(3,0,0)=0: piece(3,1,0)=1: piece(3,2,0)=1: piece(3,3,0)=0
  20. piece(3,0,1)=0: piece(3,1,1)=0: piece(3,2,1)=1: piece(3,3,1)=1
  21. piece(4,0,0)=0: piece(4,1,0)=1: piece(4,2,0)=1: piece(4,3,0)=1
  22. piece(4,0,1)=0: piece(4,1,1)=0: piece(4,2,1)=1: piece(4,3,1)=0
  23. piece(5,0,0)=0: piece(5,1,0)=1: piece(5,2,0)=1: piece(5,3,0)=1
  24. piece(5,0,1)=0: piece(5,1,1)=1: piece(5,2,1)=0: piece(5,3,1)=0
  25. piece(6,0,0)=0: piece(6,1,0)=1: piece(6,2,0)=1: piece(6,3,0)=1
  26. piece(6,0,1)=0: piece(6,1,1)=0: piece(6,2,1)=0: piece(6,3,1)=1
  27.  
  28. screen _newimage(sw*size, sh*size, 32)
  29.  
  30. piece_color(0) = _rgb(0,200,0)
  31. piece_color(1) = _rgb(200,0,0)
  32. piece_color(2) = _rgb(156,85,211)
  33. piece_color(3) = _rgb(219,112,147)
  34. piece_color(4) = _rgb(0,100,250)
  35. piece_color(5) = _rgb(230,197,92)
  36. piece_color(6) = _rgb(0,128,128)
  37.  
  38.  
  39. redraw = -1
  40.  
  41. speed = 10
  42. lines = 0
  43. pause = 0
  44. putpiece = 0
  45. startx = (sw - 4)/2
  46.  
  47. pn = int(rnd*7)
  48. px = startx
  49. py = 1
  50. rot = 0
  51.  
  52. title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
  53. _title title$
  54.  
  55. t = timer
  56.  
  57.         if (timer - t) > (1/speed) and not pause then
  58.                 if valid(pn, px, py + 1, rot) then py = py + 1 else putpiece = -1
  59.  
  60.                 t = timer
  61.                 redraw = -1
  62.         end if
  63.  
  64.         if putpiece then
  65.                 if valid(pn, px, py, rot) then
  66.                         n = place(pn, px, py, rot)
  67.                         if n then
  68.                                 lines = lines + n
  69.                                 title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
  70.                                 _title title$
  71.                         end if
  72.                 end if
  73.  
  74.                 pn = int(rnd*7)
  75.                 px = startx
  76.                 py = 0
  77.                 rot = 0
  78.  
  79.                 putpiece = 0
  80.                 redraw = -1
  81.  
  82.                 if not valid(pn, px, py, rot) then
  83.                         for y=0 to sh-1
  84.                                 for x=0 to sw-1
  85.                                         board(x, y) = 0
  86.                                 next
  87.                         next
  88.                         lines = 0
  89.                         title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
  90.                         _title title$
  91.                 end if
  92.         end if
  93.  
  94.         if redraw then
  95.                 line (0,0)-(sw*size, sh*size),_rgb(0,0,0),bf
  96.                 for y=0 to sh - 1
  97.                         for x=0 to sw - 1
  98.                                 if board(x, y) <> 0 then
  99.                                         line (x*size, y*size)-step(size-2, size-2), piece_color(board(x, y)-1), bf
  100.                                 else
  101.                                         line (x*size, y*size)-step(size-2, size-2), _rgb(50,50,50), b
  102.                                 end if
  103.                         next
  104.                 next
  105.  
  106.                 for y=0 to 1
  107.                         for x=0 to 3
  108.                                 rotate xx, yy, x, y, pn, rot
  109.                                 if piece(pn, x, y) then line ((px + xx)*size, (py + yy)*size)-step(size-2, size-2), piece_color(pn), bf
  110.                         next
  111.                 next
  112.  
  113.                 _display
  114.                 redraw = 0
  115.         end if
  116.  
  117.         k = _keyhit
  118.         if k then
  119.                 shift = _keydown(100304) or _keydown(100303)
  120.                 select case k
  121.                 case 18432 'up
  122.                         if valid(pn, px, py, (rot + 1) mod 4) then rot = (rot + 1) mod 4
  123.                         pause = 0
  124.                 case 19200 'left
  125.                         if shift then
  126.                                 for xx=0 to sw-1
  127.                                         if not valid(pn, px - xx, py, rot) then exit for
  128.                                 next
  129.                                 px = px - xx + 1
  130.                         else
  131.                                 if valid(pn, px - 1, py, rot) then px = px - 1
  132.                         end if
  133.                         pause = 0
  134.                 case 19712 'right
  135.                         if shift then
  136.                                 for xx=px to sw-1
  137.                                         if not valid(pn, xx, py, rot) then exit for
  138.                                 next
  139.                                 px = xx - 1
  140.                         else
  141.                                 if valid(pn, px + 1, py, rot) then px = px + 1
  142.                         end if
  143.                         pause = 0
  144.                 case 20480, 32 'down
  145.                         if shift or k = 32 then
  146.                                 for yy=py to sh-1
  147.                                         if not valid(pn, px, yy, rot) then exit for
  148.                                 next
  149.                                 py = yy - 1
  150.                                 putpiece = -1
  151.                         else
  152.                                 if valid(pn, px, py + 1, rot) then py = py + 1
  153.                         end if
  154.                         pause = 0
  155.                 case 112 'p
  156.                         pause = not pause
  157.                 case 13 'enter
  158.                         for y=0 to sh-1
  159.                                 for x=0 to sw-1
  160.                                         board(x, y) = 0
  161.                                 next
  162.                         next
  163.                         pn = int(rnd*7)
  164.                         px = startx
  165.                         py = 0
  166.                         rot = 0
  167.                         putpiece = 0
  168.                         lines = 0
  169.                         title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
  170.                         _title title$
  171.                 case 43, 61 'plus
  172.                         if speed < 100 then
  173.                                 speed = speed + 1
  174.                                 title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
  175.                                 _title title$
  176.                         end if
  177.                 case 95, 45
  178.                         if speed > 1 then
  179.                                 speed = speed - 1
  180.                                 title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
  181.                                 _title title$
  182.                         end if
  183.                 case 27
  184.                         exit do
  185.                 end select
  186.  
  187.                 redraw = -1
  188.         end if
  189.  
  190. sub rotate(xx, yy, x, y, pn, rot)
  191.         select case pn
  192.         case 0
  193.                 rot_new = 0
  194.         case 1 to 3
  195.                 rot_new = rot mod 2
  196.         case 4 to 6
  197.                 rot_new = rot
  198.         end select
  199.  
  200.         select case rot_new
  201.         case 0
  202.                 xx = x
  203.                 yy = y
  204.         case 1
  205.                 xx = y + 2
  206.                 yy = 2 - x
  207.         case 2
  208.                 xx = 4 - x
  209.                 yy = 1 - y
  210.         case 3
  211.                 xx = 2 - y
  212.                 yy = x - 1
  213.         end select
  214.  
  215. function valid(pn, px, py, rot)
  216.         for y=0 to 1
  217.                 for x=0 to 3
  218.                         rotate xx, yy, x, y, pn, rot
  219.                         if py + yy >= 0 then
  220.                                 if piece(pn, x, y) then
  221.                                         if (px + xx >= sw) or (px + xx < 0) then
  222.                                                 valid = 0
  223.                                                 exit function
  224.                                         end if
  225.                                         if (py + yy >= sh) then
  226.                                                 valid = 0
  227.                                                 exit function
  228.                                         end if
  229.                                         if (py >= 0) then
  230.                                         if board(px + xx, py + yy) then
  231.                                                 valid = 0
  232.                                                 exit function
  233.                                         end if
  234.                                         end if
  235.                                 end if
  236.                         end if
  237.                 next
  238.         next
  239.  
  240.         valid = -1
  241.  
  242. function place(pn, px, py, rot)
  243.         lines = 0
  244.  
  245.         for y=0 to 1
  246.                 for x=0 to 3
  247.                         rotate xx, yy, x, y, pn, rot
  248.                         if py + yy >= 0 then if piece(pn, x, y) then board(px + xx, py + yy) = pn + 1
  249.                 next
  250.         next
  251.  
  252.         'clear lines
  253.         for y=py-1 to py+2
  254.                 if y>=0 and y<sh then
  255.                         clr = -1
  256.                         for x=0 to sw - 1
  257.                                 if board(x, y) = 0 then
  258.                                         clr = 0
  259.                                         exit for
  260.                                 end if
  261.                         next
  262.  
  263.                         if clr then
  264.                                 lines = lines + 1
  265.                                 for yy=y to 1 step -1
  266.                                         for x=0 to sw-1
  267.                                                 board(x, yy) = board(x, yy-1)
  268.                                         next
  269.                                 next
  270.                         end if
  271.                 end if
  272.         next
  273.  
  274.         place = lines
  275.  

screenshot.png
* Tetris.bas (Filesize: 9.53 KB, Downloads: 485)
« Last Edit: March 06, 2020, 05:14:19 am by Qwerkey »