Keskustelu: Koodit: QB: Taas yksi Tetris

'
'  T E R Z I S  versio 0.8
'
'  Pelataan nuolinäppäimillä, esc lopettaa
'  Tehnyt Tero Ristolainen 2007-2011
'
'_FULLSCREEN 'qb64-komento
RANDOMIZE TIMER
Aleveys% = 12 ' Kentän leveys
AKorkeus% = 22 ' Kentän korkeus
Tyhjarivi$ = "XXXX" + SPACE$(Aleveys%) + "XXXX"
DIM f%(AKorkeus%)
DIM K$(AKorkeus% + 4)
DIM P$(28)

Alku:
SCREEN 12: CLS

blue = 43: green = 0: red = 0 ' määritetään värit
PALETTE 1, 65536 * blue + 256 * green + red ' sininen
blue = 63: green = 0: red = 0
PALETTE 6, 65536 * blue + 256 * green + red

blue = 0: green = 0: red = 43
PALETTE 2, 65536 * blue + 256 * green + red ' punainen
blue = 0: green = 0: red = 60
PALETTE 7, 65536 * blue + 256 * green + red

blue = 0: green = 43: red = 43
PALETTE 3, 65536 * blue + 256 * green + red ' keltainen
blue = 0: green = 63: red = 63
PALETTE 8, 65536 * blue + 256 * green + red

blue = 0: green = 43: red = 0
PALETTE 4, 65536 * blue + 256 * green + red ' vihreä
blue = 0: green = 63: red = 0
PALETTE 9, 65536 * blue + 256 * green + red

blue = 43: green = 0: red = 43
PALETTE 5, 65536 * blue + 256 * green + red ' violetti
blue = 63: green = 0: red = 63
PALETTE 10, 65536 * blue + 256 * green + red

P$(1) = "0000000000000000" ' palikat
P$(2) = "0110011001100110"
P$(3) = "0110011001100110"
P$(4) = "0000000000000000"
P$(5) = "0100111101001111"
P$(6) = "0100000001000000"
P$(7) = "0100000001000000"
P$(8) = "0100000001000000"
P$(9) = "0000001000100100"
P$(10) = "0111011001110110"
P$(11) = "0010001000000100"
P$(12) = "0000000000000000"
P$(13) = "0111001001000110"
P$(14) = "0001001001110100"
P$(15) = "0000011000000100"
P$(16) = "0000000000000000"
P$(17) = "0010000000100000"
P$(18) = "0110110001101100"
P$(19) = "0100011001000110"
P$(20) = "0000000000000000"
P$(21) = "0100000001000000"
P$(22) = "0110011001100110"
P$(23) = "0010110000101100"
P$(24) = "0000000000000000"
P$(25) = "0111011000010100"
P$(26) = "0100001001110100"
P$(27) = "0000001000000110"
P$(28) = "0000000000000000"
ns = .4 ' Nopeus
nopeus = ns
Pkoko% = 20 ' Palikan koko
level% = 1 ' Taso
score% = 0 ' Pisteet
lines% = 0 ' Poistetut rivit
r% = 15 ' Ruudukon väri
laske% = 0 ' Laske montako riviä
LOCATE 2, 43: PRINT "T E R Z I S  0.8"
LOCATE 4, 34: PRINT "N"
LOCATE 5, 34: PRINT "E"
LOCATE 6, 34: PRINT "X"
LOCATE 7, 34: PRINT "T"
LOCATE 9, 27: PRINT "SCORE"
LOCATE 10, 28: PRINT USING "#####"; score%
LOCATE 12, 27: PRINT "LINES"
LOCATE 13, 28: PRINT USING "#####"; lines%
LOCATE 15, 27: PRINT "LEVEL"
LOCATE 16, 28: PRINT USING "#####"; level%
LINE (200, 124)-(280, 160), 15, B
LINE (200, 172)-(280, 208), 15, B
LINE (200, 220)-(280, 256), 15, B
FOR y% = 1 TO AKorkeus% + 4
    K$(y%) = Tyhjarivi$
