tetris qb64

6 yıl

Yüzbaşı

Konu Sahibi

kendi yazdığım tetris oyunu ascii tabanlı,oyun sorunsuz, ve bugsizdir. hatasiz
*****Bilgisayarım temiz fakat İndirmek isteyen ve oynamak isteyen olursa her ihtimale karşı lütfen virüs taramasından geçiriniz.*****
http://dosya.co/z1ehaya0cq09/tetris_game.rar.html

tetris_game.rar - 1.9 MB

T

tween25

6 yıl

Yüzbaşı

Konu Sahibi

Kodlarımızda buarada isteyen copy paste yaparak çalıştırabilir.

CLS , 5
_FULLSCREEN _STRETCH
SCREEN 0
RANDOMIZE TIMER
OPTION BASE 1
WIDTH 80, 60
CONST mm = 42
CONST nn = 23
DIM SHARED renkdata(mm, nn)
DIM toplam(40)
DIM aa(4), bb(4)
DIM SHARED alan(mm, nn) AS INTEGER
DIM SHARED B$
DIM SHARED fig(4, 4) AS INTEGER
DIM SHARED pnr(7, 4, 4, 4) AS INTEGER
DECLARE SUB URET (LOCX,LOCY AS INTEGER)
DIM SHARED TX, TY, X, Y, LOCX, LOCY, C, px, py, bx, by, a AS INTEGER
DIM SHARED renk
DIM SHARED randomfigur, aa, bb, rf, ro2, ro4, blok, don, blk, ro AS INTEGER

FOR blok = 1 TO 7
FOR don = 1 TO 4
FOR Xblok = 1 TO 4
FOR Yblok = 1 TO 4
READ pnr(blok, don, Xblok, Yblok)
NEXT
NEXT
NEXT
NEXT
DATA 0,0,0,0
DATA 1,0,0,0
DATA 1,0,0,0
DATA 1,1,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 0,0,1,0
DATA 1,1,1,0

DATA 0,0,0,0
DATA 1,1,0,0
DATA 0,1,0,0
DATA 0,1,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,1,0
DATA 1,0,0,0

DATA 0,0,0,0
DATA 0,1,0,0
DATA 0,1,0,0
DATA 1,1,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,1,0
DATA 0,0,1,0

DATA 0,0,0,0
DATA 1,1,0,0
DATA 1,0,0,0
DATA 1,0,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,0,0,0
DATA 1,1,1,0

DATA 1,0,0,0
DATA 1,0,0,0
DATA 1,0,0,0
DATA 1,0,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,1,1

DATA 1,0,0,0
DATA 1,0,0,0
DATA 1,0,0,0
DATA 1,0,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,1,1

DATA 0,0,0,0
DATA 0,1,0,0
DATA 1,1,0,0
DATA 1,0,0,0

DATA 0,0,0,0
DATA 1,1,0,0
DATA 0,1,1,0
DATA 0,0,0,0

DATA 0,0,0,0
DATA 0,1,0,0
DATA 1,1,0,0
DATA 1,0,0,0

DATA 0,0,0,0
DATA 1,1,0,0
DATA 0,1,1,0
DATA 0,0,0,0

DATA 0,0,0,0
DATA 1,0,0,0
DATA 1,1,0,0
DATA 0,1,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 0,1,1,0
DATA 1,1,0,0

DATA 0,0,0,0
DATA 1,0,0,0
DATA 1,1,0,0
DATA 0,1,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 0,1,1,0
DATA 1,1,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,1,0
DATA 0,1,0,0

DATA 0,0,0,0
DATA 1,0,0,0
DATA 1,1,0,0
DATA 1,0,0,0

DATA 0,0,0,0
DATA 0,1,0,0
DATA 1,1,0,0
DATA 0,1,0,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 0,1,0,0
DATA 1,1,1,0

DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,0,0
DATA 1,1,0,0
DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,0,0
DATA 1,1,0,0
DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,0,0
DATA 1,1,0,0
DATA 0,0,0,0
DATA 0,0,0,0
DATA 1,1,0,0
DATA 1,1,0,0

FOR v = 1 TO 40
FOR o = 1 TO 20
alan(v, o) = 0
NEXT
NEXT

yeksen = 1
px = 1
py = 1
LOCX = 5
LOCY = 5
TX = 0
TY = 5
DY = 1
DYY = -1
ro = 1
blk = 3
DX = 1
renk = 5
tymax = 15
tymin = 3
carpma = 0
uc = 2
sag = 77
sol = 75
DY = 1
DYY = -1
dyyzero = 0
dyzero = 0
up = 72
dort = 4

FOR Xdim = 1 TO 21
alan(41, Xdim) = 1
alan(42, Xdim) = 1
NEXT
FOR t = 5 TO 40
alan(t, 19) = 1
NEXT

FOR mk = 41 TO 58
FOR yk = 1 TO 80
COLOR 0: LOCATE mk, yk: PRINT "Û"
NEXT
NEXT

LOCATE 10, 30: PRINT "Next level"
LOCATE 15, 30: PRINT "Oyuncu skor:"
GOSUB bck
eksi1 = -1

blk2 = INT(RND * 7) + 1
DO

carpma = 0

px = TX
py = TY

CALL URETSIL(blk, ro, X, Y)

am = 0: bm = 0
suma = 0: sumb = 0
pddy = DYY
pdy = DY
TX = TX + DX

B$ = INKEY$
IF B$ = CHR$(0) + CHR$(up) THEN ro = ro + 1
IF ro > 4 THEN ro = 1
_KEYCLEAR
IF B$ = CHR$(0) + CHR$(sag) AND TY < tymax + tyart THEN TY = TY + DY
_KEYCLEAR
IF B$ = CHR$(0) + CHR$(80) THEN uc = 64

IF B$ = CHR$(0) + CHR$(sol) AND TY > tymin THEN TY = TY + DYY
_KEYCLEAR

CALL URETSIL(blk, ro, X, Y)

CALL URET(blk, ro, X, Y)

IF suma = 0 THEN DYY = -1: ELSE DYY = 0
IF sumb = 0 THEN DY = 1: ELSE DY = 0
up = 72
l = 0

FOR MX = 1 TO 4
FOR MY = 1 TO 4
IF fig(MX, MY) = 1 THEN
l = l + 1
aa(l) = MX
bb(l) = MY
END IF
NEXT
NEXT

high = bb(1)
low = bb(1)

FOR Xf = 2 TO 4
IF bb(Xf) > high THEN
high = bb(Xf)

ELSEIF bb(Xf) < low THEN
low = bb(Xf)
END IF

NEXT Xf

fark = 4 - high
tyart = fark

IF TX < 40 THEN

FOR MX = 1 TO 4

FOR MY = 1 TO 4

IF fig(MX, MY) = 1 THEN
a = MX
b = MY
IF alan(TX + 1 + a, TY + b) = fig(a, b) THEN GOSUB carp: carpma = 1:
IF alan(TX + a, TY - 1 + b) = 1 THEN am = 1: suma = suma + am
IF alan(TX + a, TY + b + 1) = 1 THEN bm = 1: sumb = sumb + bm
IF alan(TX + a + 2, TY + b) THEN up = 0
IF fark = 3 THEN eksi1 = 0:
FOR par = 1 TO fark: IF alan(TX + a, TY + b + par + eksi1) OR alan(TX + a + 2, TY + b + par + eksi1) = 1 THEN up = 0: END IF: NEXT par

IF alan(TX + a + 1, TY - 1 + b) = 1 THEN DYY = 0:
IF alan(TX + a + 1, TY + 1 + b) = 1 THEN DY = 0:

NEXT
NEXT
END IF
eksi1 = -1
basla:

FOR o = 1 TO 20
IF alan(4, o) = 1 THEN GOSUB bitir
NEXT

FOR xo = 1 TO 40

FOR yo = 4 TO 18
IF alan(xo, yo) = 1 THEN rakam = 1: topla = topla + rakam: toplam(xo) = topla

NEXT yo
topla = 0
NEXT xo

COLOR 3: LOCATE 30, 25: PRINT "Oyuncu Skoru";
COLOR 3: LOCATE 32, 29: PRINT ; toplamscore;
scorekle = 0
kj = 1

xn = 40

WHILE xn >= kj

IF toplam(xn) = 15 THEN
score = 5
scorekle = 1
BEEP

FOR hg = xn TO 3 STEP -1
FOR gh = 4 TO 18
toplam(hg) = toplam(hg - 1)
alan(hg, gh) = alan(hg - 1, gh)
renkdata(hg, gh) = renkdata(hg - 1, gh)
NEXT gh
NEXT hg

FOR hg = xn TO 3 STEP -1
FOR gh = 4 TO 18
COLOR 7: LOCATE hg, gh: PRINT ".":
NEXT gh
NEXT hg

FOR hg = xn TO 3 STEP -1
FOR gh = 4 TO 18
IF alan(hg, gh) = 1 THEN COLOR renkdata(hg, gh): LOCATE hg, gh: PRINT "Û"
NEXT gh
NEXT hg

END IF

xn = xn - 1

WEND
topla = 0

FOR mk = 1 TO 3
FOR yk = 1 TO 80
COLOR 0: LOCATE mk, yk: PRINT "Û"
NEXT
NEXT
IF scorekle = 1 THEN toplamscore = toplamscore + score

_DELAY (1 / uc)

LOOP UNTIL B$ = CHR$(27)

END
SYSTEM

nextlevel:
blk = INT(RND * 7) + 1

RETURN
nextlevel2:
nl2 = 7
RETURN

bck:
FOR a = 4 TO 40
FOR b = 4 TO 18
COLOR 7: LOCATE a, b: PRINT "."
NEXT
NEXT

RETURN
carp:
carpma = 1
FOR MX = 1 TO 4
FOR MY = 1 TO 4
IF fig(MX, MY) = 1 THEN
alan(TX + MX, TY + MY) = fig(MX, MY)
renkdata(TX + MX, TY + MY) = renk
END IF
NEXT
NEXT
IF carpma = 1 OR TX = 1 THEN TX = 1: TY = 5: renk = INT(RND * 15) + 1: COLOR 15: blk2 = INT(RND * 7) + 1: blk = blk2: pal = 0: uc = 5: xc = 0: DY = 1: DYY = -1: up = 72: eksi1 = -1:
RETURN

bitir:
CLS
SCREEN 0
WIDTH 80, 60
dem$ = "Oyun bitti"
X = LEN(dem$)
xccc = (80 - X) / 2
LOCATE 15, 25: PRINT , dem$
END
SYSTEM

RETURN

SUB URET (blk, ro, X, Y)
blok = blk
don = ro
FOR Xb = 1 TO 4
FOR Yb = 1 TO 4
fig(Xb, Yb) = pnr(blok, don, Xb, Yb)
COLOR renk: IF fig(Xb, Yb) = 1 THEN LOCATE TX + Xb, TY + Yb: PRINT "Û"

NEXT

NEXT

END SUB

SUB URETSIL (blk, ro, X, Y)

blok = blk
don = ro
FOR Xb = 1 TO 4
FOR Yb = 1 TO 4

COLOR 7: IF pnr(blok, don, Xb, Yb) = 1 THEN LOCATE px + Xb, py + Yb: PRINT "."
NEXT
NEXT
END SUB

T

tween25

6 yıl

Yüzbaşı

Konu Sahibi

PRINT "Û" çıkan yerleri klavyeden alt+219'a basarak ascii karakteri seciniz. Değiştirmezseniz kutu yerine şapkalı Û çıkacaktır.