Keskustelu: Projektit: Pallot (Shariki)

RANDOMIZE TIMER
SCREEN 12
_TITLE "Pallot (Shariki)"
DIM lauta(8, 8), poistot(8, 8), topname$(15), topscore(15)
IF _FILEEXISTS("Shariki.top") THEN ' Luetaan/luodaan high scoret
    OPEN "Shariki.top" FOR INPUT AS #1
    FOR y = 1 TO 15
        INPUT #1, topname$(y)
        INPUT #1, topscore(y)
    NEXT y
    INPUT #1, moodi
    CLOSE #1
ELSE
    OPEN "Shariki.top" FOR OUTPUT AS #1
    FOR y = 1 TO 15
        PRINT #1, "-": topname$(y) = "-"
        PRINT #1, 0: topscore(y) = 0
    NEXT y
    PRINT #1, 2
    CLOSE #1
END IF
GOSUB RuudunKoko
pkoko = 17
CLS , 8
FOR y = 2 TO 479 STEP 3 ' Piirretaan taustan tekstuuri
    FOR x = 2 TO 639 STEP 3
        PSET (x, y), 0
    NEXT x
NEXT y
LINE (149, 68)-(491, 411), 0, BF ' Piirretaan tyylikas kehikko
LINE (150, 69)-(490, 410), 8, BF
LINE (151, 70)-(489, 409), 7, BF
LINE (152, 71)-(488, 408), 15, B
LINE (154, 73)-(486, 406), 8, B
_PRINTMODE _KEEPBACKGROUND
COLOR 2: LOCATE 30, 1: PRINT " Pallot (Shariki) v.0.8 by Tertsi 2020 - ON ERROR GOTO Ohjelmointiputka!";
COLOR 0, 7
KEY(1) ON ' F1-napilla voi vaihtaa kuvasuhdetta
ON KEY(1) GOSUB RuudunKoko
Alku:
LINE (155, 75)-(485, 405), 7, BF
IF Peli <> 3 THEN Peli = 0
FOR x = 1 TO 8
    FOR y = 1 TO 8
        GOSUB Piirto
    NEXT y
NEXT x
DO
    GOSUB Tarkistus
    IF poistoja = 0 THEN EXIT DO
LOOP
score = 0
Ikkuna 512, 53, 612, 106
LINE (512, 76)-(612, 100), 0, BF
LINE (513, 77)-(611, 99), 8, B
COLOR 15, 7
_PRINTSTRING (539, 59), "PALLOT"
COLOR 0, 7
_PRINTSTRING (538, 58), "PALLOT"
_PRINTMODE _FILLBACKGROUND
COLOR 2, 0: _PRINTSTRING (516, 81), " 0"
_DISPLAY
valittu = 0
valittux1 = 0
valittuy1 = 0
valittux2 = 0
valittuy2 = 0
Peli = 1 'peli-muuttujat: 1 = peli kaynnissa, 0 = peli ohi, 2 = parhaat pelaajat, 3 = Shariki historiikki

DO
    DO WHILE _MOUSEINPUT
        mx = _MOUSEX
        my = _MOUSEY
        lx = INT(mx / 40) - 3
        ly = INT(my / 40) - 1
        IF lx > 0 AND lx < 9 AND ly > 0 AND ly < 9 THEN
            lc = lauta(lx, ly)
        ELSE
            lc = 0
        END IF
        IF Peli <> 1 THEN lc = 9
        IF _MOUSEBUTTON(1) = -1 AND lc <> 0 THEN nappi = 1
        IF _MOUSEBUTTON(1) = 0 AND nappi = 1 THEN nappi = 2
        IF nappi = 2 AND Peli = 0 THEN
            LINE (155, 75)-(485, 405), 7, BF
            IF mx > 270 AND mx < 370 AND my > 190 AND my < 290 THEN
                IF score >= topscore(15) THEN
                    GOSUB Kysynimi
                END IF
                GOSUB Toplista
            END IF
            nappi = 0
        END IF
        IF nappi = 2 AND Peli = 3 THEN
            LINE (155, 75)-(485, 405), 7, BF
            nappi = 0
            _DISPLAY
            GOTO Alku
        END IF
        IF nappi = 2 AND Peli = 2 THEN
            nappi = 0
            GOTO Alku
        END IF
        IF nappi = 2 AND Peli = 1 THEN
            nappi = 0
            sama = 0
            IF lx = valittux1 AND ly = valittuy1 THEN sama = 1
            IF lx = valittux2 AND ly = valittuy2 THEN sama = 1
            IF sama = 0 THEN
                IF valittu = 1 THEN
                    matka = 0
                    xerotus = valittux1 - lx
                    yerotus = valittuy1 - ly
                    IF xerotus = yerotus THEN matka = 1
                    IF xerotus < -1 THEN matka = 1
                    IF xerotus > 1 THEN matka = 1
                    IF yerotus < -1 THEN matka = 1
                    IF yerotus > 1 THEN matka = 1
                    IF matka = 0 THEN
                        valittu = 2: valittux2 = lx: valittuy2 = ly
                        LINE (121 + lx * 40, 41 + ly * 40)-(159 + lx * 40, 79 + ly * 40), lc, BF
                        LINE (120 + lx * 40, 40 + ly * 40)-(160 + lx * 40, 80 + ly * 40), 0, B
                        _DISPLAY
                    END IF
                END IF
            END IF
            IF valittu = 0 THEN
                valittu = 1: valittux1 = lx: valittuy1 = ly
                LINE (121 + lx * 40, 41 + ly * 40)-(159 + lx * 40, 79 + ly * 40), lc, BF
                LINE (120 + lx * 40, 40 + ly * 40)-(160 + lx * 40, 80 + ly * 40), 0, B
                _DISPLAY
            END IF
            IF valittu = 2 THEN
                LINE (122 + valittux1 * 40, 42 + valittuy1 * 40)-(158 + valittux1 * 40, 78 + valittuy1 * 40), lauta(valittux1, valittuy1), BF
                LINE (122 + valittux2 * 40, 42 + valittuy2 * 40)-(158 + valittux2 * 40, 78 + valittuy2 * 40), lauta(valittux2, valittuy2), BF
                _DISPLAY
                _DELAY .5
                SWAP lauta(valittux1, valittuy1), lauta(valittux2, valittuy2)
                SWAP valittux1, valittux2
                SWAP valittuy1, valittuy2
                FOR z = 1 TO pkoko
                    WHILE _MOUSEINPUT: WEND
                    CIRCLE (140 + valittux1 * 40, 60 + valittuy1 * 40), z, lauta(valittux1, valittuy1)
                    CIRCLE (140 + valittux2 * 40, 60 + valittuy2 * 40), z, lauta(valittux2, valittuy2)
                    _DISPLAY
                    _DELAY .01
                NEXT z
                LINE (120 + valittux1 * 40, 40 + valittuy1 * 40)-(160 + valittux1 * 40, 80 + valittuy1 * 40), 7, BF
                LINE (120 + valittux2 * 40, 40 + valittuy2 * 40)-(160 + valittux2 * 40, 80 + valittuy2 * 40), 7, BF
                CIRCLE (140 + valittux1 * 40, 60 + valittuy1 * 40), pkoko, lauta(valittux1, valittuy1)
                PAINT (140 + valittux1 * 40, 60 + valittuy1 * 40), lauta(valittux1, valittuy1)
                CIRCLE (140 + valittux1 * 40, 60 + valittuy1 * 40), pkoko, 0
                CIRCLE (140 + valittux2 * 40, 60 + valittuy2 * 40), pkoko, lauta(valittux2, valittuy2)
                PAINT (140 + valittux2 * 40, 60 + valittuy2 * 40), lauta(valittux2, valittuy2)
                CIRCLE (140 + valittux2 * 40, 60 + valittuy2 * 40), pkoko, 0
                _DISPLAY
                valittu = 0
                valittux1 = 0
                valittuy1 = 0
                valittux2 = 0
                valittuy2 = 0
                oldscore = score
                DO
                    GOSUB Tarkistus
                    IF poistoja = 0 THEN EXIT DO
                LOOP
                IF score = oldscore THEN
                    GOSUB Mokasit
                    _DISPLAY
                    PLAY "o0 g"
                    Peli = 0
                END IF
            END IF
        END IF
    LOOP
