Tetris
#1
Code:
'Tetris QB64. Writed Petr. About SUBs and Functions:

'---------------- I N F O ------------------
'SUB cti is for reading blocks from DATA in program to RAM
'SUB Hejbej (hejbej = move) is for moving blocks on the screen
'SUB Kresli (Kresli = paint) is for drawing blocks from array to screen
'FUNCTION Collis - Tetris collission detection. Return 0 if block free flight, 1 if block is crashed to bottom, 2 if block is crashed to other block, 3 if is full line
'SUB RecStin - is something as "shadow" area. Contains last block positions (step back) and block is first moved there (not displayed on screen) so is collision do,
'SUB Preview - show next block to fly on screen. Always in position ZERO (as is draw in DATAs)
'SUB rada - (rada = line) solution if is full line - create on screen block red line and then shift if line explode and write it to arrays
'FUNCTION Sirka - (Sirka = width) - return block width (from first one)
'FUNCTION Vyska - (Vyska = height) - return block height from first one
'SUB Napis - print text in quad mode to screen
'SUB i32to256 - insert pictures contains 256 colors to screen. Program run in SCREEN 13 but LOADIMAGE load it as 32 bit images. This solved it.
'SUB Zdivo - (zdivo = wall) insert "?" to image
'SUB ViewLevel show level number
'SUB Constructor extract files from multifile PMF, its own solution
'SUB Destructor kill extracted files from disk previously extracted from PMF using Constructor but not own PMF.
'SUB Textar set frames number to correct characters from PBF - the same format is used in Volleyball game, PBF editor is not released,
'FUNCTION Reader - reads head from PBF, return frame size (widht and heigt are the same, its used as quad) and calculate and return FRAMES (number frames in file)
'SUB Rozpis create texts on screen from arrays SN, thats outputs from PBF
'FUNCTION DECtoBIN$ - return decimaly number as binary string. Its used, because data in PBF are ALL writed as binary mask
'SUB Allow_poloha - test if is pressed arrow up or space, if is possible rotating blocks. This is not accepted if is not enough place for rotation.
'SUB musica - universal sound sub. If is changed input string (is shared, not as parameter) then it set volume down, loaded next music and return volume back. Linear.
'SUB Allow_X_Minus and SUB Allow_X_Plus - test if is possible move blocks to left or to right. Run game in mode "Glue" to show how Tetris works without this functions.
'SUB INI_Loader and SUB INI_Saver - Load or save INI configuration file
'SUB menu - main menu
'FUNCTION Confirm_Quad - its set box used in menu for selecting game type
'FUNCTIOM Tlacitko - (Tlacitko = Button) create DONE button and return 1 if is pressed
'SUB Efekt - play bomb sound if is one line full and explode

'All used sounds in game are from freesound.org, soundbible.com or other free sound forums and are not my own. All used pictures are from internet from free downloadable sites.
'--------------------------------------------

REDIM SHARED ConfirmQuad(10) AS _BYTE 'do tohoto pole se budou ukladat pozice tlacitek 'Arrays for "DONE" buttons
DIM SHARED GameSound, GameClicks, Glue, GameType AS _UNSIGNED _BYTE 'INI values if is none INI file
GameType = 0
GameSound = 1
GameClicks = 1
Glue = 0 '                              GLUE is "glue" effect, found between developing this program. Its really small bug but can be used for playing in other mode. If is enabled and player
'                                       move piece between other piece in direction to this second piece, then move this piece is stoped in this position and game continue.
SCREEN 13: _FULLSCREEN
napis "Tetris", 5, 30, 50, 30
_DISPLAY

INILoader


IF NOT _FILEEXISTS("tetris.pmf") THEN PRINT "Error. Tetris.pmf not found!": SLEEP 3: SYSTEM
Constructor "tetris.pmf"
DIM SHARED Big, music$, newgame, Sco
REDIM SHARED Sn(frames) AS STRING
Big = reader("chars.pbf")



REDIM SHARED obr(100, 125)
REDIM SHARED stin(100, 125)
REDIM SHARED krokzpet(100, 125)


DIM SHARED posX, posY, oldPosX, oldPosY
CONST Left = 10 '                           Left maximum
CONST Right = 110 '                         Right maximum
DIM SHARED Size, Score, Picture$
posY = 50 '                                 blocks start position
posX = 100
Predpoved = -1 '                            for next block preview
Level = 0

menu
INILoader '                                Load game settings. Show to line 176
CLS
ViewLevel: _DISPLAY
start:
poloha = 0
posY = 50
posX = 70



rada '                                      control if is some line full or not



'                                           spaghetti block for preview
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////
generuj:

SELECT CASE GameType
    CASE 0 'easy game uses 10 types flags OK
        RANDOMIZE TIMER
        IF tvar = 0 THEN tvar = CINT(RND * 10) ELSE tvar = Predpoved
        Predpoved = CINT(RND * 10)
        RESTORE easy
        '  PredpovedPass = 0: TvarPass = 0
        FOR eas = 1 TO 10
            READ easy
            IF easy = tvar THEN GOTO OK
        NEXT eas
        tvar = 0
        GOTO generuj
        OK:
        IF Predpoved > -1 THEN
            RESTORE easy
            FOR eas = 1 TO 10
                READ easy
                IF Predpoved = easy THEN GOTO OKfinal
            NEXT eas
            Predpoved = CINT(RND * 10)
            GOTO OK
        END IF
    CASE 1
        RANDOMIZE TIMER
        IF tvar = 0 THEN tvar = CINT(RND * 13) ELSE tvar = Predpoved
        Predpoved = CINT(RND * 13)
        RESTORE medium
        FOR eas = 1 TO 13
            READ medium
            IF medium = tvar THEN GOTO OK2
        NEXT eas
        tvar = 0
        GOTO generuj
        OK2:
        IF Predpoved > -1 THEN
            RESTORE medium
            FOR eas = 1 TO 13
                READ medium
                IF Predpoved = medium THEN GOTO OKfinal
            NEXT eas
            Predpoved = CINT(RND * 13)
            GOTO OK2
        END IF

    CASE 2
        RANDOMIZE TIMER
        IF tvar = 0 THEN tvar = CINT(RND * 15) ELSE tvar = Predpoved
        Predpoved = CINT(RND * 15)
        FOR eas = 1 TO 15
            IF eas = tvar THEN GOTO OK3
        NEXT eas
        tvar = 0
        GOTO generuj
        OK3:
        IF Predpoved > -1 THEN
            FOR eas = 1 TO 15
                IF Predpoved = eas THEN GOTO OKfinal
            NEXT eas
            Predpoved = CINT(RND * 15)
            GOTO OK3
        END IF
END SELECT
OKfinal:
'---------------------------------------------------------------------------------------------
'                                    spaghetti block end


SELECT CASE tvar ' Some blocks uses others size (arrays size). Here are set.
    CASE 0 TO 5, 8, 9 TO 15: Size = 3
    CASE 6: Size = 2
    CASE 7: Size = 5
END SELECT
REDIM SHARED tet(1 TO Size, 1 TO Size)