NEXT y%
K$(AKorkeus% + 1) = STRING$(Aleveys% + 8, "X")
ReunaX% = 320 - (Pkoko% * Aleveys%) / 2
ReunaY% = 240 - (Pkoko% * AKorkeus%) / 2
LINE (ReunaX% + 4 * Pkoko% - 1, ReunaY% + Pkoko% - 1)-(ReunaX% + Pkoko% * (Aleveys% + 4), ReunaY% + Pkoko% * AKorkeus%), 15, B
FOR x% = 4 TO Aleveys% + 3
    FOR y% = 2 TO AKorkeus%
        LINE (ReunaX% + x% * Pkoko% + Pkoko% - 1, ReunaY% + y% * Pkoko% - Pkoko%)-(ReunaX% + x% * Pkoko%, ReunaY% + y% * Pkoko% - 1), r%, BF
    NEXT
NEXT
GOSUB Seuraava

DO
    GOSUB Seuraava
    x% = Aleveys% / 2 + 2 ' Palikan x-koordinaatti
    FOR y% = 1 TO AKorkeus%
        GOSUB Varjopalikka
        GOSUB Piirto
        t = TIMER
        DO
            A$ = INKEY$
            IF A$ <> "" THEN
                IF A$ = CHR$(27) THEN END ' Escillä lopettaa
                IF A$ = CHR$(0) + "K" THEN ' Nuoli vasemmalle
                    GOSUB Poisto
                    x% = x% - 1: GOSUB Tarkista
                    IF Tark% = 1 THEN
                        x% = x% + 1
                    END IF
                    GOSUB Varjopalikka: GOSUB Piirto
                END IF
                IF A$ = CHR$(0) + "M" THEN ' Nuoli oikealle
                    GOSUB Poisto
                    x% = x% + 1: GOSUB Tarkista
                    IF Tark% = 1 THEN
                        x% = x% - 1
                    END IF
                    GOSUB Varjopalikka: GOSUB Piirto
                END IF
                IF A$ = CHR$(0) + "H" THEN ' Nuoli ylös
                    GOSUB Poisto
                    s% = s% + 1
                    IF s% = 5 THEN s% = 1
                    GOSUB Tarkista
                    IF Tark% = 1 THEN
                        s% = s% - 1
                        IF s% = 0 THEN s% = 4
                    END IF
                    GOSUB Varjopalikka: GOSUB Piirto
                END IF
                IF A$ = CHR$(0) + "P" AND turbo% = 0 THEN ' nuoli alas
                    nopeus = .01: turbo% = 1
                END IF
            END IF
        LOOP UNTIL TIMER - t > nopeus
        GOSUB Pohja
        IF toks% = 1 THEN EXIT FOR
        GOSUB Poisto
    NEXT y%
    loppuko% = y%: turbo% = 0
    GOSUB Rivit
    IF laske% >= 20 THEN
        laske% = 0: level% = level% + 1: ns = ns - .05
        LOCATE 16, 28: PRINT USING "#####"; level%
    END IF
    nopeus = ns
    IF loppuko% < 2 THEN
        LOCATE 2, 42: PRINT "G A M E   O V E R";
        DO
            go$ = INPUT$(1)
            SELECT CASE go$
                CASE CHR$(27): END
                CASE CHR$(13): EXIT DO
                CASE ELSE
                    LOCATE 25, 10: PRINT "Enter = new game"
                    LOCATE 26, 10: PRINT "Esc = quit game"
            END SELECT
        LOOP
        GOTO Alku
    END IF
LOOP


Taulukkoon: ' Sijoitetaan palikka taulukkoon
FOR qy% = 1 TO 4
    FOR qx% = 1 TO 4
        IF MID$(P$(n% * 4 - 4 + qy%), s% * 4 - 4 + qx%, 1) = "1" THEN
            MID$(K$(y% + qy%), x% + qx%, 1) = LTRIM$(STR$(v%))
        END IF
    NEXT
NEXT
RETURN


Poisto: ' poistetaan palikka & varjopalikka
FOR zy% = 1 TO 4
    FOR zx% = 1 TO 4
        IF MID$(P$(n% * 4 - 4 + zy%), s% * 4 - 4 + zx%, 1) = "1" THEN
            LINE (ReunaX% + (x% + zx%) * Pkoko% - Pkoko%, ReunaY% + (y% + zy%) * Pkoko% - Pkoko%)-(ReunaX% + (x% + zx%) * Pkoko% - 1, ReunaY% + (y% + zy%) * Pkoko% - 1), r%, BF
            LINE (ReunaX% + (x% + zx%) * Pkoko% - Pkoko%, ReunaY% + (varjoy% + zy%) * Pkoko% - Pkoko%)-(ReunaX% + (x% + zx%) * Pkoko% - 1, ReunaY% + (varjoy% + zy%) * Pkoko% - 1), r%, B
        END IF
    NEXT
