Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Офтопик > Зацените!
Перезагрузить страницу Игрушка "puzzle" - Tcl'Tk
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
ayax ayax вне форума
Member
 
Сообщений: 62
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 18.08.2016
По умолчанию Игрушка "puzzle" - Tcl'Tk - 04.09.2017, 02:53

Код:
#dot.tcl
label       .label    -text "Введите размерность пазла:" 
entry       .entry    -textvar a -validate all -vcmd {Valid %P}
ttk::button .button1  -text "Вычислить!" -command {source [file join [file dirname [info script]] puzzle.tcl]}
bind        .entry <Return>  {source [file join [file dirname [info script]] puzzle.tcl]}
ttk::button .button2  -text "Очистить!" -command  {.entry delete 0 end}
bind        .entry <Delete> {.entry delete 0 end}
pack        .label .entry .button1 .button2 -side left

proc Valid {a} {
     return [regexp {^(3{0,1}|4{0,1}|5{0,1}|6{0,1}|7{0,1}|8{0,1}|9{0,1}|10{0,1})$} $a]
}  
proc Spisok {t} {
  for {set k 1} {$k <= $t} {incr k} {
      set j [expr {round(rand()*$t)}]
    if {$j == 0} {
      lappend order [expr {$j + 1}]
}   else {
      lappend order $j
	    }     
    }
	  return $order
}
proc Bez_X {order} {
      set len [expr [llength $order] - 1]
      set len1 [expr $len + 1]
  for {set i 0} {$i <= $len} {incr i} {
    for {set j [expr {$i + 1}]} {$j <= $len1} {incr j} {
	  set qi [lindex $order $i]
	  set qj [lindex $order $j]
	if {$qi == $qj} {
	  set order [lreplace $order $j $j] 
		     }
	    }
	  set len1 [llength $order]
	}   
	return $order
} 
proc Qwer {t} {
       set order_1 [Bez_X [Spisok $t]]
  for {set x $t} {1 <= $x} {incr x -1} { 
       set order_1 [Bez_X [lappend order_1 $x]]
        }  
  	   set order_2 [Bez_X [Spisok $t]]
    foreach valume $order_1 {
       set order_2 [Bez_X [lappend order_2 $valume]]
    }
	  return $order_2
}

# puzzle.tcl
package require Tk

if {$a == 1} {tk_messageBox  -title "Предупреждение!"  -message "Неправильное значение a = 1"}
set u [format "%d" $a]
set d [expr {1.0 / $u}]
set t [expr {round(pow($u, 2)) - 1}]
set order [Qwer $t]

set w .puzzle
catch {destroy $w}
toplevel $w
    
set font #4ddd84
label $w.msg  -font $font  -wraplength 4i  -justify left  -text "Пазлы - $t штук."
pack $w.msg -side top

wm title $w "Игра \"Пазлы\""
wm iconname $w "$t - Пазлы"

scrollbar $w.s

if {[tk windowingsystem] eq "aqua"} {
    set frameSize 360
} else {
    set frameSize 240
 }
frame $w.frame  -width $frameSize -height $frameSize -borderwidth 2\
	            -relief sunken -bg [$w.s cget -troughcolor]
pack  $w.frame  -side top -pady 1c -padx 1c
destroy $w.s
# ----------------------------------------------------------------------
set E [expr {0.1/$u}]
set R [expr {2.5/$u}]

proc puzzleSwitch {w num} {
    global xpos ypos E R
    if   {(($ypos($num) >= ($ypos(space) - $E))
	    && ($ypos($num) <= ($ypos(space) + $E))
	    && ($xpos($num) >= ($xpos(space) - $R))
	    && ($xpos($num) <= ($xpos(space) + $R)))
	   || (($xpos($num) >= ($xpos(space) - $E))
	    && ($xpos($num) <= ($xpos(space) + $E))
	    && ($ypos($num) >= ($ypos(space) - $R))
	    && ($ypos($num) <= ($ypos(space) + $R)))} {
	set tmp $xpos(space)
	set xpos(space) $xpos($num)
	set xpos($num) $tmp
	set tmp $ypos(space)
	set ypos(space) $ypos($num)
	set ypos($num) $tmp
place       $w.frame.$num    -relx $xpos($num)    -rely $ypos($num)
    }  }    	
for {set i 0} {$i < $t} {incr i} {
     set num [lindex  $order $i]
     set xpos($num)  [expr {$i%$u*$d}]
     set ypos($num)  [expr {$i/$u*$d}]
ttk::button $w.frame.$num     -text $num   -command "puzzleSwitch $w $num"
place       $w.frame.$num     -relx $xpos($num)   -rely $ypos($num) \
	                   -relwidth $d        -relheight $d
}
set Q [expr {1.0 - 1.0/$u}]
set xpos(space) $Q
set ypos(space) $Q

Последний раз редактировалось Alexiski; 04.09.2017 в 20:46
Ответить с цитированием
Ads
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Появилось окно с ошибкой: "Insert the "Tray App" disk and click OK". Anita_2 Техническая поддержка 6 14.12.2014 14:20
Пропали стрелочки "вверх" и "вниз" справа в браузере Мборзик Любые вопросы от новичков 0 20.04.2014 20:19
Ставлю систему "с нуля" после сбоя. Какие "работы" по тестированию железа полезны? russcand Любые вопросы от новичков 14 01.09.2011 00:27
В проводнике пропала строка с функциями "Вперед"/"Назад" viv Техническая поддержка 18 12.12.2010 21:35
Инструкция по адресу "0x436b10f" обратилась к памяти "0x03793dac". ВИРУС???? skazka Windows XP 5 21.03.2010 01:21
помогите выбрать "ASRock P4i45PE" или "GigaByte GA-8PE800" Константин Материнские платы 2 06.12.2009 15:21
Как исправить "attempt to store duplicate value in unique index "RDB$INDEX_5" ?" devo4ka-nimfetka Другие СУБД 1 16.04.2009 09:58
После подключения кнопок "power" и "reset" компьютер перестал включаться. Лаборант-Шурупов Любые вопросы от новичков 1 25.01.2009 15:15
Ошибка POST "FF" в материнской плате "Epox EP-5ELA3I". sushv Любые вопросы от новичков 2 28.08.2007 12:25
Добавить кнопки "свернуть" и "восстановить" к окну готового dialog-based приложения Lesat Visual C++ 2 07.01.2006 04:34
Как сделать чтобы вместо кнопок "Да" и "Нет" высвечивалось украинсие "Так" и "Ні" Форсаж Delphi 5 19.07.2003 19:30
Как в TFilterValidatorе задать такой фильтр: все символы кроме "{" и "}" Anonymous Pascal 1 28.06.2003 00:50



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов