| manikdepresif | 06 Ekim 2023 02:57 |
mirc tetris
merhaba,
window picture penceresinde tetris oyunu
kod uzun oldugundan dolayi kod uzerinde pek hakimyet saglayamamisim,
yazdigim kodu tekrar editleyemiyorum kusura bakmayin bir eksigi vardi siradak sekli verrnesi gerekiyordu.
--
kod yazari : jeun
emegi gecenler: HsN ;;->> Oyun ici kontrol
;Yon kontrol tuslari <- | -> sag sol hareket,
;Ust yon kontrol tusu ile sekil degistirme,
;Alt yon kontrol tusuna basik tutunca hizlanma,
;Bosluk(space) tusu ile basip durdurup devam ettirme,
;menu'den klasik veya renkli secim tercihi,
;Xp ve Win 7 isletim sisteminde denenmistir.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;KALANLAR
;uste yana bir sonraki sekil Kod:
menu channel,nicklist,status,query {
Tetris
.Klasik:menu_tet klasik
.Renkli:menu_tet renkli
}
on *:close:@[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]:{ .timertet* off | unset %_tet* }
alias -l menu_tet {
set %tetris_renk $1 | unset %timer_no_tetris | window -c $t_p | tetris
}
alias -l t_p return @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]
alias -l tetris {
unset %_all_coor %_1_x %_2_y %_3_x %_4_y %_5_x %_6_y %_7_x %_8_y %_tet* %_x_cor %_y_cor
if !$window($t_p) { window -aiHl20p $t_p }
else { window -a $t_p }
pencere_ayar_kare | karelere_bol | ilk_start
.timertetris -h 0 300 asagiya_oynat
}
alias -l ilk_start {
var %n = $sekil_sec
var %z = $len(%n), %t = 1, %b, %f
while (%t <= %z) {
var %b %b $+ $mid(%n,%t,1)
if (4 // $len(%b)) {
inc %f
var %m = 1
while %m <= $pos(%b,1,0) {
var %_x_cor $calc(((1 + $pos(%b,1,%m))) * %w_miktr_w)
var %_y_cor $calc($calc(%f - 1) * %h_miktr_w)
set %_all_coor %_all_coor %_x_cor %_y_cor
inc %m
}
var %b
}
inc %t
}
}
alias -l karelere_bol {
;ekrani karelere boler ve uygun olan width ve height degerlerini bulur.
var %y = 1, %j = 20
while (%j) {
var %c = 10, %x = 1
while (%c) {
;drawrect $t_p 1 1 %x %y %w_miktr_w %h_miktr_w
aline -l $t_p %x %y
inc %x %w_miktr_w
dec %c
}
aline -l $t_p %x %y
inc %y %h_miktr_w
set %_tetr_y_coor %_tetr_y_coor %y
dec %j
}
}
alias sekil_sec {
;her seferinde random olarak sekil secer
var %j = $r(1,7), %k = 1
;Tetris sekil renkleri
var %r_1 = 255,0,0 , %r_2 = 255,128,0 , %r_3 = 255,0,255 , %r_4 = 0,0,170
var %r_5 = 255,255,23 , %r_6 = 99,236,60 , %r_7 = 0,255,255
while ($isalias($+(sekil-,%j,-,%k))) inc %k
var %l = $r(1,$calc(%k - 1))
set %_renk_tet $eval($+(%,r,_,%j),2)
if (%tetris_renk == klasik) { set %_renk_tet 0,0,0 }
set %_tet_sekil $+(sekil-,%j,-,%l)
return $eval($+($,sekil-,%j,-,%l),2)
}
alias -l sekil_cevir_ {
set %_tet_old_all_coor %_all_coor
var %kk = $pos($left($eval($+($,%_tet_sekil),2),4),1,1)
var %hj = $gettok(%_tet_sekil,1-2,45) $+ - $+ $calc($gettok(%_tet_sekil,3,45) + 1)
if $isalias(%hj) { set %_tet_sekil %hj }
else { set %_tet_sekil $gettok(%_tet_sekil,1-2,45) $+ - $+ 1 }
var %n = $eval($+($,%_tet_sekil),2), %z = $len(%n), %t = 1, %b, %f
tokenize 32 %_all_coor
unset %_all_coor
var %x_1 = $calc($1 - $calc(%kk * %w_miktr_w)) , %y_1 = $2
while (%t <= %z) {
var %b %b $+ $mid(%n,%t,1)
if (4 // $len(%b)) {
inc %f
var %m = 1
while %m <= $pos(%b,1,0) {
var %_x_cor = $calc(%x_1 + (($pos(%b,1,%m)) * %w_miktr_w))
var %_y_cor = $calc(%y_1 + ($calc(%f - 1) * %h_miktr_w))
var %_xy_cor = $calc(%_x_cor +1) $calc(%_y_cor + 1)
;aline'de lbx'da yoksa, eski kordinatlara doner.
if !$fline($t_p,%_xy_cor,1,1) { set %_all_coor %_tet_old_all_coor | break | return }
set %_all_coor %_all_coor %_x_cor %_y_cor
inc %m
}
var %b
}
inc %t
}
}
alias -l showindisplay_save_coor {
;olusan kordinatlardaki kareleri her time da ekrana yukler
tokenize 45 $1
var %rgbn_ = $remove($1,@)
drawrect -fr $t_p $rgb( [ % $+ rgbn_ ] ) 1 $2 %w_miktr_w %h_miktr_w
}
alias -l pencere_ayar_kare {
set %w_miktr_w $ceil($calc(($window($t_p).bw / 20))) | set %h_miktr_w $ceil($calc(($window($t_p).bh / 20)))
}
alias -l asagiya_oynat {
;;;;;;;;;;;;;;;;;;;;;;;
inc %timer_no_tetris
;;;;;;;;;;;;;;;;;;;;;;;;;;;
clear $t_p
;puan skor ????????
if (%_2_y == 0 || %_4_y == 0 || %_6_y == 0 || %_8_y == 0) {
$iif($input(Oyun Bitti $crlf $+ Puaniniz: $iif(%_tetris_puan,$v1,0),ok,Tetris Bilgi),window -c $t_p)
.timertet* off
goto bitir
}
drawtext $t_p 1 verdana $CALC(%h_miktr_w *2) $calc((%w_miktr_w * 11) +5) $calc(($window($t_p).dh / 2) + $CALC(%h_miktr_w * 4)) Skor: $iif(%_tetris_puan,$v1,0)
if $fline($t_p,@*,1,1) { filter -lk $t_p showindisplay_save_coor @* }
;orta ayrac
drawline $t_p 1 3 $calc((%w_miktr_w * 11) +5) 1 $calc((%w_miktr_w * 11) +5) $window($t_p).dh
;yan ayrac
drawline $t_p 1 3 $calc((%w_miktr_w * 11) +5) $calc($window($t_p).dh / 2) $window($t_p).bw $calc($window($t_p).bh / 2)
tokenize 32 %_all_coor
set %_1_x $1 | set %_2_y $2 | set %_3_x $3 | set %_4_y $4
set %_5_x $5 | set %_6_y $6 | set %_7_x $7 | set %_8_y $8
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
if (%timer_no_tetris == 1) {
tetris_siradaki
}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
if (%_tet_kont == sol) {
dec %_1_x %w_miktr_w | dec %_3_x %w_miktr_w | dec %_5_x %w_miktr_w | dec %_7_x %w_miktr_w
dec %_2_y %h_miktr_w | dec %_4_y %h_miktr_w | dec %_6_y %h_miktr_w | dec %_8_y %h_miktr_w
}
if (%_tet_kont == sag) {
inc %_1_x %w_miktr_w | inc %_3_x %w_miktr_w | inc %_5_x %w_miktr_w | inc %_7_x %w_miktr_w
dec %_2_y %h_miktr_w | dec %_4_y %h_miktr_w | dec %_6_y %h_miktr_w | dec %_8_y %h_miktr_w
}
;sag sol kordinat degisikligi
var %a = $calc(%_1_x +1) $calc(%_2_y +1)
var %b = $calc(%_3_x +1) $calc(%_4_y +1)
var %c = $calc(%_5_x +1) $calc(%_6_y +1)
var %d = $calc(%_7_x +1) $calc(%_8_y +1)
; asagiya koordinat degisiklig
if !$fline($t_p,%a,1,1) || !$fline($t_p,%b,1,1) || !$fline($t_p,%c,1,1) || !$fline($t_p,%d,1,1) {
;[HsN] oyunu sonlandirma tavsiyesi uzerine eklendi.
;sag ve sol tuslarinda tum karelerin hareket edebilmesi lazim, eger kod buraya sarkarsa,
;bir sonraki asama da asagiya kontrolu yapilacak.
;asagiya da hareket ediyorsa sorun yok kendi haline birak,
;harekt etmiyorsa, o zaman, lbx'a kayitla %renk ile
set %_1_x $1 | set %_2_y $2 | set %_3_x $3 | set %_4_y $4
set %_5_x $5 | set %_6_y $6 | set %_7_x $7 | set %_8_y $8
}
; Y kordinatlarda ilerleme var mi kontrol
var %e = $calc(%_1_x +1) $calc(%_2_y + %h_miktr_w +1)
var %f = $calc(%_3_x +1) $calc(%_4_y + %h_miktr_w +1)
var %g = $calc(%_5_x +1) $calc(%_6_y + %h_miktr_w +1)
var %h = $calc(%_7_x +1) $calc(%_8_y + %h_miktr_w +1)
if !$fline($t_p,%e,1,1) || !$fline($t_p,%f,1,1) || !$fline($t_p,%g,1,1) || !$fline($t_p,%h,1,1) {
var %j = $calc($1 +1) $calc($2 +1)
var %k = $calc($3 +1) $calc($4 +1)
var %l = $calc($5 +1) $calc($6 +1)
var %m = $calc($7 +1) $calc($8 +1)
; Burada Line bulup renk degerlendirme yapiyr.
if $fline($t_p,%j,1,1) { rline -l $($t_p) $v1 @ $+ %_renk_tet $+ - $+ %j }
if $fline($t_p,%k,1,1) { rline -l $($t_p) $v1 @ $+ %_renk_tet $+ - $+ %k }
if $fline($t_p,%l,1,1) { rline -l $($t_p) $v1 @ $+ %_renk_tet $+ - $+ %l }
if $fline($t_p,%m,1,1) { rline -l $($t_p) $v1 @ $+ %_renk_tet $+ - $+ %m }
;;;;;;;;;;;;;;;;;;;;;
unset %timer_no_tetris
;;;;;;;;;;;;;;;;;;;;;;
unset %_all_coor | ilk_start | goto fin
}
drawrect -fr $t_p $rgb( [ % $+ _renk_tet ] ) 1 %_1_x %_2_y %w_miktr_w %h_miktr_w
drawrect -fr $t_p $rgb( [ % $+ _renk_tet ] ) 1 %_3_x %_4_y %w_miktr_w %h_miktr_w
drawrect -fr $t_p $rgb( [ % $+ _renk_tet ] ) 1 %_5_x %_6_y %w_miktr_w %h_miktr_w
drawrect -fr $t_p $rgb( [ % $+ _renk_tet ] ) 1 %_7_x %_8_y %w_miktr_w %h_miktr_w
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
drawrect -fr $t_p %_tetris_siradaki_1
drawrect -fr $t_p %_tetris_siradaki_2
drawrect -fr $t_p %_tetris_siradaki_3
drawrect -fr $t_p %_tetris_siradaki_4
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;normal olarak asagiya iniste Y koordinatlar degisiyor.
inc %_2_y %h_miktr_w | inc %_4_y %h_miktr_w | inc %_6_y %h_miktr_w | inc %_8_y %h_miktr_w
set %_all_coor %_1_x %_2_y %_3_x %_4_y %_5_x %_6_y %_7_x %_8_y
:fin
line_tamam_full_mu
unset %_tet_kont
:bitir
}
alias line_tamam_full_mu {
var %m = 1, %_tetrs_silme_kac_kez = 0
while $gettok(%_tetr_y_coor,%m,32) {
;y kordinat 11 oldugu zaman hepsini lbx'dan Sil
;ipucu : lbx degistigi icin degisken kullanilmadi while dongusunde
var %y-coor = $v1
; 11 ?
if $fline($t_p,$+(@,*,%y-coor),0,1) == 11 {
while $fline($t_p,$+(@,*,%y-coor),1,1) {
aline -l $t_p $gettok($fline($t_p,$+(@,*,%y-coor),1,1).text,2,45)
dline -l $t_p $fline($t_p,$+(@,*,%y-coor),1,1)
}
set %_tetris_line_silme OK
set %_tetris_son_y_coor %y-coor
inc %_tetrs_silme_kac_kez
}
inc %m
}
;silme islemi varsa line'da diger linelari duzelt
if (%_tetris_line_silme) {
beep %_tetrs_silme_kac_kez
if (%_tetrs_silme_kac_kez == 1) { inc %_tetris_puan }
else { inc %_tetris_puan $calc(%_tetrs_silme_kac_kez * 2) }
set %_tetris_sabit_silme %_tetrs_silme_kac_kez
:dgsk
var %line_ = $calc(%_tetris_son_y_coor - (%_tetrs_silme_kac_kez * %h_miktr_w))
if !$fline($t_p,$+(@,*,%line_),1,1) { goto end }
while $fline($t_p,$+(@,*,%line_),1,1).text {
var %tet_fline_text = $v1, %d = $gettok(%tet_fline_text,-2-0,32), %c = $gettok(%d,2,45)
rline -l $t_p $fline($t_p,$+(@,*,%line_),1,1) %d $calc(%line_ + $calc(%_tetris_sabit_silme * %h_miktr_w))
aline -l $t_p %c %line_
if $fline($t_p,%c $calc(%line_ + (%_tetris_sabit_silme * %h_miktr_w)),1,1) { dline -l $t_p $v1 }
}
inc %_tetrs_silme_kac_kez
goto dgsk
}
:end
unset %_tetris_line_silme %_tetris_son_y_coor %_tetris_sabit_silme
}
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
alias -l tetris_siradaki {
set %_tetris_siradaki_1 $rgb( [ % $+ _renk_tet ] ) 1 $calc(%_1_x + $calc((%w_miktr_w * 11) +5)) $calc(%_2_y + %h_miktr_w) %w_miktr_w %h_miktr_w
set %_tetris_siradaki_2 $rgb( [ % $+ _renk_tet ] ) 1 $calc(%_3_x + $calc((%w_miktr_w * 11) +5)) $calc(%_4_y + %h_miktr_w) %w_miktr_w %h_miktr_w
set %_tetris_siradaki_3 $rgb( [ % $+ _renk_tet ] ) 1 $calc(%_5_x + $calc((%w_miktr_w * 11) +5)) $calc(%_6_y + %h_miktr_w) %w_miktr_w %h_miktr_w
set %_tetris_siradaki_4 $rgb( [ % $+ _renk_tet ] ) 1 $calc(%_7_x + $calc((%w_miktr_w * 11) +5)) $calc(%_8_y + %h_miktr_w) %w_miktr_w %h_miktr_w
}
;;;;;;;;;;;;;;
;Sekiller sabit en az 4 tane 1 olmali.
;Renk kirmizi
alias sekil-1-1 return 0110011000000000
;Renk turuncu
;set %_renk 255,128,0
alias sekil-2-1 return 1111000000000000
alias sekil-2-2 return 1000100010001000
;Renk pembe
;L1
alias sekil-3-1 return 1110100000000000
alias sekil-3-2 return 0011000100010000
alias sekil-3-3 return 0001011100000000
alias sekil-3-4 return 1000100011000000
;Renk lacivert
;L2
alias sekil-4-1 return 0111000100000000
alias sekil-4-2 return 0001000100110000
alias sekil-4-3 return 1000111000000000
alias sekil-4-4 return 1100100010000000
;Renk sari
alias sekil-5-1 return 0010011100000000
alias sekil-5-2 return 0111001000000000
alias sekil-5-3 return 1000110010000000
alias sekil-5-4 return 0001001100010000
;Renk yesil
;Z1
alias sekil-6-1 return 0011011000000000
alias sekil-6-2 return 0010001100010000
;Renk mavi
;Z2
alias sekil-7-1 return 0110001100000000
alias sekil-7-2 return 0001001100100000
on *:keydown:@[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]:*:{
if ($keyval == 38 && !$timer(tetris).pause) { sekil_cevir_ }
if ($keyval == 37 && !$timer(tetris).pause) { set %_tet_kont sol }
if ($keyval == 39 && !$timer(tetris).pause) { set %_tet_kont sag }
if ($keyval == 32) { .timertetris $$iif($timer(tetris).pause,-r,-p) }
;tus tekrari varsa, bekleyen timer -e anahtari ile hemen aktif hale getirip hizlanma saglandi.
if ($keyval == 40) {
if ($keyrpt) { .timertetris -e }
}
}
[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...] [Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...] |