LOOP UNTIL INKEY$ = CHR$(27)
Loppu:
SYSTEM

Kysynimi:
Ikkuna 180, 100, 460, 200
COLOR 0, 7
LOCATE 9, 26: PRINT "Kirjoita nimesi ja paina ENTER"
_DISPLAY
COLOR 0, 7
DO
    WHILE _MOUSEINPUT: WEND
    COLOR 0, 7: LOCATE 11, 25: PRINT nimi$;
    COLOR 4, 7: PRINT "_ ";
    _DISPLAY
    k$ = INKEY$
    IF k$ <> "" THEN
        SELECT CASE k$
            CASE CHR$(13): EXIT DO
            CASE CHR$(8): IF pts > 0 THEN pts = pts - 1: nim$ = LEFT$(nimi$, pts): nimi$ = nim$
            CASE ELSE: IF pts < 21 THEN pts = pts + 1: nimi$ = nimi$ + k$
        END SELECT
        COLOR 0, 7: LOCATE 11, 25: PRINT nimi$;
        _DISPLAY
    END IF
LOOP
FOR y = 1 TO 15
    IF score >= topscore(y) THEN EXIT FOR
NEXT y
FOR fy = 15 TO y + 1 STEP -1
    SWAP topname$(fy), topname$(fy - 1)
    SWAP topscore(fy), topscore(fy - 1)
NEXT fy
topname$(y) = nimi$
topscore(y) = score
OPEN "Shariki.top" FOR OUTPUT AS #1
FOR z = 1 TO 15
    PRINT #1, topname$(z)
    PRINT #1, topscore(z)
NEXT z
PRINT #1, moodi
CLOSE #1
score = 0
RETURN


Toplista:
LINE (155, 75)-(485, 405), 7, BF
COLOR 0, 7
LOCATE 7, 33: PRINT "PARHAAT PELAAJAT"
FOR y = 1 TO 15
    LOCATE 8 + y, 26: PRINT USING "##"; y;
    LOCATE 8 + y, 30: PRINT topname$(y);
    LOCATE 8 + y, 51: PRINT USING "#####"; topscore(y);
NEXT y
_DISPLAY
Peli = 2
RETURN


Mokasit:
Ikkuna 270, 190, 370, 290
COLOR 0, 7: _PRINTSTRING (290, 270), "PELI OHI"
IF _FILEEXISTS("facepalm.txt") THEN 'ladataan pikselitaidetta
    OPEN "facepalm.txt" FOR INPUT AS #1
    FOR y = 1 TO 60
        INPUT #1, Rivi$
        FOR x = 1 TO 85
            IF MID$(Rivi$, x, 1) = "0" THEN PSET (278 + x, 200 + y), 0
        NEXT x
    NEXT y
    CLOSE #1
END IF
RETURN

Tarkistus:
FOR x = 1 TO 8
    FOR y = 1 TO 8
        WHILE _MOUSEINPUT: WEND 'disabloidaan hiiren toiminta jottei tule virhepainalluksia
        poistot(x, y) = 0
    NEXT y
NEXT x
FOR y = 1 TO 8
    FOR x = 1 TO 6
        WHILE _MOUSEINPUT: WEND
        IF lauta(x, y) = lauta(x + 1, y) AND lauta(x, y) = lauta(x + 2, y) AND lauta(x, y) > 0 THEN poistot(x, y) = 1: poistot(x + 1, y) = 1: poistot(x + 2, y) = 1
    NEXT x
