Keskustelu: Koodit: QB64: Puzzlepeli 2048

_TITLE "2 0 4 8"
RANDOMIZE TIMER
SCREEN _NEWIMAGE(660, 660, 32)

rootpath$ = ENVIRON$("SYSTEMROOT") 'ladataan fontit
fontfile$ = rootpath$ + "\Fonts\arial.ttf"
f& = _LOADFONT(fontfile$, 60)
pf& = _LOADFONT(fontfile$, 20)
_PRINTMODE _KEEPBACKGROUND

DIM gridxy(4, 4)
DIM r(2048), g(2048), b(2048)

Alku:
voitto$ = "EI TOTTA"
rb = INT(RND * 55) + 20 'arvotaan taustav„rit
gb = INT(RND * 55) + 20
bb = INT(RND * 55) + 20
GOSUB Ruudukko
FOR y = 90 TO 570 'taustan sumennusefekti
    FOR x = 90 TO 570
        IF POINT(x, y) = _RGB(rb - 10, gb - 10, bb - 10) THEN PSET (x, y), _RGB(10, 10, 10) ELSE PSET (x, y), _RGB(20, 20, 20)
    NEXT x
NEXT y
_FONT pf&
Teksti$ = "v.0.2.0": pituus = _PRINTWIDTH(Teksti$)
COLOR _RGB(200, 200, 200): _PRINTSTRING (570 - pituus, 91), Teksti$
_FONT f&
Teksti$ = "2 0 4 8": puolet = _PRINTWIDTH(Teksti$) / 2
COLOR _RGB(200, 200, 200): _PRINTSTRING (330 - puolet, 130), Teksti$
LINE (330 - puolet, 190)-(330 + puolet, 194), _RGB(200, 200, 200), BF
Teksti$ = "Play with wasd": puolet = _PRINTWIDTH(Teksti$) / 2
COLOR _RGB(200, 200, 200): _PRINTSTRING (330 - puolet, 270), Teksti$
Teksti$ = "or arrow keys.": puolet = _PRINTWIDTH(Teksti$) / 2
COLOR _RGB(200, 200, 200): _PRINTSTRING (330 - puolet, 330), Teksti$
Teksti$ = "Enter = Start": puolet = _PRINTWIDTH(Teksti$) / 2
tc = 0: suunta = 1
DO
    tc = tc + suunta
    IF tc = 155 THEN suunta = -1
    IF tc = 0 THEN suunta = 1
    COLOR _RGB(100 + tc, 100 + tc, 100 + tc): _PRINTSTRING (330 - puolet, 470), Teksti$ 'vilkkuvaa tekstia
    _DELAY .001
    ka$ = INKEY$
    IF ka$ = CHR$(13) THEN EXIT DO
    IF ka$ = CHR$(27) THEN GOTO Loppu
LOOP
GOSUB Ruudukko
GOSUB Varit
FOR z = 1 TO 2
    GOSUB Arpa
NEXT z

DO
    FOR x = 1 TO 4
        FOR y = 1 TO 4
            lukko$(x, y) = ""
        NEXT y
    NEXT x
    DO
        d$ = "5"
        k$ = INKEY$
        SELECT CASE k$
            CASE CHR$(27): d$ = "0"
            CASE CHR$(13): GOTO Alku
            CASE CHR$(0) + "K", "a", "A", "4": d$ = "4"
            CASE CHR$(0) + "M", "d", "D", "6": d$ = "6"
            CASE CHR$(0) + "H", "w", "W", "8": d$ = "8"
            CASE CHR$(0) + "P", "s", "S", "2": d$ = "2"
        END SELECT
        IF d$ <> "5" THEN EXIT DO
    LOOP
    SELECT CASE d$
        CASE "0": EXIT DO
        CASE "2": xp = 0: yp = -1: GOSUB Laskenta
        CASE "8": xp = 0: yp = 1: GOSUB Laskenta
        CASE "6": xp = -1: yp = 0: GOSUB Laskenta
        CASE "4": xp = 1: yp = 0: GOSUB Laskenta
    END SELECT
    IF voitto$ = "TOTTA" THEN
        FOR y = 280 TO 380 'taustan sumennusefekti
            FOR x = 100 TO 560
                IF POINT(x, y) = _RGB(rb - 10, gb - 10, bb - 10) THEN PSET (x, y), _RGB(10, 10, 25) ELSE PSET (x, y), _RGB(10, 10, 50)
            NEXT x
        NEXT y
        tc = 0: suunta = 1
        Teksti$ = "VICTORY!": puolet = _PRINTWIDTH(Teksti$) / 2
        DO
            tc = tc + suunta
            IF tc = 155 THEN suunta = -1
            IF tc = 0 THEN suunta = 1
            COLOR _RGB(10, 10, 100 + tc)
            _PRINTSTRING (330 - puolet, 305), Teksti$
            _DELAY .001
            kv$ = INKEY$
            IF kv$ = CHR$(13) THEN GOTO Alku
            IF kv$ = CHR$(27) THEN GOTO Loppu
        LOOP
    END IF
    mahtuu = 0
    FOR x = 1 TO 4
        FOR y = 1 TO 4
            IF gridxy(x, y) = 0 THEN mahtuu = 1
        NEXT y
    NEXT x
    IF mahtuu = 1 AND siirto = 1 THEN
        GOSUB Arpa 'arvotaan uuden palikan sijanti jos ruudukossa tilaa
    ELSE
        osuma = 0 'tarkistetaan voiko tehda siirtoja
        FOR y = 1 TO 4
            FOR x = 1 TO 3
                IF gridxy(x, y) = gridxy(x + 1, y) THEN osuma = osuma + 1
            NEXT x
        NEXT y
        FOR x = 1 TO 4
            FOR y = 1 TO 3
                IF gridxy(x, y) = gridxy(x, y + 1) THEN osuma = osuma + 1
            NEXT y
        NEXT x
        IF osuma = 0 THEN 'game over
            FOR y = 280 TO 380 'taustan sumennusefekti
                FOR x = 100 TO 560
                    IF POINT(x, y) = _RGB(rb - 10, gb - 10, bb - 10) THEN PSET (x, y), _RGB(25, 10, 10) ELSE PSET (x, y), _RGB(50, 20, 20)
                NEXT x
            NEXT y
            tc = 0: suunta = 1
            Teksti$ = "GAME   OVER": puolet = _PRINTWIDTH(Teksti$) / 2
            DO
                tc = tc + suunta
                IF tc = 155 THEN suunta = -1
                IF tc = 0 THEN suunta = 1
                COLOR _RGB(100 + tc, 10, 10)
                _PRINTSTRING (330 - puolet, 305), Teksti$
                _DELAY .001
                kg$ = INKEY$
                IF kg$ = CHR$(13) THEN GOTO Alku
                IF kg$ = CHR$(27) THEN GOTO Loppu
            LOOP
        END IF
    END IF
