Реверси на TCL в 64 строки

    На хабре уже есть топики про написание игры Реверси (Отелло) на Python, Silverlight.
    Изобретем велосипед на Tcl/Tk. Кроссплатформенно (работает даже на Windows Mobile при небольшой модификации), всего в 64 строки.

    image

    Код, небольшое описание и скрин с WinMobile под хабракатом.


    Исходник (reversi.tcl):
    package require Tk 8.5
    for {set i 0} {$i<64} {incr i} {lappend icells [expr {$i/8}] [expr {$i%8}]}
    array set vs [list 1 2 2 1 cl,1 black cl,2 white pn,1 черные pn,2 белые]
    ttk::button .b1 -text "Новая игра" -command {newgame 1 2}
    ttk::button .b2 -text "Выход" -command {exit}
    ttk::label  .l1 -text "Добро пожаловать в игру Реверси"
    canvas .cv -width 479 -height 479
    grid rowconfigure . 1 -weight 1
    grid columnconfigure . 2 -weight 1
    grid .b1 .b2 .l1 -padx 4 -pady 4 -sticky e
    grid .cv -padx 4 -pady 4 -columnspan 3
    foreach {x y} $icells {
      set cr1 [list [expr {$x*60+2}] [expr {$y*60+2}] [expr {$x*60+60}] [expr {$y*60+60}]]
      set cr2 [list [expr {$x*60+4}] [expr {$y*60+4}] [expr {$x*60+58}] [expr {$y*60+58}]]
      .cv create rectangle $cr1 -fill gray -tag "cell,$x,$y"
      .cv create oval $cr2 -state hidden -tag "piece $x,$y"
      .cv bind cell,$x,$y <1> [list evuser $x $y]}
    proc pieceset {x y p}  {
      .cv itemconfigure $x,$y -state normal -fill $::vs(cl,$p)
      incr ::score($p)        [expr {+($::board($x,$y) != $p)}]
      incr ::score($::vs($p)) [expr {-($::board($x,$y) == $::vs($p))}]
      set  ::board($x,$y)     [list $p]}
    proc newgame {p1 p2} {
      .cv itemconfigure piece -state hidden
      array set ::score  [list 0 0 1 0 2 0]
      array set ::player [list 1 $p1 2 $p2]
      foreach {x y} $::icells {set ::board($x,$y) 0}
      foreach {x y s} {3 3 2 4 4 2 3 4 1 4 3 1} {pieceset $x $y $s}
      set ::cur 1; waitturn}
    proc getflips {x y p} {
      if {$::board($x,$y) != 0} return;
      set result {}
      foreach {ix iy} {0 -1 0 1 -1 0 1 0 -1 -1 1 1 1 -1 -1 1} {
        set temp {}
        for {set i [expr {$x+$ix}]; set j [expr {$y+$iy}]} \
            {[info exists ::board($i,$j)]} {incr i $ix; incr j $iy} {
            switch -- $::board($i,$j) \
              $::vs($p) {lappend temp $i $j} \
              $p        {foreach {m n} $temp {lappend result $m $n}; break} \
              0         {break}
      }}
      return $result}
    proc waitturn {} {
      .l1 configure -text "Ходят $::vs(pn,$::cur) ($::score(1):$::score(2))"
      array set v [list $::cur {} $::vs($::cur) {}]  
      foreach {x y} $::icells {
        set l [getflips $x $y $::cur]; if {[llength $l]} {lappend v($::cur) [list $x $y]}
        set l [getflips $x $y $::vs($::cur)]; if {[llength $l]} {lappend v($::vs($::cur)) [list $x $y]}}
      if {[llength $v($::cur)] == 0 && [llength $v($::vs($::cur))] == 0} {
        tk_messageBox -title "Reversi" -message "Игра окончена"; return}
      if {$::player($::cur) == 1 && [llength $v($::cur)]} {
        set ::waituser 1; return}
      if {$::player($::cur) == 2 && [llength $v($::cur)]} {
        set ::waituser 0
        set ::flip [lindex $v($::cur) [expr {int([llength $v($::cur)]*rand())}]]
        turn [lindex $::flip 0] [lindex $::flip 1] $::cur}
      set ::cur $::vs($::cur); after idle waitturn}
    proc evuser {x y} {
      if {[info exists ::waituser] && $::waituser && [turn $x $y $::cur]} {
        set ::cur $::vs($::cur); after idle waitturn}}
    proc turn {x y p} {
      set flips [getflips $x $y $p]
      foreach {i j} $flips  {pieceset $i $j $p}
      if {[llength $flips]} {pieceset $x $y $p; return 1} else {return 0}}
    


    Чтобы удобней было работать с координатами, создадим список icells (0 0 0 1… 1 1 1 2..).
    В дальнейшем вместо вложенного цикла можем пользоваться foreach {x y} $icells.

    Далее идет создание интерфейса, работа с канвой и привязка события (evuser) при нажатии на клетку.

    Глобальные переменные:
    vs — хеш массив, определяет ID противников, цвета фишек. vs(1) = 2; vs(2) = 1.
    score — счет (количество черных и белых фишек)
    player — конфигурация игроков (1 — человек, 2 — компьютер)
    board — игровое поле
    cur — идентификатор текущего игрока
    waituser — флаг ожидания хода пользователя

    Рассмотрим объявленные функции.
    newgame {p1 p2}
    Начало новой игры. Аргументы определяют тип игрока:
    1 — Человек
    2 — Компьютер

    В прочем, AI здесь совершенно нет, но можно посмотреть как будут играть Random vs Random передав {2 2}

    pieceset {x y p}
    Устанавливает фишку игрока p, в клетку x,y
    Пересчитывает текущий счет. Здесь небольшая магия
    incr ::score($p)        [expr {+($::board($x,$y) != $p)}]
    incr ::score($::vs($p)) [expr {-($::board($x,$y) == $::vs($p))}].
    


    Мы увеличиваем счет текущего игрока p, и его оппонента $vs($p)
    Для текущего игрока, если его фишка еще не стояла в клетке, то +1 иначе +0
    Если стоила фишка противника, то ему уменьшаем счет на -1.

    getflips {x y p}
    Возвращает список всех возможных фишек, который игрок (p) может захватить сходив в x y

    waitturn {}
    Ожидание хода.
    Определяет количество всех возможных ходов для каждого игрока. Решает, когда игра окончена и кто сейчас должен сделать ход.

    evuser {x y}
    Процедура вызываемая каждый раз, когда человек нажимает на одну из клеток.
    Если установлена глобальная переменная ::waituser и есть возможность сходить текущему пользователю, то передаем управление оппоненту:
    set ::cur $::vs($::cur); after idle waitturn}}

    turn {x y p}
    Сделать ход в x y. Перевернуть захваченные фишки противника, если получилось — возвращает 1, иначе 0.

    Ссылки:
    Реверси на Википедии
    ActiveTcl (дистрибутив Tcl для Windows/OSX/Linux)
    eTcl (Windows Mobile)


    Ну и напоследок, скрин с Windows Mobile
    image

    UPD:
    Скриншот с Ubuntu. Правда, чтобы привести к нормальному виду, подключил модуль tile-gtk

    Google Code
    Старкит и сборка под Windows (1.2 мб)
    Поделиться публикацией

    Комментарии 20

      –5
      как я ненавижу виндовс мобайл...( и сильверлайт вместе с ним…
        +16
        и особено я ненвижу реверси!
          0
          Как я ненавижу такие глупые каменты...( и безосновательность принесенная ими…
            –4
            «и безосновательность принесенная ими»
            хотелось сказать умно, а получилось как обычно?
              0
              нет, я хотел сказать именно то что написал, обычно с такими заявлениями пытаются хоть аргументировать свои слова, а не просто ляпнть что-то троллеобразное или холливарное
          –1
          сам пришла смс!
            –1
            Так вот, что вы по пятницам после работы делаете :P
              +17
              <@insomnia> Нужно выполнить всего три команды, чтобы поставить Gentoo
              <@insomnia> cfdisk /dev/hda && mkfs.xfs /dev/hda1 && mount /dev/hda1 /mnt/gentoo/ && chroot /mnt/gentoo/ && env-update &&. /etc/profile && emerge sync && cd /usr/portage && scripts/bootsrap.sh && emerge system && emerge vim && vi /etc/fstab && emerge gentoo-dev-sources && cd /usr/src/linux && make menuconfig && make install modules_install && emerge gnome mozilla-firefox openoffice && emerge grub && cp /boot/grub/grub.conf.sample /boot/grub/grub.conf && vi /boot/grub/grub.conf && grub && init 6
              <@insomnia> это первая

              --bash.org.ru, quote#394695
                +2
                Кстати, не установиться, забыли все систмные сервисы.
                Надо так:
                env-update && source /etc/profile && emerge --oneshot --nodeps gcc-config && USE="-* build bootstrap" emerge linux-headers && cd /usr/portage && scripts/bootstrap.sh && emerge libperl && emerge libperl && emerge --newuse -uD system && emerge syslog-ng xinetd grub hotplug coldplug vixie-cron reiserfsprogs reiser4progs sysfsutils udev dhcpcd && emerge --nodeps acpid ntp && rc-update add syslog-ng default && rc-update add net.eth0 default && rc-update add vixie-cron default && rc-update add xinetd default && rc-update add sshd default && rc-update add hotplug default && rc-update add coldplug default && rc-update add acpid default
                +2
                может лучше писать комментарии, а то так приходится листать вверх-вниз, чтобы понять о чем вы там пишете в пояснениях
                  +1
                  tcl жив, ура! :)
                    0
                    Ах вот ты какой Tcl/Tk на самом деле :)
                    Использую Tkinter в питоне, потому что быстро, кроссплатформенно и мало места занимаем в программах, собранных py2exe.
                      +2
                      Спасибо за статью, полезна будет (особенно ввиду малого количества материала по Tcl/Tk). Интересно было бы что-то подобное увидеть на Smalltalk или Clean.
                        +1
                        Приятно видеть Tcl на хабре. Жаль на русском языке приемы работы с ним практически не освещены. Однако поклонников вполне хватает.
                          0
                          Чойта не запускается

                          $ wish reversi.tcl
                          Error in startup script: invalid command name «ttk::button»
                          while executing
                          «ttk::button .b1 -text „Новая игра“ -command {newgame 1 2}»
                          (file «reversi.tcl» line 4)
                            0
                            ttk::button заменить просто на button
                              0
                              button .b1 -text «Новая игра» -command {newgame 1 2}
                              button .b2 -text «Выход» -command {exit}
                              label .l1 -text «Добро пожаловать в игру Реверси»
                                0
                                ага, спасибо
                              0
                              нужен Tcl 8.5
                                0
                                Здорово, что кто-то еще увлечен Tcl'ом. У меня остались довольно приятные ощущения после 2-летнего программирования на нем.

                                Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

                                Самое читаемое