cti tvar '                           Read concrete block from DATA
restart:
WHILE i& <> 27

    SELECT CASE GameType '          Game speed settings. Its obviously on setup settings in game (menu difficulty), previously loaded from INI file. IF INI NOT EXISTS, is created automaticaly new using basing settings
        CASE 0: speedUp = 0.35 '    See to spaghetti block. To SELECT CASE GameType. It is loaded from INI file (case number) and set how blocks for how settings can be used.
        CASE 1: speedUp = 0.45
        CASE 2: speedUp = 0.55
    END SELECT


    i& = _KEYHIT
    IF i& THEN delay = delay + .03
    smerY = 0
    oldPosX = posX
    oldPosY = posY
    SELECT CASE i&
        CASE 27: menu: i& = 0: cntGame = 1: GOTO restart
        CASE 32, 18432: Allow_Poloha 'Allow rotation IF IS POSSIBLE
        CASE 19200: IF Glue THEN posX = posX - 5 ELSE Allow_X_Minus ' Allow positionX for blocks seting on screen IF IT IS POSSIBLE
        CASE 19712: IF Glue THEN posX = posX + 5: ELSE Allow_X_Plus 'the same as previous case for second direction
        CASE 20480: posY = posY + 5 '                                block is moved down. Always, if is not Collis more than zero, but is need shifting down for using in shadow array
    END SELECT



    LeftCorrect = 0
    IF tvar = 9 AND poloha = 2 THEN LeftCorrect = 5 '               Beacuase some blocks are 3x3 and some 5x5 or 4x4, this is on screen correction for correct view
    IF tvar = 10 AND poloha = 2 THEN LeftCorrect = 5
    IF tvar = 11 AND poloha = 2 THEN LeftCorrect = 5
    IF tvar = 12 AND poloha = 1 THEN LeftCorrect = 5




    IF posX < Left - LeftCorrect THEN posX = Left - LeftCorrect '      Test if block is in correct area in quad for blocks on screen
    IF posX > Right + (5 * Sirka) THEN posX = Right + (5 * Sirka) 'ok
    IF _EXIT THEN Destructor "tetris.pmf": SYSTEM


    SELECT CASE Level '0 is invalid value
        CASE 1: Picture$ = "01.gif": music$ = "loop.mp3" '              Sound loops for listening in game ALL FREE.
        CASE 2: Picture$ = "02.gif": music$ = "loop2.mp3"
        CASE 3: Picture$ = "03.gif": music$ = "loop3.mp3"
        CASE 4: Picture$ = "04.gif": music$ = "loop4.mp3"
        CASE 5: Picture$ = "05.gif": music$ = "loop5.mp3"
        CASE 6: Picture$ = "06.gif": music$ = "loop6.mp3"
        CASE 7: Picture$ = "07.gif": music$ = "loop7.mp3"
        CASE 8: Picture$ = "08.gif": music$ = "loop4.mp3"
    END SELECT

    ' ////////////////////// mazani obrazu po pruletu ////////////////////////////////////
    musica '                                                               Start sound playing (SUB alone solve if it is enbled or disabled)


    IF TIMER > delay THEN delay = TIMER + (.95 - (speedUp + (Level / 10))): posY = posY + 5 ' variable delay in this program is for time to fly block down.

    FOR ZY = 1 TO Size
        FOR ZX = 1 TO Size
            krokzpet(((posX - Left) / 5) + ZX, ((posY - Left) / 5) + ZY) = tet(ZX, ZY) '      write new array - recalculate on screen positions to array positions (my fault, bad concept, but works)
        NEXT ZX
    NEXT ZY


    SELECT CASE collis '                                                                     Colission detection
        CASE 0
            FOR ZY = 1 TO Size ' 3
                FOR ZX = 1 TO Size ' 3
                    IF tet(ZX, ZY) = 1 THEN obr(((oldPosX - Left) / 5) + ZX, ((oldPosY - Left) / 5) + ZY) = 0 'Free blocks in fly if is none collision from array
                NEXT ZX
            NEXT ZY

        CASE 1
            delay = TIMER + .1 '                                                                               This is after block is on the bottom
            posY = 50
            stav = 0
            IF GameClicks THEN _SNDPLAYFILE ("ozem.ogg")
            GOTO start
        CASE 2
            delay = TIMER + .1
            stav = 0
            posY = 50
            posX = 100 'dopad tvaru na tvar                                                                    Collision block to block
            IF GameClicks THEN _SNDPLAYFILE ("osebe.wav")
            recstin
            GOTO start
        CASE 3
            IF GameClicks THEN _SNDPLAYFILE ("strop.mp3")
            napis " Game ", 5, 40, 42, 40 'je zapleno po strop                                                 Collision - minimal one block is in upper position
            napis " Over ", 5, 40, 110, 40 '
            cntGame = 0: Score = 0: Level = 1
            _DISPLAY
            SLEEP 4
            'reset matic
            REDIM obr(100, 125) '                                                                               matrix reset
            REDIM stin(100, 125)
            REDIM krokzpet(100, 125)
            menu
    END SELECT
    '//////////////////////////////////////////////////////////////////////////////////////////////////

    'malovani snimku s babou vola RADA - po odbouchnuti rady se snimek prekresli

    '--------------------------------------   ovladani natoceni kostky   ------------------------------
    IF tvar = 2 THEN poloha = 0 '                                                                               rotation for blocks driving. Some block using one position, some two and some four. This here using one.
    IF tvar = 5 THEN poloha = 0
    IF tvar = 15 THEN poloha = 0



    Hejbej tvar, poloha '                                                                                       Hejbej = MOVE   tvar is block number (see to DATA), poloha is rotation 0 to 3

    '-------------------------------------------------------------------------------------------------------
    'detekce polohy kosky po jejim nacteni

    'detekce dopadu

    FOR ZY = 1 TO Size
        FOR ZX = 1 TO Size
            IF tet(ZX, ZY) = 1 THEN obr(((posX - Left) / 5) + ZX, ((posY - Left) / 5) + ZY) = tet(ZX, ZY) '   This translate points from array to screen
        NEXT ZX
    NEXT ZY


    CLS


    PCOPY 1, _DISPLAY 'jen pro obnovu fotky s babou                                                          Save current picture to memory

    LINE (14, 50)-(136, 196), 18, BF '                                                                       Draw playing area
    LINE (14, 50)-(136, 196), 15, B
    napis " QB64", 2, 25, 90, 1 '                                                                            playing area background text
    napis "Tetris", 2, 25, 130, 1

    kresli tet() '                                                                                           show block on screen
    menupreview = 0
    preview Predpoved, 140, 0 '                                                                              show next block - preview
    Zdivo Sco '                                                                                              rewrite photo by wall
    textar "Score:", -20, -2: textar LTRIM$(STR$(Score)), 60, -2 '                                           texts created from binary records in PBF file
    textar "Level:", 190, -2: textar LTRIM$(STR$(Level)), 270, -2
    _DISPLAY
    _LIMIT 150

WEND
menu
_KEYCLEAR: GOTO start '                                                                                       After presing ESC return to menu and delete keyboard and mouse buffer
Destructor "tetris.pmf" '                                                                                     Delete extracted files. Unacessable program area

SYSTEM

easy: '                                                                                                      how blocks are enabled for easy game type
DATA 1,2,3,4,5,6,7,9,10,11

medium: '                                                                                                    how blocks are enabled for medium game type
DATA 1,2,3,4,5,6,7,8,9,10,11,12,14

kostka:
DATA 1,1,1
DATA 1,0,0
DATA 1,0,0


kostka1: 'rotace jen dvema zpusoby  OK
DATA 1,0,0
DATA 1,0,0
DATA 1,0,0



