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
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
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
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
PRINT "Û" çıkan yerleri klavyeden alt+219'a basarak ascii karakteri seciniz. Değiştirmezseniz kutu yerine şapkalı Û çıkacaktır.
yeni mesaja git
Yeni mesajları sizin için sürekli kontrol ediyoruz, bir mesaj yazılırsa otomatik yükleyeceğiz.Bir Daha Gösterme