NEXT y
FOR x = 1 TO 8
    FOR y = 1 TO 6
        WHILE _MOUSEINPUT: WEND
        IF lauta(x, y) = lauta(x, y + 1) AND lauta(x, y) = lauta(x, y + 2) AND lauta(x, y) > 0 THEN poistot(x, y) = 1: poistot(x, y + 1) = 1: poistot(x, y + 2) = 1
    NEXT y
NEXT x
poistoja = 0
FOR x = 1 TO 8
    FOR y = 1 TO 8
        WHILE _MOUSEINPUT: WEND
        IF poistot(x, y) = 1 THEN
            lauta(x, y) = 0
            IF Peli = 1 THEN
                FOR z = pkoko TO 1 STEP -1
                    WHILE _MOUSEINPUT: WEND
                    CIRCLE (140 + x * 40, 60 + y * 40), z, 7
                    _DISPLAY
                    _DELAY .01
                NEXT z
            END IF
            LINE (120 + x * 40, 40 + y * 40)-(160 + x * 40, 80 + y * 40), 7, BF
            poistoja = poistoja + 1
            score = score + 1
            COLOR 2, 0: _PRINTSTRING (516, 81), STR$(score)
            IF Peli = 1 THEN _DISPLAY
            poistot(x, y) = 0
        END IF
    NEXT y
NEXT x
IF poistoja > 0 THEN
    FOR toisto = 1 TO 5
        vaihtoja = 0
        FOR x = 1 TO 8
            FOR y = 8 TO 2 STEP -1
                WHILE _MOUSEINPUT: WEND
                IF lauta(x, y) = 0 THEN
                    IF POINT(140 + x * 40, 20 + y * 40) = 7 THEN viive = 0 ELSE viive = .1: vari = POINT(140 + x * 40, 20 + y * 40)
                    LINE (120 + x * 40, y * 40)-(160 + x * 40, y * 40 + 40), 7, BF
                    SWAP lauta(x, y), lauta(x, y - 1)
                    CIRCLE (140 + x * 40, 60 + y * 40), pkoko, vari
                    PAINT (140 + x * 40, 60 + y * 40), vari
                    CIRCLE (140 + x * 40, 60 + y * 40), pkoko, 0
                    IF Peli = 1 THEN _DISPLAY
                    vaihtoja = vaihtoja + 1
                END IF
            NEXT y
            IF lauta(x, 1) = 0 THEN
                y = 1: GOSUB Piirto
            END IF
        NEXT x
    NEXT toisto
END IF
RETURN

Piirto:
c = INT(RND * 7) + 1
IF c = 7 THEN c = 14
IF c = 6 THEN c = 9
IF c = 5 THEN c = 13
IF c = 3 THEN c = 11
lauta(x, y) = c
CIRCLE (140 + x * 40, 60 + y * 40), pkoko, c
PAINT (140 + x * 40, 60 + y * 40), c
CIRCLE (140 + x * 40, 60 + y * 40), pkoko, 0
IF Peli = 1 THEN _DISPLAY
RETURN

RuudunKoko:
moodi = moodi + 1
IF moodi = 3 THEN moodi = 0
SELECT CASE moodi
    CASE 0: _FULLSCREEN _OFF
    CASE 1: _FULLSCREEN _SQUAREPIXELS
    CASE 2: _FULLSCREEN _STRETCH
END SELECT
RETURN

SUB Ikkuna (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2), 0, B
    LINE (x1 + 1, y1 + 1)-(x2 - 1, y2 - 1), 15, B
    LINE (x1 + 2, y1 + 2)-(x2 - 1, y2 - 1), 8, B
    LINE (x1 + 2, y1 + 2)-(x2 - 2, y2 - 2), 7, BF
END SUB