NEXT
RETURN


Piirto: ' Piirretään palikka
FOR zy% = 1 TO 4
    FOR zx% = 1 TO 4
        IF MID$(P$(n% * 4 - 4 + zy%), s% * 4 - 4 + zx%, 1) = "1" THEN
            LINE (ReunaX% + (x% + zx%) * Pkoko% - Pkoko%, ReunaY% + (y% + zy%) * Pkoko% - Pkoko%)-(ReunaX% + (x% + zx%) * Pkoko% - 1, ReunaY% + (y% + zy%) * Pkoko% - 1), v%, B
            LINE (ReunaX% + (x% + zx%) * Pkoko% - Pkoko% + 1, ReunaY% + (y% + zy%) * Pkoko% - Pkoko% + 1)-(ReunaX% + (x% + zx%) * Pkoko% - 2, ReunaY% + (y% + zy%) * Pkoko% - 2), v2%, BF
            IF zy% > 1 AND MID$(P$(n% * 4 - 4 + zy% - 1), s% * 4 - 4 + zx%, 1) = "1" THEN
                LINE (ReunaX% + (x% + zx%) * Pkoko% - Pkoko% + 1, ReunaY% + (y% + zy%) * Pkoko% - Pkoko%)-(ReunaX% + (x% + zx%) * Pkoko% - 2, ReunaY% + (y% + zy%) * Pkoko% - Pkoko%), v2%
            END IF
            IF zy% < 4 AND MID$(P$(n% * 4 - 4 + zy% + 1), s% * 4 - 4 + zx%, 1) = "1" THEN
                LINE (ReunaX% + (x% + zx%) * Pkoko% - Pkoko% + 1, ReunaY% + (y% + zy%) * Pkoko% - 1)-(ReunaX% + (x% + zx%) * Pkoko% - 2, ReunaY% + (y% + zy%) * Pkoko% - 1), v2%
            END IF
            IF zx% > 1 AND MID$(P$(n% * 4 - 4 + zy%), s% * 4 - 4 + zx% - 1, 1) = "1" THEN
                LINE (ReunaX% + (x% + zx%) * Pkoko% - Pkoko%, ReunaY% + (y% + zy%) * Pkoko% - Pkoko% + 1)-(ReunaX% + (x% + zx%) * Pkoko% - Pkoko%, ReunaY% + (y% + zy%) * Pkoko% - 2), v2%
            END IF
            IF zx% < 4 AND MID$(P$(n% * 4 - 4 + zy%), s% * 4 - 4 + zx% + 1, 1) = "1" THEN
                LINE (ReunaX% + (x% + zx%) * Pkoko% - 1, ReunaY% + (y% + zy%) * Pkoko% - Pkoko% + 1)-(ReunaX% + (x% + zx%) * Pkoko% - 1, ReunaY% + (y% + zy%) * Pkoko% - 2), v2%
            END IF
        END IF
    NEXT
NEXT
RETURN


Pohja: ' Tarkistetaan tuleeko pohjakosketus
toks% = 0
FOR zy% = 1 TO 4
    FOR zx% = 1 TO 4
        IF MID$(P$(n% * 4 - 4 + zy%), s% * 4 - 4 + zx%, 1) = "1" THEN
            IF MID$(K$(y% + zy% + 1), x% + zx%, 1) <> " " THEN GOSUB Taulukkoon: toks% = 1
        END IF
    NEXT
NEXT
RETURN


Tarkista: ' tarkistetaan onko palikan alla tilaa
Tark% = 0
FOR qy% = 1 TO 4
    FOR qx% = 1 TO 4
        IF MID$(K$(y% + qy%), x% + qx%, 1) <> " " THEN
            IF MID$(P$(n% * 4 - 4 + qy%), s% * 4 - 4 + qx%, 1) = "1" THEN Tark% = 1
        END IF
    NEXT
NEXT
RETURN


