Keskustelu: Projektit: QBlicBlock

'
' QBlicBlock by Tertsi 2018
'
RANDOMIZE TIMER
SCREEN 13
Update$ = "v.1.5"

'QB64-hemmoille:
_FULLSCREEN _SQUAREPIXELS '  Qbasic-hemmo, poista tama rivi
_TITLE "QBlicBlock " + Update$ ' Qbasic-hemmo, poista tama rivi

PK = 20: PY = PK * 2: PX = PK * 4.5: highscore = 0: TopLevel = 0
DIM Palikka(1000), Seuraava(1000)
DIM Taulukko(5, 7), Poistot(5, 7)

DIM Numero$(9) 'Custom numero-fontti! Piirretaan DRAW-kaskylla
Numero$(0) = "r7d14l7u14" '0
Numero$(1) = "br3 r1d14" '1
Numero$(2) = "r7d7l7d7r7" '2
Numero$(3) = "r7d14l7 bu7 r7" '3
Numero$(4) = "d7r7 bu7 d14" '4
Numero$(5) = "br7 l7d7r7d7l7" '5
Numero$(6) = "d14r7u7l7" '6
Numero$(7) = "r7d14" '7
Numero$(8) = "r7d14l7u14 bd7 r7" '8
Numero$(9) = "r7d14 bu7 l7u7" '9

OPEN "QBlicBlock.top" FOR APPEND AS #1 'jos tiedostoa ei ole, APPEND luo uuden
PRINT #1, highscore 'jos tiedosto olemassa, kirjoittaa vanhan sisallon peraan
PRINT #1, TopLevel
CLOSE #1

OPEN "QBlicBlock.top" FOR INPUT AS #1 'INPUT vain lukee
INPUT #1, highscore 'luetaan high score ekalta rivilta
INPUT #1, TopLevel
CLOSE #1

OPEN "QBlicBlock.top" FOR OUTPUT AS #1 'OUTPUT luo uuden ja tuhoaa vanhan tiedoston > APPEND:in luoma ylimaarainen rivi poistuu
PRINT #1, highscore 'kirjoitetaan highscore
PRINT #1, TopLevel
CLOSE #1

Alku:

IF score > highscore THEN
    highscore = score
    OPEN "QBlicBlock.top" FOR OUTPUT AS #1
    PRINT #1, highscore 'kirjoitetaan highscore
    PRINT #1, TopLevel
    CLOSE #1
END IF
IF level > TopLevel THEN
    TopLevel = level
    OPEN "QBlicBlock.top" FOR OUTPUT AS #1
    PRINT #1, highscore 'kirjoitetaan highscore
    PRINT #1, TopLevel
    CLOSE #1
END IF

c = 7: GOSUB MenuTekstit

DO
    Menu$ = INKEY$
    IF Menu$ = CHR$(13) THEN EXIT DO 'Enter aloittaa pelin
    IF Menu$ = CHR$(27) THEN GOTO Loppu 'Esc lopettaa
LOOP

LINE (8, 0)-(102, 143), 0, BF ' menu piiloon
FOR x = 1 TO 5: FOR Y = 1 TO 7: Taulukko(x, Y) = 0: Poistot(x, Y) = 0: NEXT Y: NEXT x 'nollataan taulukot
score = 0: level = 1: LevelUp = 20: PoistotTotal = 0: PoistotLevel = 0 'nollataan tilastot

Next1 = INT(RND * 6) + 1: block1 = Next1: NextX = PK * 11 + 1: NextY1 = PY + PK / 2 'arvotaan seuraavat palikat
LINE (NextX, NextY1)-(NextX + PK - 1, NextY1 + PK - 1), Next1, BF 'tumma reunus
LINE (NextX + 5, NextY1 + 5)-(NextX + PK - 6, NextY1 + PK - 6), Next1 + 8, BF 'vaalea sisus

Next2 = INT(RND * 6) + 1: block2 = Next2: NextX = PK * 11 + 1: NextY2 = PY + PK * 2
LINE (NextX, NextY2)-(NextX + PK - 1, NextY2 + PK - 1), Next2, BF 'tumma reunus
LINE (NextX + 5, NextY2 + 5)-(NextX + PK - 6, NextY2 + PK - 6), Next2 + 8, BF 'vaalea sisus

LINE (PX + PK - 1, PK - 1)-(PX + PK * 6, PY - 1), 8, B ' score-alue

LINE (PX + PK - 1, PY - 1)-(PX + PK * 6, PK * 9), 8, B ' pelialue
LINE (PX + PK, PY)-(PX + PK * 6 - 1, PK * 9 - 1), 0, BF

LINE (PX + PK * 6, PY - 1)-(PX + PK * 8 + 1, PY + PK * 3.5), 8, B 'next-alue
LINE (PX - PK - 5, PK * 7 + 3)-(PX + PK - 1, PK * 9), 8, B ' level-alue

GOSUB PrintScore
GOSUB PrintLevel

DO

    GET (NextX, NextY1)-(NextX + PK - 1, NextY1 + PK - 1), Palikka()
    GET (NextX, NextY2)-(NextX + PK - 1, NextY2 + PK - 1), Seuraava()
    PUT (NextX, NextY1), Seuraava(), PSET
    block = block1: SWAP block1, block2
    Next2 = INT(RND * 6) + 1: NextX = PK * 11 + 1: NextY2 = PY + PK * 2
    LINE (NextX, NextY2)-(NextX + PK - 1, NextY2 + PK - 1), Next2, BF 'tumma reunus
    LINE (NextX + 5, NextY2 + 5)-(NextX + PK - 6, NextY2 + PK - 6), Next2 + 8, BF 'vaalea sisus
    block2 = Next2
    x = 3: Y = 0

    DO
        LINE (PX + x * PK, PY + Y)-(PX + (x + 1) * PK - 1, PY + Y), 0 ' pikselin paksuinen musta viiva palikan ylalaitaan
        IF Taulukko(3, 2) = 0 THEN Y = Y + 1 ' pudotellaan pikselin verran alaspain
        PUT (PX + x * PK, PY + Y), Palikka(), PSET
        T = TIMER
        DO
            a$ = INKEY$
            IF a$ <> "" THEN
                SELECT CASE a$
                    CASE CHR$(27): GOTO Loppu 'esc
                    CASE CHR$(0) + "K" 'vasen nuolinappain
                        IF POINT(PX + x * PK - 1, PY + Y) = 0 AND POINT(PX + x * PK - 1, PY + Y + PK - 1) = 0 THEN
                            GOSUB PoistaPalikka
                            x = x - 1
                            PUT (PX + x * PK, PY + Y), Palikka(), PSET
                        END IF
                    CASE CHR$(0) + "M" 'oikea nuolinappain
                        IF POINT(PX + x * PK + PK, PY + Y) = 0 AND POINT(PX + x * PK + PK, PY + Y + PK - 1) = 0 THEN
                            GOSUB PoistaPalikka
                            x = x + 1
                            PUT (PX + x * PK, PY + Y), Palikka(), PSET
                        END IF
                    CASE CHR$(0) + "P" 'nuolinappain alas > hard drop
                        GOSUB PoistaPalikka
                        DO
                            Y = Y + 1
                            IF POINT(PX + x * PK + PK / 2, PY + PK + Y) <> 0 THEN EXIT DO
                        LOOP
                        PUT (PX + x * PK, PY + Y), Palikka(), PSET
                        EXIT DO
                END SELECT
            END IF
            IF level > 14 THEN ajastin = 0.001 ELSE ajastin = .0015 - level * .0001
        LOOP UNTIL TIMER - T > ajastin
        IF POINT(PX + x * PK + PK / 2, PY + PK + Y) <> 0 THEN EXIT DO
    LOOP

    lx = x: ly = FIX(Y / PK) + 1: Taulukko(lx, ly) = block: score = score + level

    DO
        Poistuu = 0
        FOR block = 1 TO 6
            GOSUB Taulukot
        NEXT block
        GOSUB PrintScore
        IF Poistuu = 1 THEN GOSUB Pudotusta ELSE EXIT DO
    LOOP
    IF lx = 3 AND ly = 1 THEN GOTO Alku
    IF PoistotLevel >= LevelUp THEN
        Yli = PoistotLevel - LevelUp
        IF level < 99 THEN level = level + 1
        PoistotLevel = 0 + Yli
        GOSUB PrintLevel
    END IF
LOOP

Loppu:
SYSTEM


PrintLevel:
LINE (PX - PK - 4, PK * 7 + 4)-(PX + PK - 2, PK * 9 - 1), 0, BF ' level-alue
DRAW "c3 bm68,146 r4 d14 bu14 r4 br3 d14 bu14 r7 d14 bu7 l7 bd7 br10 r7 u7 l7 u7 r7 br3 r7 d14 l7 u14" 'taso-teksti
MLevel$ = LTRIM$(STR$(level)) ' muutetaan level merkkimuotoon
MLeveys = LEN(MLevel$)
FOR z = 1 TO MLeveys
    Num = VAL(MID$(MLevel$, z, 1))
    IF MLeveys = 1 THEN xalku = 74 ELSE xalku = 69
    DRAW "c5 bm" + STR$(xalku + z * 10) + ",163" + Numero$(Num)
NEXT z
RETURN


MenuTekstit:
COLOR c
LINE (8, 0)-(102, 143), 8, B
LOCATE 2, 3: PRINT "QBlicBlock"
LOCATE 3, 8: PRINT Update$
LOCATE 5, 3: PRINT "TOP-SCORE"
hisx = LEN(LTRIM$(STR$(highscore)))
LOCATE 6, 13 - hisx: PRINT LTRIM$(STR$(highscore))
LOCATE 8, 3: PRINT "TOP-LEVEL"
LOCATE 9, 11: PRINT USING "##"; TopLevel
LOCATE 11, 3: PRINT " " + CHR$(27) + " " + CHR$(26) + "  Move"
LOCATE 13, 3: PRINT "  " + CHR$(25) + "   Drop"
LOCATE 15, 3: PRINT " ESC  Quit"
LOCATE 17, 3: PRINT "ENTER Play"
RETURN


PrintScore:
LINE (PX + PK, PK)-(PX + PK * 6 - 1, PY - 2), 0, BF ' score-alueen sisusta
MScore$ = LTRIM$(STR$(score)) ' muutetaan pisteet merkkimuotoon
ScoreLeveys = LEN(MScore$)
FOR z = 1 TO ScoreLeveys
    Num = VAL(MID$(MScore$, z, 1))
    DRAW "c5 bm" + STR$(151 - ((ScoreLeveys * 10) / 2) + z * 10) + ",22" + Numero$(Num)
NEXT z
RETURN


PoistaPalikka:
LINE (PX + x * PK, PY + Y)-(PX + (x + 1) * PK - 1, PY + Y + PK - 1), 0, BF
RETURN


PiirraPalikka:
LINE (NextX, NextY)-(NextX + PK - 1, NextY + PK - 1), block, BF 'tumma reunus
LINE (NextX + 5, NextY + 5)-(NextX + PK - 6, NextY + PK - 6), block + 8, BF 'vaalea sisus
RETURN


Taulukot: 'Tunnistetaan taulukosta Tetris-palikoiden muotoisia muodostelmia ja merkataan ne poisto-taulukkoon
FOR tx = 1 TO 4: FOR ty = 1 TO 6 'O-palikka
        IF Taulukko(tx, ty) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty + 1) = block THEN
            Poistot(tx, ty) = block: Poistot(tx + 1, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty + 1) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 5: FOR ty = 1 TO 4 'I-palikka pysty
        IF Taulukko(tx, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx, ty + 2) = block AND Taulukko(tx, ty + 3) = block THEN
            Poistot(tx, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx, ty + 2) = block: Poistot(tx, ty + 3) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 2: FOR ty = 1 TO 7 'I-palikka vaaka
        IF Taulukko(tx, ty) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx + 2, ty) = block AND Taulukko(tx + 3, ty) = block THEN
            Poistot(tx, ty) = block: Poistot(tx + 1, ty) = block: Poistot(tx + 2, ty) = block: Poistot(tx + 3, ty) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 3: FOR ty = 1 TO 6 'S-palikka vaaka
        IF Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx + 2, ty) = block THEN
            Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 1, ty) = block: Poistot(tx + 2, ty) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 4: FOR ty = 1 TO 5 'S-palikka pysty
        IF Taulukko(tx, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 1, ty + 2) = block THEN
            Poistot(tx, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 1, ty + 2) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 3: FOR ty = 1 TO 6 'Z-palikka vaaka
        IF Taulukko(tx, ty) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 2, ty + 1) = block THEN
            Poistot(tx, ty) = block: Poistot(tx + 1, ty) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 2, ty + 1) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 4: FOR ty = 1 TO 5 'Z-palikka pysty
        IF Taulukko(tx, ty + 1) = block AND Taulukko(tx, ty + 2) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx + 1, ty + 1) = block THEN
            Poistot(tx, ty + 1) = block: Poistot(tx, ty + 2) = block: Poistot(tx + 1, ty) = block: Poistot(tx + 1, ty + 1) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 3: FOR ty = 1 TO 6 'L-palikka vaaka 1
        IF Taulukko(tx, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx + 2, ty) = block THEN
            Poistot(tx, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty) = block: Poistot(tx + 2, ty) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 3: FOR ty = 1 TO 6 'L-palikka vaaka 2
        IF Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 2, ty + 1) = block AND Taulukko(tx + 2, ty) = block THEN
            Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 2, ty + 1) = block: Poistot(tx + 2, ty) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 4: FOR ty = 1 TO 5 'L-palikka pysty 1
        IF Taulukko(tx, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx, ty + 2) = block AND Taulukko(tx + 1, ty + 2) = block THEN
            Poistot(tx, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx, ty + 2) = block: Poistot(tx + 1, ty + 2) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 4: FOR ty = 1 TO 5 'L-palikka pysty 2
        IF Taulukko(tx, ty) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 1, ty + 2) = block THEN
            Poistot(tx, ty) = block: Poistot(tx + 1, ty) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 1, ty + 2) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 3: FOR ty = 1 TO 6 'J-palikka vaaka 1
        IF Taulukko(tx, ty) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx + 2, ty) = block AND Taulukko(tx + 2, ty + 1) = block THEN
            Poistot(tx, ty) = block: Poistot(tx + 1, ty) = block: Poistot(tx + 2, ty) = block: Poistot(tx + 2, ty + 1) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 3: FOR ty = 1 TO 6 'J-palikka vaaka 2
        IF Taulukko(tx, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 2, ty + 1) = block THEN
            Poistot(tx, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 2, ty + 1) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 4: FOR ty = 1 TO 5 'J-palikka pysty 1
        IF Taulukko(tx + 1, ty) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 1, ty + 2) = block AND Taulukko(tx, ty + 2) = block THEN
            Poistot(tx + 1, ty) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 1, ty + 2) = block: Poistot(tx, ty + 2) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 4: FOR ty = 1 TO 5 'J-palikka pysty 2
        IF Taulukko(tx, ty) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx, ty + 2) = block THEN
            Poistot(tx, ty) = block: Poistot(tx + 1, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx, ty + 2) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 3: FOR ty = 1 TO 6 'T-palikka vaaka 1
        IF Taulukko(tx, ty) = block AND Taulukko(tx + 1, ty) = block AND Taulukko(tx + 2, ty) = block AND Taulukko(tx + 1, ty + 1) = block THEN
            Poistot(tx, ty) = block: Poistot(tx + 1, ty) = block: Poistot(tx + 2, ty) = block: Poistot(tx + 1, ty + 1) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 3: FOR ty = 1 TO 6 'T-palikka vaaka 2
        IF Taulukko(tx + 1, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 2, ty + 1) = block THEN
            Poistot(tx + 1, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 2, ty + 1) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 4: FOR ty = 1 TO 5 'T-palikka pysty 1
        IF Taulukko(tx, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx, ty + 2) = block THEN
            Poistot(tx, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx, ty + 2) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
