Author Topic: Tetris by _vince  (Read 1131 times)

Offline The Librarian

  • Moderator
Tetris by _vince
« on: September 27, 2018, 11: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: [Select]
randomize timer
deflng a-z

dim shared piece(6, 3, 1)
dim shared piece_color(6)
dim shared size, sw, sh

size = 35
sw = 10
sh = 20

redim shared board(sw - 1, sh - 1)

piece(0,0,0)=0: piece(0,1,0)=1: piece(0,2,0)=1: piece(0,3,0)=0
piece(0,0,1)=0: piece(0,1,1)=1: piece(0,2,1)=1: piece(0,3,1)=0
piece(1,0,0)=1: piece(1,1,0)=1: piece(1,2,0)=1: piece(1,3,0)=1
piece(1,0,1)=0: piece(1,1,1)=0: piece(1,2,1)=0: piece(1,3,1)=0
piece(2,0,0)=0: piece(2,1,0)=0: piece(2,2,0)=1: piece(2,3,0)=1
piece(2,0,1)=0: piece(2,1,1)=1: piece(2,2,1)=1: piece(2,3,1)=0
piece(3,0,0)=0: piece(3,1,0)=1: piece(3,2,0)=1: piece(3,3,0)=0
piece(3,0,1)=0: piece(3,1,1)=0: piece(3,2,1)=1: piece(3,3,1)=1
piece(4,0,0)=0: piece(4,1,0)=1: piece(4,2,0)=1: piece(4,3,0)=1
piece(4,0,1)=0: piece(4,1,1)=0: piece(4,2,1)=1: piece(4,3,1)=0
piece(5,0,0)=0: piece(5,1,0)=1: piece(5,2,0)=1: piece(5,3,0)=1
piece(5,0,1)=0: piece(5,1,1)=1: piece(5,2,1)=0: piece(5,3,1)=0
piece(6,0,0)=0: piece(6,1,0)=1: piece(6,2,0)=1: piece(6,3,0)=1
piece(6,0,1)=0: piece(6,1,1)=0: piece(6,2,1)=0: piece(6,3,1)=1

screen _newimage(sw*size, sh*size, 32)

piece_color(0) = _rgb(0,200,0)
piece_color(1) = _rgb(200,0,0)
piece_color(2) = _rgb(156,85,211)
piece_color(3) = _rgb(219,112,147)
piece_color(4) = _rgb(0,100,250)
piece_color(5) = _rgb(230,197,92)
piece_color(6) = _rgb(0,128,128)

dim t as double

redraw = -1

speed = 10
lines = 0
pause = 0
putpiece = 0
startx = (sw - 4)/2

pn = int(rnd*7)
px = startx
py = 1
rot = 0

title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
_title title$

t = timer