Rivit:
rivi% = 0: lns% = 0
FOR y% = 1 TO AKorkeus% ' Valaistaan poistettava rivi...
    f%(y%) = 0
    FOR x% = 5 TO Aleveys% + 4
        IF MID$(K$(y%), x%, 1) = " " THEN f%(y%) = 1
    NEXT x%
    IF f%(y%) = 0 THEN
        LINE (ReunaX% + 4 * Pkoko%, ReunaY% + Pkoko% * y% - 1)-(ReunaX% + (Aleveys% + 3) * Pkoko% + Pkoko% - 1, ReunaY% + Pkoko% * y% - Pkoko%), 15, BF
        rivi% = 1: lns% = lns% + 1: lines% = lines% + 1: laske% = laske% + 1
    END IF
NEXT y%
IF rivi% = 1 THEN
    IF lns% = 1 THEN score% = score% + 10 * level% ' Annetaan pisteitä
    IF lns% = 2 THEN score% = score% + 30 * level%
    IF lns% = 3 THEN score% = score% + 60 * level%
    IF lns% = 4 THEN score% = score% + 100 * level%
    LOCATE 10, 28: PRINT USING "#####"; score%
    LOCATE 13, 28: PRINT USING "#####"; lines%
    t2 = TIMER
    DO
    LOOP UNTIL TIMER - t2 > .5 ' Odotetaan puoli sekuntia
    FOR y% = 1 TO AKorkeus% ' ...ja poistetaan se
        IF f%(y%) = 0 THEN
            K$(y%) = Tyhjarivi$
            LINE (ReunaX% + 4 * Pkoko%, ReunaY% + Pkoko% * y% - 1)-(ReunaX% + (Aleveys% + 3) * Pkoko% + Pkoko% - 1, ReunaY% + Pkoko% * y% - Pkoko%), r%, BF
        END IF
    NEXT y%
    FOR y% = 1 TO AKorkeus% ' pudotetaan rivejä alaspäin
        IF f%(y%) = 0 THEN
            REDIM Tiputus%(25000)
            GET (ReunaX% + 4 * Pkoko%, ReunaY% + Pkoko% * 2 - 1)-(ReunaX% + (Aleveys% + 3) * Pkoko% + Pkoko% - 1, ReunaY% + Pkoko% * y% - Pkoko% - 1), Tiputus%()
            PUT (ReunaX% + 4 * Pkoko%, ReunaY + Pkoko% * 3 + Pkoko% - 1), Tiputus%(), PSET
        END IF
    NEXT y%
    FOR Putoo% = 1 TO AKorkeus%
        FOR y% = AKorkeus% TO 1 STEP -1 ' pudotetaan rivejä alaspäin taulukossa
            IF K$(y%) = Tyhjarivi$ THEN
                FOR y2% = y% TO 2 STEP -1
                    K$(y2%) = K$(y2% - 1)
                NEXT y2%
                K$(1) = Tyhjarivi$
            END IF
        NEXT y%
    NEXT Putoo%
END IF
RETURN


Seuraava: ' Arvotaan seuraava palikka
n% = na%
s% = sa%
v% = va%
v2% = va2%
na% = INT(RND * 7) + 1
sa% = INT(RND * 4) + 1
va% = INT(RND * 5) + 1
va2% = va% + 5
IF n% = 0 THEN n% = na%: s% = sa%: v% = va%
LINE (ReunaX% + Pkoko% - Pkoko% * 2, Pkoko% * 2)-(ReunaX% + 4 * Pkoko% - Pkoko%, 5 * Pkoko% + Pkoko%), 0, BF
backupx% = x%: x% = -1: backupy% = y%: y% = 1
backupn% = n%: n% = na%
backups% = s%: s% = sa%
backupv% = v%: v% = va%
backupv2% = v2%: v2% = va2%
GOSUB Piirto
x% = backupx%: y% = backupy%
n% = backupn%: s% = backups%: v% = backupv%: v2% = backupv2%
RETURN


Varjopalikka:
Tarkmem% = Tark%: ymem% = y%: v2mem% = v2%: v2% = r%
FOR y% = ymem% TO AKorkeus%
    GOSUB Tarkista
    IF Tark% = 1 THEN
        y% = y% - 1: GOSUB Piirto
        y% = y% + 1
        EXIT FOR
    END IF
NEXT y%
varjoy% = y% - 1
Tark% = Tarkmem%: y% = ymem%: v2% = v2mem%
RETURN