kostka2: 'zakazat rotaci            OK                                                                          own blocks used in game. 1 is point 5 x 5 on screen, zero is nothing.
DATA 0,0,0
DATA 0,0,0
DATA 1,0,0


kostka3:

DATA 0,0,1
DATA 1,1,1
DATA 1,0,0

kostka4:
DATA 0,1,0
DATA 0,1,0
DATA 1,1,1


kostka5: 'zakazat rotaci
DATA 0,0,0
DATA 1,1,0
DATA 1,1,0

kostka6:
DATA 1,0
DATA 1,1

kostka7: '5
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0
DATA 1,0,0,0,0


kostka8:
DATA 0,1,0
DATA 1,1,1
DATA 0,1,0


kostka9:
DATA 0,1,0
DATA 1,1,0
DATA 1,0,0

kostka10:
DATA 1,0,0
DATA 1,1,0
DATA 0,1,0

kostka11:
DATA 1,0,0
DATA 1,1,0
DATA 1,0,0

kostka12:
DATA 1,0,1
DATA 0,1,0
DATA 0,0,0

kostka13:
DATA 1,0,1
DATA 1,0,1
DATA 1,1,1

kostka14:
DATA 1,0,0
DATA 0,1,0
DATA 0,0,1

kostka15:

DATA 1,0,1
DATA 0,1,0
DATA 1,0,1



'-----------------------------------------------------------------------------------------------------------------------
SUB cti (w AS _UNSIGNED _BYTE) '                 'Is here better WAY HOW send parameter (label name) to RESTORE and READ used in SUB from my loop?
    'cislem W predam cislo toho co chci
    SELECT CASE w
        CASE 0: RESTORE kostka
        CASE 1: RESTORE kostka1
        CASE 2: RESTORE kostka2
        CASE 3: RESTORE kostka3
        CASE 4: RESTORE kostka4
        CASE 5: RESTORE kostka5
        CASE 6: RESTORE kostka6
        CASE 7: RESTORE kostka7
        CASE 8: RESTORE kostka8

        CASE 9: RESTORE kostka9
        CASE 10: RESTORE kostka10
        CASE 11: RESTORE kostka11
        CASE 12: RESTORE kostka12
        CASE 13: RESTORE kostka13
        CASE 14: RESTORE kostka14
        CASE 15: RESTORE kostka15

    END SELECT

    FOR kostkaY = 1 TO Size
        FOR kostkaX = 1 TO Size ' 3
            SELECT CASE w
                CASE 0: READ kostka: tet(kostkaX, kostkaY) = kostka
                CASE 1: READ kostka1: tet(kostkaX, kostkaY) = kostka1
                CASE 2: READ kostka2: tet(kostkaX, kostkaY) = kostka2
                CASE 3: READ kostka3: tet(kostkaX, kostkaY) = kostka3
                CASE 4: READ kostka4: tet(kostkaX, kostkaY) = kostka4
                CASE 5: READ kostka5: tet(kostkaX, kostkaY) = kostka5
                CASE 6: READ kostka6: tet(kostkaX, kostkaY) = kostka6
                CASE 7: READ kostka7: tet(kostkaX, kostkaY) = kostka7
                CASE 8: READ kostka8: tet(kostkaX, kostkaY) = kostka8

                CASE 9: READ kostka9: tet(kostkaX, kostkaY) = kostka9
                CASE 10: READ kostka10: tet(kostkaX, kostkaY) = kostka10
                CASE 11: READ kostka11: tet(kostkaX, kostkaY) = kostka11
                CASE 12: READ kostka12: tet(kostkaX, kostkaY) = kostka12
                CASE 13: READ kostka13: tet(kostkaX, kostkaY) = kostka13
                CASE 14: READ kostka14: tet(kostkaX, kostkaY) = kostka14
                CASE 15: READ kostka15: tet(kostkaX, kostkaY) = kostka15

            END SELECT

    NEXT: NEXT
END SUB


SUB Hejbej (Tvar, Poloha) 'Hejbej is the same as "MOVE" english. Sub move flags on 4 ways

    SELECT CASE Tvar
        CASE 0: RESTORE kostka
        CASE 1: RESTORE kostka1
        CASE 2: RESTORE kostka2
        CASE 3: RESTORE kostka3
        CASE 4: RESTORE kostka4
        CASE 5: RESTORE kostka5
        CASE 6: RESTORE kostka6
        CASE 7: RESTORE kostka7
        CASE 8: RESTORE kostka8

        CASE 9: RESTORE kostka9
        CASE 10: RESTORE kostka10
        CASE 11: RESTORE kostka11
        CASE 12: RESTORE kostka12
        CASE 13: RESTORE kostka13
        CASE 14: RESTORE kostka14
        CASE 15: RESTORE kostka15
    END SELECT


    SELECT CASE Poloha '                                                   Poloha is ROTATION. Blocks are rotated in four positions. Some not. Point need not be rotated.
        CASE 0: cti Tvar '                                                 Tvar is BLOCK. The same number as in DATA: 0 for kostka: 1 for kostka1: 2 for kostka2: .....
        CASE 1
            FOR kostkaX = Size TO 1 STEP -1
                FOR kostkaY = 1 TO Size
                    SELECT CASE Tvar
                        CASE 0: READ kostka: tet(kostkaX, kostkaY) = kostka
                        CASE 1: READ kostka1: tet(kostkaX, 4 - kostkaY) = kostka1 '  for example this is "three" ***
                        CASE 2: READ kostka2: tet(kostkaX, kostkaY) = kostka2
                        CASE 3: READ kostka3: tet(kostkaX, kostkaY) = kostka3
                        CASE 4: READ kostka4: tet(kostkaX, kostkaY) = kostka4
                        CASE 5: READ kostka5: tet(kostkaX, kostkaY) = kostka5
                        CASE 6: READ kostka6: tet(kostkaX, kostkaY) = kostka6
                        CASE 7: READ kostka7: tet(kostkaX, 6 - kostkaY) = kostka7
                        CASE 8: cti Tvar


                        CASE 9: READ kostka9: tet(kostkaX, kostkaY) = kostka9
                        CASE 10: READ kostka10: tet(kostkaX, kostkaY) = kostka10
                        CASE 11: READ kostka11: tet(kostkaX, kostkaY) = kostka11
                        CASE 12: READ kostka12: tet(kostkaX, kostkaY) = kostka12
                        CASE 13: READ kostka13: tet(kostkaX, kostkaY) = kostka13
                        CASE 14: READ kostka14: tet(kostkaX, kostkaY) = kostka14

                    END SELECT
            NEXT: NEXT

        CASE 2
            FOR kostkaY = Size TO 1 STEP -1 ' 3
                FOR kostkaX = Size TO 1 STEP -1 ' 3
                    SELECT CASE Tvar
                        CASE 0: READ kostka: tet(kostkaY, kostkaX) = kostka
                        CASE 1: cti Tvar
                        CASE 2: READ kostka2: tet(kostkaY, kostkaX) = kostka2
                        CASE 3: READ kostka3: tet(kostkaY, kostkaX) = kostka3
                        CASE 4: READ kostka4: tet(kostkaX, kostkaY) = kostka4
                        CASE 5: READ kostka5: tet(kostkaY, kostkaX) = kostka5
                        CASE 6: READ kostka6: tet(kostkaX, kostkaY) = kostka6
                        CASE 7: cti Tvar 'READ kostka7: tet(kostkaY, kostkaX) = kostka7
                        CASE 8: cti Tvar

                        CASE 9: READ kostka9: tet(kostkaX, kostkaY) = kostka9
                        CASE 10: READ kostka10: tet(kostkaX, kostkaY) = kostka10
                        CASE 11: READ kostka11: tet(kostkaX, 4 - kostkaY) = kostka11
                        CASE 12: READ kostka12: tet(kostkaX, kostkaY) = kostka12
                        CASE 13: READ kostka13: tet(kostkaX, kostkaY) = kostka13
                        CASE 14: READ kostka14: tet(kostkaX, kostkaY) = kostka14

                    END SELECT
            NEXT: NEXT

        CASE 3
            FOR kostkaX = Size TO 1 STEP -1 ' 3
                FOR kostkaY = 1 TO Size ' 3
                    SELECT CASE Tvar
                        CASE 0: READ kostka: tet(kostkaY, kostkaX) = kostka
                        CASE 1: READ kostka1: tet(kostkaX, 4 - kostkaY) = kostka1
                        CASE 2: READ kostka2: tet(kostkaY, kostkaX) = kostka2
                        CASE 3: READ kostka3: tet(kostkaY, kostkaX) = kostka3
                        CASE 4: READ kostka4: tet(4 - kostkaX, kostkaY) = kostka4
                        CASE 5: READ kostka5: tet(kostkaY, kostkaX) = kostka5
                        CASE 6: READ kostka6: tet(3 - kostkaX, 3 - kostkaY) = kostka6
                        CASE 7: READ kostka7: tet(kostkaX, 6 - kostkaY) = kostka7
                        CASE 8: cti Tvar

                        CASE 9: READ kostka9: tet(kostkaX, kostkaY) = kostka9
                        CASE 10: READ kostka10: tet(kostkaX, kostkaY) = kostka10
                        CASE 11: READ kostka11: tet(4 - kostkaX, 4 - kostkaY) = kostka11
                        CASE 12: READ kostka12: tet(4 - kostkaX, 4 - kostkaY) = kostka12
                        CASE 13: READ kostka13: tet(4 - kostkaX, 4 - kostkaY) = kostka13
                        CASE 14: READ kostka14: tet(4 - kostkaX, 4 - kostkaY) = kostka14

                    END SELECT
            NEXT: NEXT
    END SELECT
END SUB

SUB kresli (pole())

    IF B = 0 THEN B = Barva
    FOR kostkaX = 1 TO 100 '1 TO 3
        FOR kostkaY = 1 TO 125 '1 TO 3
            posx2 = Left + (kostkaX * 5)
            posy2 = Left + (kostkaY * 5)
            IF obr(kostkaX, kostkaY) = 1 THEN LINE (posx2 + 1, posy2 + 1)-(posx2 + 4, posy2 + 4), 45, B '          Draw all scene to screen as it is in array
    NEXT: NEXT
END SUB


FUNCTION collis
    SHARED tvar, poloha ' Tvar is BLOCK number, Poloha is ROTATION number 0 to 3
    _LIMIT 1000
    P = 0
    FOR ZY = 1 TO Size '3
        FOR ZX = 1 TO Size ' 3
            IF krokzpet(((posX - Left) / 5) + ZX, ((posY - Left) / 5) + ZY) = 1 AND stin(((posX - Left) / 5) + ZX, ((posY - Left) / 5) + ZY) = 1 THEN P = P + 1: collis = 2: recstin: 'SOUND 250, .5
            IF posY <> 50 THEN P = 0
            IF posY = 50 AND P THEN collis = 3: EXIT FUNCTION
        NEXT ZX
    NEXT ZY
    SELECT CASE tvar


        CASE 9, 10:
            SELECT CASE poloha
                CASE 1, 3: mez = 180 '                                                  mez is variable which set how up is bottom for concrete block
                CASE 0, 2: mez = 175
            END SELECT
        CASE 11
            SELECT CASE poloha
                CASE 1: mez = 180
                CASE 0, 2, 3: mez = 175
            END SELECT

        CASE 12
            SELECT CASE poloha
                CASE 1, 2, 3: mez = 175
                CASE 0: mez = 180
            END SELECT



        CASE 0, 2 TO 5, 8, 13, 14, 15: mez = 175
        CASE 6: mez = 180
        CASE 1: mez = 177
        CASE 7: mez = 165
    END SELECT


    IF posY > mez THEN collis = 1: recstin: B = 0
END FUNCTION

SUB recstin 'create shadow array. This is then used for collission detection (if is 1 in the same position, is collission, its one step forward as game)
    FOR kostkaX = 1 TO 100
        FOR kostkaY = 1 TO 125
            stin(kostkaX, kostkaY) = obr(kostkaX, kostkaY)
    NEXT: NEXT
END SUB


SUB preview (Tvar, posX2 AS INTEGER, posY2 AS INTEGER)
    SHARED menupreview
    IF NOT menupreview THEN LINE (posX2, posY2)-(posX2 + 40, posY2 + 40), 0, BF
    SELECT CASE Tvar
        CASE 0: RESTORE kostka: s = 3
        CASE 1: RESTORE kostka1: s = 3
        CASE 2: RESTORE kostka2: s = 3
        CASE 3: RESTORE kostka3: s = 3
        CASE 4: RESTORE kostka4: s = 3
        CASE 5: RESTORE kostka5: s = 3
        CASE 6: RESTORE kostka6: s = 2
        CASE 7: RESTORE kostka7: s = 5
        CASE 8: RESTORE kostka8: s = 3
        CASE 9: RESTORE kostka9: s = 3
        CASE 10: RESTORE kostka10: s = 3
        CASE 11: RESTORE kostka11: s = 3
        CASE 12: RESTORE kostka12: s = 3
        CASE 13: RESTORE kostka13: s = 3
        CASE 14: RESTORE kostka14: s = 3
        CASE 15: RESTORE kostka15: s = 3
    END SELECT

    REDIM Prew(s, s)
    FOR kostkaY = 1 TO s
        FOR kostkaX = 1 TO s ' 3
            SELECT CASE Tvar
                CASE 0: READ kostka: Prew(kostkaX, kostkaY) = kostka
                CASE 1: READ kostka1: Prew(kostkaX, kostkaY) = kostka1
                CASE 2: READ kostka2: Prew(kostkaX, kostkaY) = kostka2
                CASE 3: READ kostka3: Prew(kostkaX, kostkaY) = kostka3
                CASE 4: READ kostka4: Prew(kostkaX, kostkaY) = kostka4
                CASE 5: READ kostka5: Prew(kostkaX, kostkaY) = kostka5
                CASE 6: READ kostka6: Prew(kostkaX, kostkaY) = kostka6
                CASE 7: READ kostka7: Prew(kostkaX, kostkaY) = kostka7
                CASE 8: READ kostka8: Prew(kostkaX, kostkaY) = kostka8
                CASE 9: READ kostka9: Prew(kostkaX, kostkaY) = kostka9
                CASE 10: READ kostka10: Prew(kostkaX, kostkaY) = kostka10
                CASE 11: READ kostka11: Prew(kostkaX, kostkaY) = kostka11
                CASE 12: READ kostka12: Prew(kostkaX, kostkaY) = kostka12
                CASE 13: READ kostka13: Prew(kostkaX, kostkaY) = kostka13
                CASE 14: READ kostka14: Prew(kostkaX, kostkaY) = kostka14
                CASE 15: READ kostka15: Prew(kostkaX, kostkaY) = kostka15

            END SELECT
            IF menupreview THEN Clr = 18 ELSE Clr = 45
            IF Prew(kostkaX, kostkaY) = 1 THEN LINE ((5 * kostkaX) + posX2 + 1, (5 * kostkaY) + posY2 + 1)-((5 * kostkaX + posX2) + 4, (5 * kostkaY + posY2) + 4), Clr, B
    NEXT: NEXT

END SUB

SUB rada
    SHARED Sco, Level
    FOR y = 1 TO 125
        rad = 0
        FOR x = 1 TO 100
            IF obr(x, y) = 1 THEN rad = rad + 1
        NEXT x
        IF rad = 24 THEN GOSUB SundejRadu ' one complete line contains 24* "1"
    NEXT y
    EXIT SUB

    SundejRadu:
    rad = 0
    efekt 0
    FOR x2 = Left - 5 TO (Right + Left * 2 + 2) - 10 STEP 5
        LINE (Left + x2 + 1, Left + (y * 5) + 1)-(Left + x2 + 4, Left + (5 * y) + 4), 35, B
    NEXT x2
    _DISPLAY
    _DELAY .3

    REDIM NewObr(100, 125)
    FOR yP = 1 TO y
        FOR Xp = 1 TO 100
            NewObr(Xp, yP + 1) = obr(Xp, yP)
    NEXT Xp, yP

    FOR yP = y + 1 TO 125
        FOR Xp = 1 TO 100
            NewObr(Xp, yP) = obr(Xp, yP)
    NEXT Xp, yP


    REDIM obr(100, 125)
    FOR rewY = 1 TO 125
        FOR rewX = 1 TO 100
            obr(rewX, rewY) = NewObr(rewX, rewY)
    NEXT rewX, rewY
    recstin
    Score = Score + 1
    Sco = Sco + 1: IF Sco > 1 AND Sco MOD 20 = 0 THEN Sco = 0: ViewLevel 'upgrded
    LINE (0, 0)-(_WIDTH, 35), 0, BF 'misto CLS


    i32to256 Picture$, 150, 50 'obnovi fotku s babou       'picture MUSS BE 145 x 145 pixels, saved as 256 colors BMP or GIF (1 Byte pex pixel, also 8 bit depth)
    Zdivo Sco
    textar "Score:", -20, -2: textar LTRIM$(STR$(Score)), 60, -2
    textar "Level:", 190, -2: textar LTRIM$(STR$(Level)), 270, -2

    PCOPY _DISPLAY, 1
    RETURN
END SUB

FUNCTION Sirka 'spocita sirku (vzdalenost nejblizsiho bodu "1" od okraje pole tet)
    Sirka = 4
    FOR y = 1 TO Size
        FOR x = 1 TO Size
            IF tet(x, y) = 1 THEN
                Si = 4 - x
                IF Si < Sirka THEN Sirka = Si
            END IF
    NEXT x, y
END FUNCTION


FUNCTION Vyska 'spocita nejblizi 1 z leva
    Vyska = Size
    FOR y = 1 TO Size
        FOR x = 1 TO Size
            IF tet(x, y) = 1 THEN nVyska = y
            IF nVyska < Vyska THEN Vyska = nVyska
    NEXT x, y
END FUNCTION

SUB napis (co AS STRING, size3 AS SINGLE, xc AS INTEGER, yc AS INTEGER, colr)
    kam& = _DEST
    virtual& = _NEWIMAGE(120, 60, 256)
    _DEST virtual&: PRINT co$: _DEST kam&: _SOURCE virtual&
    FOR y = 0 TO 15
        FOR x = 0 TO LEN(co$) * 8
            IF POINT(x, y) THEN LINE (x * size3 + xc, y * size3 + yc)-(x * size3 + xc + size3, y * size3 + yc + size3), colr, BF: LINE (x * size3 + xc, y * size3 + yc)-(x * size3 + xc + size3, y * size3 + yc + size3), 0, B
    NEXT x, y
    _SOURCE kam&
    _FREEIMAGE virtual&
END SUB

SUB i32to256 (image AS STRING, x AS INTEGER, y AS INTEGER) '     this is already on the .NET forum writed by me. As example how show pictures in 256 colors.
    IF _FILEEXISTS(image$) THEN
        image& = _LOADIMAGE(image$, 32)
        TYPE colors
            ClrVal AS LONG '                                    this contais color number in long format (_RGB32)
            ClrNmbr AS LONG '                                   this contais number for color. How much is this one color used in picture. Is for future use, if 32bit image contais more than 256 colors, then
        END TYPE '                                               i will use the most used only.
        REDIM colors(256) AS colors
        REDIM scn AS LONG, col AS LONG, scan AS LONG, control AS LONG, TotalColors AS LONG
        REDIM m AS _MEM
        m = _MEMIMAGE(image&)

        FOR scan = 0 TO (_WIDTH(image&) * _HEIGHT(image&) * 4) - 4 STEP 4 ' use 32 bit, step is 4 byt * 8 bit = 32 bit, i read 4 bytes (LONG) in one loop, so STEP 4
            _MEMGET m, m.OFFSET + scan, col&
            FOR control = 0 TO TotalColors&
                IF col& = colors(control).ClrVal THEN colors(control).ClrNmbr = colors(control).ClrNmbr + 1: col& = 0: EXIT FOR
            NEXT
            IF col& <> 0 THEN colors(control + 1).ClrVal = col&: colors(control + 1).ClrNmbr = 1: TotalColors& = TotalColors& + 1: col& = 0
            IF TotalColors& > 255 THEN EXIT FOR
        NEXT scan
        IF TotalColors& <= 256 THEN
            image256& = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 256)
            _DEST image256&
            DIM m2 AS _MEM
            m2 = _MEMIMAGE(image256&)
            FOR MESecam = 255 - TotalColors& TO 255
                _DEST 0
                _PALETTECOLOR MESecam, colors(255 - MESecam).ClrVal
            NEXT

            REDIM SelectColor AS _UNSIGNED _BYTE
            FOR scan = 0 TO (_WIDTH(image&) * _HEIGHT(image&) * 4) - 4 STEP 4
                _MEMGET m, m.OFFSET + scan, Value&
                FOR SelectColor = 255 - TotalColors& TO 255
                    IF colors(255 - SelectColor).ClrVal& = Value& THEN _MEMPUT m2, m2.OFFSET + position256, SelectColor
                NEXT SelectColor
                position256 = position256 + 1
            NEXT scan
            _PUTIMAGE (x, y), image256&, 0
            _MEMFREE m: _MEMFREE m2: _FREEIMAGE image&: _FREEIMAGE image256&
        ELSE PRINT "Image contains more than 256 colors."
        END IF
    ELSE PRINT "File "; image$; " not exists.": SLEEP 5
    END IF
END SUB


SUB Zdivo (S AS INTEGER)

    SHARED ZdivoActive&
    '    IF S = 20 THEN EXIT SUB
    IF ZdivoActive& < -1 THEN
        _PUTIMAGE (150, 50 + (7.25 * S)), ZdivoActive&, 0, (0, 0)-(145, 145)
    ELSE
        ZdivoActive& = _NEWIMAGE(145, 145, 256)
        _DEST ZdivoActive&
        PAINT (1, 1), 24
        napis "?", 12, 25, -10, 8
        _DEST 0
    END IF