do
        if (timer - t) > (1/speed) and not pause then
                if valid(pn, px, py + 1, rot) then py = py + 1 else putpiece = -1

                t = timer
                redraw = -1
        end if

        if putpiece then
                if valid(pn, px, py, rot) then
                        n = place(pn, px, py, rot)
                        if n then
                                lines = lines + n
                                title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
                                _title title$
                        end if
                end if

                pn = int(rnd*7)
                px = startx
                py = 0
                rot = 0

                putpiece = 0
                redraw = -1

                if not valid(pn, px, py, rot) then
                        for y=0 to sh-1
                                for x=0 to sw-1
                                        board(x, y) = 0
                                next
                        next
                        lines = 0
                        title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
                        _title title$
                end if
        end if

        if redraw then
                line (0,0)-(sw*size, sh*size),_rgb(0,0,0),bf
                for y=0 to sh - 1
                        for x=0 to sw - 1
                                if board(x, y) <> 0 then
                                        line (x*size, y*size)-step(size-2, size-2), piece_color(board(x, y)-1), bf
                                else
                                        line (x*size, y*size)-step(size-2, size-2), _rgb(50,50,50), b
                                end if
                        next
                next

                for y=0 to 1
                        for x=0 to 3
                                rotate xx, yy, x, y, pn, rot
                                if piece(pn, x, y) then line ((px + xx)*size, (py + yy)*size)-step(size-2, size-2), piece_color(pn), bf
                        next
                next

                _display
                redraw = 0
        end if

        k = _keyhit
        if k then
                shift = _keydown(100304) or _keydown(100303)
                select case k
                case 18432 'up
                        if valid(pn, px, py, (rot + 1) mod 4) then rot = (rot + 1) mod 4
                        pause = 0
                case 19200 'left
                        if shift then
                                for xx=0 to sw-1
                                        if not valid(pn, px - xx, py, rot) then exit for
                                next
                                px = px - xx + 1
                        else
                                if valid(pn, px - 1, py, rot) then px = px - 1
                        end if
                        pause = 0
                case 19712 'right
                        if shift then
                                for xx=px to sw-1
                                        if not valid(pn, xx, py, rot) then exit for
                                next
                                px = xx - 1
                        else
                                if valid(pn, px + 1, py, rot) then px = px + 1
                        end if
                        pause = 0
                case 20480, 32 'down
                        if shift or k = 32 then
                                for yy=py to sh-1
                                        if not valid(pn, px, yy, rot) then exit for
                                next
                                py = yy - 1
                                putpiece = -1
                        else
                                if valid(pn, px, py + 1, rot) then py = py + 1
                        end if
                        pause = 0
                case 112 'p
                        pause = not pause
                case 13 'enter
                        for y=0 to sh-1
                                for x=0 to sw-1
                                        board(x, y) = 0
                                next
                        next
                        pn = int(rnd*7)
                        px = startx
                        py = 0
                        rot = 0
                        putpiece = 0
                        lines = 0
                        title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
                        _title title$
                case 43, 61 'plus
                        if speed < 100 then
                                speed = speed + 1
                                title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
                                _title title$
                        end if
                case 95, 45
                        if speed > 1 then
                                speed = speed - 1
                                title$ = "lines="+ltrim$(str$(lines))+",speed="++ltrim$(str$(speed))
                                _title title$
                        end if
                case 27
                        exit do
                end select

                redraw = -1
        end if
loop
system

sub rotate(xx, yy, x, y, pn, rot)
        select case pn
        case 0
                rot_new = 0
        case 1 to 3
                rot_new = rot mod 2
        case 4 to 6
                rot_new = rot
        end select

        select case rot_new
        case 0
                xx = x
                yy = y
        case 1
                xx = y + 2
                yy = 2 - x
        case 2
                xx = 4 - x
                yy = 1 - y
        case 3
                xx = 2 - y
                yy = x - 1
        end select
end sub

function valid(pn, px, py, rot)
        for y=0 to 1
                for x=0 to 3
                        rotate xx, yy, x, y, pn, rot
                        if py + yy >= 0 then
                                if piece(pn, x, y) then
                                        if (px + xx >= sw) or (px + xx < 0) then
                                                valid = 0
                                                exit function
                                        end if
                                        if (py + yy >= sh) then
                                                valid = 0
                                                exit function
                                        end if
                                        if (py >= 0) then
                                        if board(px + xx, py + yy) then
                                                valid = 0
                                                exit function
                                        end if
                                        end if
                                end if
                        end if
                next
        next

        valid = -1
end function

function place(pn, px, py, rot)
        lines = 0

        for y=0 to 1
                for x=0 to 3
                        rotate xx, yy, x, y, pn, rot
                        if py + yy >= 0 then if piece(pn, x, y) then board(px + xx, py + yy) = pn + 1
                next
        next

        'clear lines
        for y=py-1 to py+2
                if y>=0 and y<sh then
                        clr = -1
                        for x=0 to sw - 1
                                if board(x, y) = 0 then
                                        clr = 0
                                        exit for
                                end if
                        next

                        if clr then
                                lines = lines + 1
                                for yy=y to 1 step -1
                                        for x=0 to sw-1
                                                board(x, yy) = board(x, yy-1)
                                        next
                                next
                        end if
                end if
        next

        place = lines
end function

« Last Edit: September 28, 2018, 12:38:44 PM by The Librarian »