FOR tx = 1 TO 4: FOR ty = 1 TO 5 'T-palikka pysty 2
        IF Taulukko(tx + 1, ty) = block AND Taulukko(tx, ty + 1) = block AND Taulukko(tx + 1, ty + 1) = block AND Taulukko(tx + 1, ty + 2) = block THEN
            Poistot(tx + 1, ty) = block: Poistot(tx, ty + 1) = block: Poistot(tx + 1, ty + 1) = block: Poistot(tx + 1, ty + 2) = block: Poistuu = 1
        END IF
NEXT ty: NEXT tx
IF Poistuu = 1 THEN
    FOR tx = 1 TO 5: FOR ty = 1 TO 7 'valaistaan poistettavat palikat
            IF Poistot(tx, ty) = block THEN
                LINE (PX + tx * PK, PK + (ty) * PK)-(PX + (tx + 1) * PK - 1, PK + (ty + 1) * PK - 1), block + 8, BF 'vaalea kehys
                LINE (PX + tx * PK + 5, PY + (ty - 1) * PK + 5)-(PX + tx * PK + PK - 6, PY + (ty - 1) * PK + PK - 6), 15, BF 'valkea sisus
            END IF
    NEXT ty: NEXT tx
    T = TIMER: DO: LOOP UNTIL TIMER - T > .15 'pikkanen viive
    FOR tx = 1 TO 5: FOR ty = 1 TO 7 'valkaistaan poistettavat palikat
            IF Poistot(tx, ty) = block THEN
                LINE (PX + tx * PK, PK + (ty) * PK)-(PX + (tx + 1) * PK - 1, PK + (ty + 1) * PK - 1), 15, BF 'valkea palikka
            END IF
    NEXT ty: NEXT tx
    T = TIMER: DO: LOOP UNTIL TIMER - T > .15 'pikkanen viive
    laske = 0
    FOR tx = 1 TO 5: FOR ty = 1 TO 7 'poistetaan palikat ruudulta ja annetaan pisteet
            IF Poistot(tx, ty) = block THEN
                laske = laske + 1
                IF PoistotLevel > LevelUp THEN PoistotLevel = LevelUp
                LINE (PX + tx * PK, PK + (ty) * PK)-(PX + (tx + 1) * PK - 1, PK + (ty + 1) * PK - 1), 0, BF
                Poistot(tx, ty) = 0: Taulukko(tx, ty) = 0: score = score + 100 * (laske + level)
            END IF
    NEXT ty: NEXT tx
    PoistotTotal = PoistotTotal + laske
    PoistotLevel = PoistotLevel + laske
END IF
RETURN


Pudotusta: ' pudotellaan palikoita ruudulla ja taulukossa
FOR tx = 1 TO 5
    FOR toista = 1 TO 6
        ty = 8
        FOR typ = 1 TO 6
            ty = ty - 1
            IF Taulukko(tx, ty) = 0 THEN
                IF Taulukko(tx, ty - 1) > 0 THEN
                    MuistaYlempi = Taulukko(tx, ty - 1)
                    LINE (PX + tx * PK, PK + (ty - 1) * PK)-(PX + (tx + 1) * PK - 1, PK + (ty) * PK - 1), 0, BF
                    LINE (PX + tx * PK, PY + (ty - 1) * PK)-(PX + tx * PK + PK - 1, PY + (ty - 1) * PK + PK - 1), MuistaYlempi, BF
                    LINE (PX + tx * PK + 5, PY + (ty - 1) * PK + 5)-(PX + tx * PK + PK - 6, PY + (ty - 1) * PK + PK - 6), MuistaYlempi + 8, BF
                    Taulukko(tx, ty - 1) = 0: Taulukko(tx, ty) = MuistaYlempi
                END IF
            END IF
        NEXT typ
    NEXT toista
NEXT tx
RETURN