END SUB


SUB ViewLevel 'Show Level number and after showing it, up it
    SHARED Level
    Level = Level + 1
    napis "Level", 6, 30, 10, 15
    napis STR$(Level), 7, 66, 80, 14
    _DISPLAY
    SLEEP 2
    CLS
END SUB

SUB Constructor (vystup AS STRING) 'extract files from .PMF
    TYPE head2
        identity AS STRING * 16
        much AS LONG
    END TYPE
    IF INSTR(1, LCASE$(vystup$), ".pmf") THEN ELSE vystup$ = vystup$ + ".PMF"
    IF _FILEEXISTS(vystup$) THEN
        DIM head AS head2
        e = FREEFILE
        OPEN vystup$ FOR BINARY AS #e
        GET #e, , head
        IF head.identity = "Petr's MultiFile" THEN ELSE PRINT "Head Failure": SLEEP 3: END
        DIM starts(head.much) AS LONG

        FOR celek = 1 TO head.much
            GET #e, , starts(celek)
        NEXT

        SEEK #e, 21 + head.much * 4 ' start DATA area
        FOR total = 1 TO head.much
            IF total = 1 THEN velikost& = starts(1) - (21 + head.much * 4) ELSE velikost& = starts(total) - starts(total - 1) 'velikost is SIZE english -
            record$ = SPACE$(velikost&)
            GET #e, , record$
            i = FREEFILE
            jmeno$ = "$Ext" + LTRIM$(STR$(total))
            OPEN jmeno$ FOR OUTPUT AS #i: CLOSE #i: OPEN jmeno$ FOR BINARY AS #i
            PUT #i, , record$
            CLOSE #i
        NEXT total
        DIM NamesLenght(head.much) AS INTEGER
        FOR NameIt = 1 TO head.much
            GET #e, , NamesLenght(NameIt)
            '    PRINT "File name: "; NameIt; "lenght in bytes is "; NamesLenght(NameIt)
        NEXT NameIt

        CLOSE #i
        FOR Name2 = 1 TO head.much
            s$ = SPACE$(NamesLenght(Name2))
            GET #e, , s$
            jm$ = "$Ext" + LTRIM$(STR$(Name2))
            erh:
            IF _FILEEXISTS(s$) THEN
                BEEP: INPUT "Warnig! Extracted file the same name already exists!!!! (O)verwrite, (R)ename or (E)xit? "; er$
                SELECT CASE LCASE$(er$)
                    CASE "o": KILL s$: NAME jm$ AS s$
                    CASE "r": INPUT "Input new name"; s$: GOTO erh
                    CASE "e": Destructor "tetris.pmf": SYSTEM
                END SELECT
            ELSE
                NAME jm$ AS s$
            END IF
        NEXT Name2
        CLOSE #e

        FOR ctrl = 1 TO head.much
            nam$ = "$ext" + LTRIM$(STR$(ctrl))
            IF _FILEEXISTS(nam$) THEN KILL nam$
        NEXT ctrl
    ELSE
        PRINT "Specified file not found": SLEEP 3
    END IF
END SUB

SUB Destructor (vystup AS STRING) 'delete files created by Constructor
    TYPE head
        identity AS STRING * 16
        much AS LONG
    END TYPE
    IF INSTR(1, LCASE$(vystup$), ".pmf") THEN ELSE vystup$ = vystup$ + ".PMF"
    IF _FILEEXISTS(vystup$) THEN
        CLOSE
        DIM head AS head
        e = FREEFILE
        OPEN vystup$ FOR BINARY AS #e
        GET #e, , head
        DIM starts(head.much) AS LONG

        FOR celek = 1 TO head.much
            GET #e, , starts(celek)
        NEXT

        SEEK #e, starts(head.much) ' start DATA area
        DIM NamesLenght(head.much) AS INTEGER
        FOR NameIt = 1 TO head.much
            GET #e, , NamesLenght(NameIt)
        NEXT NameIt
        FOR Name2 = 1 TO head.much
            s$ = SPACE$(NamesLenght(Name2))
            GET #e, , s$
            IF _FILEEXISTS(s$) THEN KILL s$
        NEXT Name2
        CLOSE #e
    ELSE
        PRINT "Specified file not found": SLEEP 3
    END IF
END SUB



SUB textar (veta AS STRING, x AS INTEGER, y AS INTEGER)
    c = 25
    FOR r = 1 TO LEN(veta$)
        ch$ = UCASE$(MID$(veta$, r, 1))
        SELECT CASE ch$
            CASE ":": in = 10
            CASE "A": in = 11
            CASE "B": in = 12
            CASE "C": in = 13
            CASE "D": in = 14
            CASE "E": in = 15
            CASE "F": in = 16
            CASE "G": in = 17
            CASE "H": in = 18
            CASE "I": in = 19
            CASE "J": in = 20
            CASE "K": in = 21
            CASE "L": in = 22
            CASE "M": in = 23
            CASE "N": in = 24
            CASE "O": in = 25
            CASE "P": in = 26
            CASE "Q": in = 27
            CASE "R": in = 28
            CASE "S": in = 29
            CASE "T": in = 30
            CASE "U": in = 31
            CASE "V": in = 32
            CASE "W": in = 33
            CASE "X": in = 34
            CASE "Y": in = 35
            CASE "Z": in = 36
            CASE "0": in = 0
            CASE "1": in = 9
            CASE "2": in = 8
            CASE "3": in = 7
            CASE "4": in = 6
            CASE "5": in = 5
            CASE "6": in = 4
            CASE "7": in = 3
            CASE "8": in = 2
            CASE "9": in = 1
        END SELECT
        krokX = krokX + 13: IF krokX > _WIDTH - 13 - x THEN krokX = 0: krokY = krokY + 22
        rozpis in, x + krokX, y + krokY
        in = 0
    NEXT
END SUB


FUNCTION reader (file AS STRING) 'primo vraci delku strany, neprimo pocet snimku v souboru FRAMES
    SHARED frames
    kx = 0: ky = 1
    IF _FILEEXISTS(file$) THEN OPEN file$ FOR BINARY AS #1 ELSE BEEP: PRINT "Error opening file "; file$: EXIT SUB
    ident$ = SPACE$(4)
    REDIM big AS INTEGER
    GET #1, , ident$
    IF ident$ <> "Petr" THEN PRINT "This is not my file format": SLEEP 2: EXIT SUB
    GET #1, , big
    frames = (LOF(1) - 6) / (big ^ 2 / 8)
    REDIM udaj AS _UNSIGNED _BYTE
    REDIM Sn(frames) AS STRING
    WHILE NOT EOF(1)
        GET #1, , udaj
        binar$ = DECtoBIN$(udaj)
        Sn(snindex) = Sn(snindex) + binar$
        FOR rozklad = 1 TO LEN(binar$)
            inSeek = inSeek + 1
            povel = VAL(MID$(binar$, rozklad, 1))
            kx = kx + 1: IF kx > big THEN kx = 1: ky = ky + 1
        NEXT rozklad
        IF inSeek MOD (big ^ 2) = 0 THEN ky = ky + 10: snindex = snindex + 1
        IF _HEIGHT - ky < big THEN ky = 1: posun = posun + 60
    WEND
    reader = big