LOOP


Loppu:
_FONT 16
_FREEFONT f&
_FREEFONT pf&
SYSTEM


Ruudukko:
CLS , _RGB(rb - 10, gb - 10, bb - 10)
FOR y = 1 TO 4
    FOR x = 1 TO 4
        LINE (x * 160 - 140, y * 160 - 140)-(x * 160, y * 160), _RGB(rb, gb, bb), BF
        gridxy(x, y) = 0
    NEXT x
NEXT y
RETURN


Varit: 'arvotaan palikoiden varit
c = 2
DO
    r(c) = INT(RND * 75) + 1
    g(c) = INT(RND * 75) + 1
    b(c) = INT(RND * 75) + 1
    IF c = 2048 THEN EXIT DO
    c = c + c
LOOP
c = 2
RETURN


Arpa:
DO
    x = INT(RND * 4) + 1
    y = INT(RND * 4) + 1
    IF gridxy(x, y) = 0 THEN EXIT DO
LOOP
t$ = "2"
gridxy(x, y) = 2
c = 2
GOSUB Animaatio
GOSUB Piirto
RETURN


Laskenta:
siirto = 0
FOR z = 1 TO 3
    IF xp = 0 THEN
        FOR x = 1 TO 4
            IF yp = -1 THEN
                FOR y = 4 TO 2 STEP -1
                    GOSUB Liikuta
                NEXT y
            ELSE
                FOR y = 1 TO 3
                    GOSUB Liikuta
                NEXT y
            END IF
        NEXT x
    ELSE
        FOR y = 1 TO 4
            IF xp = -1 THEN
                FOR x = 4 TO 2 STEP -1
                    GOSUB Liikuta
                NEXT x
            ELSE
                FOR x = 1 TO 3
                    GOSUB Liikuta
                NEXT x
            END IF
        NEXT y
    END IF
NEXT z
RETURN


Liikuta:
IF gridxy(x, y) = 0 THEN
    IF gridxy(x + xp, y + yp) <> 0 THEN
        LINE ((x + xp) * 160 - 140, (y + yp) * 160 - 140)-((x + xp) * 160, (y + yp) * 160), _RGB(rb, gb, bb), BF
        LINE (x * 160 - 140, y * 160 - 140)-(x * 160, y * 160), _RGB(r(c) + 125, g(c) + 125, b(c) + 125), BF
        SWAP gridxy(x, y), gridxy(x + xp, y + yp)
        c = gridxy(x, y)
        t$ = LTRIM$(STR$(gridxy(x, y)))
        GOSUB Piirto
        siirto = 1
    END IF
ELSE
    IF gridxy(x, y) = gridxy(x + xp, y + yp) THEN
        gridxy(x, y) = gridxy(x, y) * 2
        c = gridxy(x, y)
        IF c = 2048 THEN voitto$ = "TOTTA"
        gridxy(x + xp, y + yp) = 0
        LINE ((x + xp) * 160 - 140, (y + yp) * 160 - 140)-((x + xp) * 160, (y + yp) * 160), _RGB(rb, gb, bb), BF
        t$ = LTRIM$(STR$(gridxy(x, y)))
        GOSUB Animaatio2
        GOSUB Piirto
        siirto = 1
    END IF
END IF
RETURN


Piirto: 'piirretaan palikka
LINE (x * 160 - 140, y * 160 - 140)-(x * 160, y * 160), _RGB(r(c) + 125, g(c) + 125, b(c) + 125), BF
COLOR _RGB(r(c) + 180, g(c) + 180, b(c) + 180)
l = _PRINTWIDTH(t$) / 2
h = _FONTHEIGHT / 2
_PRINTSTRING (x * 160 - 70 - l, y * 160 - 70 - h), t$
RETURN


Animaatio:
FOR a = 1 TO 70
    LINE (x * 160 - 70 - a, y * 160 - 70 - a)-(x * 160 - 70 + a, y * 160 - 70 + a), _RGB(r(c) + 125, g(c) + 125, b(c) + 125), B
    _DELAY .0001
NEXT a
RETURN


Animaatio2:
FOR a = 70 TO 1 STEP -1
    LINE (x * 160 - 70 - a, y * 160 - 70 - a)-(x * 160 - 70 + a, y * 160 - 70 + a), _RGB(r(c) + 125, g(c) + 125, b(c) + 125), B
    _DELAY .0001
NEXT a
RETURN