Samples Gallery & Reference > Games

Tetris by _vince

(1/1)

The Librarian:
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: ---randomize timerdeflng a-z dim shared piece(6, 3, 1)dim shared piece_color(6)dim shared size, sw, sh size = 35sw = 10sh = 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)=0piece(0,0,1)=0: piece(0,1,1)=1: piece(0,2,1)=1: piece(0,3,1)=0piece(1,0,0)=1: piece(1,1,0)=1: piece(1,2,0)=1: piece(1,3,0)=1piece(1,0,1)=0: piece(1,1,1)=0: piece(1,2,1)=0: piece(1,3,1)=0piece(2,0,0)=0: piece(2,1,0)=0: piece(2,2,0)=1: piece(2,3,0)=1piece(2,0,1)=0: piece(2,1,1)=1: piece(2,2,1)=1: piece(2,3,1)=0piece(3,0,0)=0: piece(3,1,0)=1: piece(3,2,0)=1: piece(3,3,0)=0piece(3,0,1)=0: piece(3,1,1)=0: piece(3,2,1)=1: piece(3,3,1)=1piece(4,0,0)=0: piece(4,1,0)=1: piece(4,2,0)=1: piece(4,3,0)=1piece(4,0,1)=0: piece(4,1,1)=0: piece(4,2,1)=1: piece(4,3,1)=0piece(5,0,0)=0: piece(5,1,0)=1: piece(5,2,0)=1: piece(5,3,0)=1piece(5,0,1)=0: piece(5,1,1)=1: piece(5,2,1)=0: piece(5,3,1)=0piece(6,0,0)=0: piece(6,1,0)=1: piece(6,2,0)=1: piece(6,3,0)=1piece(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 = 10lines = 0pause = 0putpiece = 0startx = (sw - 4)/2 pn = int(rnd*7)px = startxpy = 1rot = 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 ifloopsystem 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 selectend 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 = -1end 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 = linesend function 

Navigation

[0] Message Index