END FUNCTION


SUB rozpis (snimek AS INTEGER, posX AS INTEGER, posY AS INTEGER)
    binar$ = Sn(snimek)
    FOR rozklad = 1 TO LEN(binar$)
        povel = VAL(MID$(binar$, rozklad, 1))
        kx = kx + 1: IF kx > Big THEN kx = 1: ky = ky + 1
        IF povel = 1 THEN PSET (posX + kx, posY + ky), 15
    NEXT rozklad
END SUB

FUNCTION DECtoBIN$ (vstup)
    SHARED BINARY$
    FOR rj = 7 TO 0 STEP -1
        IF vstup AND 2 ^ rj THEN BINtoDE$ = BINtoDE$ + "1" ELSE BINtoDE$ = BINtoDE$ + "0"
    NEXT rj
    DECtoBIN$ = BINtoDE$
END FUNCTION

SUB Allow_Poloha
    SHARED poloha
    ' recstin                  pole tet obsahuje informace o telese ktere ovladas
    FOR ZY = 1 TO Size '3
        FOR ZX = 1 TO Size ' 3
            IF tet(ZX, ZY) = 0 AND obr(((posX - Left) / 5) + ZX, ((posY - Left) / 5) + ZY) = 1 THEN EXIT SUB
        NEXT
    NEXT
    poloha = poloha + 1: IF poloha > 3 THEN poloha = 0
END SUB

SUB musica
    IF GameSound THEN
        IF NOT _FILEEXISTS(music$) THEN IF TIMER MOD 10 = 0 THEN SOUND 300, .2: EXIT SUB
        SHARED Volume, music$, hudba&, oldmusic$
        IF oldmusic$ = "" THEN oldmusic$ = music$
        IF hudba& = 0 THEN hudba& = _SNDOPEN(music$)
        IF _SNDLEN(hudba&) - _SNDGETPOS(hudba&) < 7 AND Volume > 0 OR oldmusic$ <> music$ THEN Volume = Volume - 0.001: GOTO NoUpVol 'not writed correctly. In fact good works with the same CPU speed as mine. For correct work muss this be calculated using TIMER
        IF hudba& AND Volume < 1 AND oldmusic$ = music$ THEN Volume = Volume + 0.001
        NoUpVol:
        _SNDVOL hudba&, Volume
        IF NOT _SNDPLAYING(hudba&) AND _SNDGETPOS(hudba&) <> _SNDLEN(hudba&) THEN _SNDPLAY hudba&
        IF _SNDGETPOS(hudba&) > _SNDLEN(hudba&) - 1 THEN ' OR oldmusic$ <> music$ AND Volume < .1 THEN
            _SNDSTOP (hudba&)
            Volume = 0
        END IF
        IF oldmusic$ <> music$ AND Volume < .1 THEN
            _SNDSTOP (hudba&)
            Volume = 0
            _SNDCLOSE (hudba&)
            hudba& = _SNDOPEN(music$)
            oldmusic$ = music$
        END IF
    ELSE
        IF _SNDPLAYING(hudba&) THEN _SNDSTOP (hudba&)
    END IF
END SUB


SUB Allow_X_Minus
    VirtualX = posX - 5: IF VirtualX < Left THEN VirtualX = Left
    FOR ZY = 1 TO Size '3
        FOR ZX = 1 TO Size ' 3
            IF VirtualX * ZX < Left THEN VirtualX = Left
            IF tet(ZX, ZY) = 1 AND stin(((VirtualX - Left) / 5) + ZX, ((posY - Left) / 5) + ZY) = 1 THEN EXIT SUB
        NEXT
    NEXT
    posX = posX - 5
END SUB

SUB Allow_X_Plus
    VirtualX = posX + 5: ' IF VirtualX > Right + (5 * Sirka) THEN VirtualX = Right + (5 * Sirka)   TYHLE HOVNA musi byt zakazany jinak dela petka na stojaka picoviny
    FOR ZY = 1 TO Size '3
        FOR ZX = 1 TO Size ' 3
            '            IF VirtualX + 5 * ZX > Right + (5 * Sirka) THEN VirtualX = Right + (5 * Sirka) ' - 3 Musi byt zakazano!
            IF tet(ZX, ZY) = 1 AND stin(((VirtualX - Left) / 5) + ZX, ((posY - Left) / 5) + ZY) = 1 THEN EXIT SUB
        NEXT
    NEXT
    posX = posX + 5
END SUB

SUB INILoader
    'Game SETUP
    TYPE INI
        Identifier AS STRING * 11
        GameSound AS _UNSIGNED _BYTE
        GameClicks AS _UNSIGNED _BYTE
        Glue AS _UNSIGNED _BYTE
        GameType AS _UNSIGNED _BYTE
    END TYPE
    DIM ini AS INI

    inicializace:
    inic = FREEFILE
    IF _FILEEXISTS("tetris.ini") THEN
        OPEN "Tetris.ini" FOR BINARY AS #inic
        GET #inic, , ini
        CLOSE #inic
        GameSound = ini.GameSound
        GameClicks = ini.GameClicks
        Glue = ini.Glue
        GameType = ini.GameType

    ELSE
        OPEN "Tetris.ini" FOR OUTPUT AS #inic: CLOSE #inic: OPEN "Tetris.ini" FOR BINARY AS #inic
        ini.Identifier = "Tetris QB64"
        ini.GameSound = GameSound
        ini.GameClicks = GameClicks
        ini.Glue = Glue
        ini.GameType = 0
        PUT #inic, , ini
        CLOSE #inic
    END IF
    IF ini.Identifier <> "Tetris QB64" AND _FILEEXISTS("Tetris.ini") THEN KILL "tetris.ini": GOTO inicializace

    '//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
END SUB


SUB INISaver (GameSound, GameClicks, Glue, GameType)
    TYPE INI2
        Identifier AS STRING * 11
        GameSound AS _UNSIGNED _BYTE
        GameClicks AS _UNSIGNED _BYTE
        Glue AS _UNSIGNED _BYTE
        GameType AS _UNSIGNED _BYTE
    END TYPE
    DIM ini2 AS INI2
    ini2.Identifier = "Tetris QB64"
    ini2.GameSound = GameSound
    ini2.GameClicks = GameClicks
    ini2.Glue = Glue
    ini2.GameType = GameType
    Inis = FREEFILE
    OPEN "tetris.ini" FOR OUTPUT AS #Inis
    CLOSE #Inis
    OPEN "tetris.ini" FOR BINARY AS #Inis
    PUT #Inis, , ini2
    CLOSE #Inis
END SUB


SUB menu
    SHARED menupreview, cntGame
    menupreview = 1
    SLEEP 2 'tetris napis
    CLS
    TYPE prvek
        poloha AS _BYTE
        tvar AS _BYTE
        x AS INTEGER
        y AS INTEGER
    END TYPE
    DIM prvek(15) AS prvek

    FOR plneni = 1 TO 15
        prvek(plneni).poloha = RND * 4
        prvek(plneni).tvar = RND * 15
        prvek(plneni).x = RND * _WIDTH
        prvek(plneni).y = RND * _HEIGHT
    NEXT plneni

    vyber = 1

    DO WHILE i$ <> CHR$(13)
        mz:
        i$ = INKEY$
        in = in + 1: IF in > 15 THEN in = 1
        tvar = prvek(in).tvar
        prvek(in).poloha = prvek(in).poloha + 1: IF prvek(in).poloha > 4 THEN prvek(in).poloha = 1
        prvek(in).x = prvek(in).x + RND * 3: IF prvek(in).x > _WIDTH THEN prvek(in).x = -20
        prvek(in).y = prvek(in).y + 2: IF prvek(in).y > _HEIGHT THEN prvek(in).y = 0
        preview in, prvek(in).x, prvek(in).y
        music$ = "loop4.mp3"
        musica
        SELECT CASE i$
            CASE CHR$(0) + "H": CLS: vyber = vyber - 1: IF vyber < 1 THEN vyber = 1
            CASE CHR$(0) + "P": CLS: vyber = vyber + 1: IF vyber > 4 THEN vyber = 4
        END SELECT
        IF cntGame THEN F$ = "Continue Game" ELSE F$ = "New Game": Sco = 0
        SELECT CASE vyber
            CASE 1
                napis "Game menu", 2, 20, 0, 70

                napis "Sound", 2, 60, 70, 30
                napis "Difficulty", 2, 60, 110, 30
                napis "End", 2, 60, 145, 30

                napis F$, 3, 10, 30, 50

            CASE 2
                napis "Game menu", 2, 20, 0, 70
                napis F$, 2, 60, 40, 30
                napis "Difficulty", 2, 60, 110, 30
                napis "End", 2, 60, 145, 30

                napis "Sound", 3, 10, 65, 50
            CASE 3
                napis "Game menu", 2, 20, 0, 70
                napis F$, 2, 60, 40, 30
                napis "Sound", 2, 60, 70, 30
                napis "End", 2, 60, 145, 30

                napis "Difficulty", 3, 10, 100, 50
            CASE 4
                napis "Game menu", 2, 20, 0, 70
                napis F$, 2, 60, 40, 30
                napis "Sound", 2, 60, 70, 30
                napis "Difficulty", 2, 60, 110, 30

                napis "End", 3, 10, 140, 50
        END SELECT
        _DISPLAY
        _LIMIT 200
    LOOP
    SELECT CASE vyber
        CASE 1: newgame = 1: cntGame = 1: _KEYCLEAR: CLS: PCOPY 2, 1: EXIT SUB
        CASE 2 ' sound
            CLS
            ConfirmQuad(0) = GameSound
            ConfirmQuad(1) = GameClicks
            DO WHILE Tlacitko(80, 135, "Done") <> 1
                music$ = "loop5.mp3"
                musica
                napis "Sound menu", 2, 20, 0, 70
                napis "Use sound", 2, 20, 55, 30
                napis "Use effects", 2, 20, 90, 30
                _DISPLAY
                GameSound = Confirm_Quad(0, 220, 65)
                GameClicks = Confirm_Quad(1, 220, 100)
            LOOP
            INISaver GameSound, GameClicks, Glue, GameType
            INILoader
            CLS
            GOTO mz '         menu
            ' GameClicks
        CASE 3 'difficulty
            CLS
            ConfirmQuad(2) = Glue
            ConfirmQuad(3) = GameType
            DO WHILE Tlacitko(180, 175, "Done") <> 1
                music$ = "loop3.mp3"
                musica
                napis "Difficulty", 2, 20, 0, 70
                napis "Use Glue mode", 2, 10, 55, 30

                napis "Easy game", 2, 10, 90, 30
                napis "Medium game", 2, 10, 120, 30
                napis "Hard game", 2, 10, 150, 30
                _DISPLAY


                Glue = Confirm_Quad(2, 250, 65)

                HraE = Confirm_Quad(3, 250, 105)
                HraM = Confirm_Quad(4, 250, 135)
                HraH = Confirm_Quad(5, 250, 165)

                IF HraE THEN ConfirmQuad(3) = 1: ConfirmQuad(4) = 0: ConfirmQuad(5) = 0: e = 0: GameType = 0
                IF HraM THEN ConfirmQuad(3) = 0: ConfirmQuad(4) = 1: ConfirmQuad(5) = 0: m = 0: GameType = 1
                IF HraH THEN ConfirmQuad(3) = 0: ConfirmQuad(4) = 0: ConfirmQuad(5) = 1: h = 0: GameType = 2


            LOOP
            INISaver GameSound, GameClicks, Glue, GameType
            INILoader
            CLS
            GOTO mz ' menu
        CASE 4: Destructor "tetris.pmf": SYSTEM 'quit
    END SELECT
    _KEYCLEAR
    menupreview = 0
END SUB

FUNCTION Confirm_Quad (index AS INTEGER, x AS INTEGER, y AS INTEGER)
    SHARED Confirm_Quad_TTT
    IF index > UBOUND(ConfirmQuad) THEN REDIM _PRESERVE ConfirmQuad(index) AS _BYTE
    E = _MOUSEINPUT 'uncorrect mouse call, but works better as using with DO or WHILE.
    FOR all = 0 TO UBOUND(confirmquad)
        SELECT CASE _MOUSEX
            CASE x TO x + 8
                SELECT CASE _MOUSEY
                    CASE y TO y + 8
                        IF _MOUSEBUTTON(1) AND TIMER > Confirm_Quad_TTT THEN
                            IF ConfirmQuad(index) THEN ConfirmQuad(index) = 0: Confirm_Quad_TTT = TIMER + .4 ELSE ConfirmQuad(index) = 1: Confirm_Quad_TTT = TIMER + .4
                        END IF
                END SELECT
        END SELECT
    NEXT
    E = 0
    IF TIMER > Confirm_Quad_TTT THEN Confirm_Quad_TTT = 0
    Confirm_Quad = ConfirmQuad(index)
    SELECT CASE ConfirmQuad(index)
        CASE 0
            LINE (x, y)-(x + 8, y + 8), 0, BF
            LINE (x, y)-(x + 8, y + 8), 15, B
        CASE 1
            '      LINE (x, y)-(x + 8, y + 8), 0, BF
            LINE (x, y)-(x + 8, y + 8), 15, B
            LINE (x, y)-(x + 8, y + 8), 15
            LINE (x, y + 8)-(x + 8, y), 15
    END SELECT
END FUNCTION

FUNCTION Tlacitko (x AS INTEGER, y AS INTEGER, text AS STRING) 'easy button function
    Tlacitko = 0
    F = _MOUSEINPUT
    SELECT CASE _MOUSEX
        CASE x TO x + _PRINTWIDTH(text)
            SELECT CASE _MOUSEY
                CASE y TO y + _FONTHEIGHT
                    IF _MOUSEBUTTON(1) THEN Tlacitko = 1
            END SELECT
    END SELECT
    F = 0
    IF Tlacitko = 1 THEN clr = 10 ELSE clr = 30
    LINE (x - 1, y - 1)-(x + _PRINTWIDTH(text) + 1, y + _FONTHEIGHT + 1), 15, B
    COLOR clr: _PRINTSTRING (x + 1, y + 1), text$: COLOR 15
    IF Tlacitko THEN _DISPLAY: _DELAY .5
END FUNCTION

SUB efekt (co AS INTEGER)
    IF GameClicks THEN
        SELECT CASE co
            CASE 0: _SNDPLAYFILE "bomb.mp3"
        END SELECT
    END IF
END SUB


Attached Files .pmf   tetris.pmf (Size: 10.97 MB / Downloads: 8)
Reply