Kirjautuminen
Tehtävät
Kilpailu
4. kierros:
7.11. klo 18 – 9.11. klo 23
Tässä oma versioni tetriksestä.
Pitäisi toimia kaikilla qb-versioilla.
Päivitetty 27.7.07: korjattu palikan ujutusongelma(lisätty aliohjelma nimeltä pohja).
Päivitetty 19.4.11: pientä koodin ja ulkoasun viilausta, lisätty varjopalikka
'
' 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%
RETURNKoodia en sen kummemmin katsellut mutta QB peliksi varsin onnistunut tapaus.
Tuota innostui ihan oikeasti pelaamaan. :)
Ei voi sanoa muuta kuin että pirun hyvä.
hieno...
PS. pelissä ei näköjään pysty siirtämään kenttää koskevaa palaa edes yhtä ruutua
Aihe on jo aika vanha, joten et voi enää vastata siihen.