Крайне непопулярный язык Tcl/Tk

#Rim_Arab.tcl
source [file join [file dirname [info script]] chisla_rim_arab.tcl]
source [file join [file dirname [info script]] chisla_arab_rim.tcl]
source [file join [file dirname [info script]] Valid_Int.tcl]
source [file join [file dirname [info script]] Valid_Rim.tcl]
 
package require Tk
. config -bg gray75
set w .search
catch {destroy $w}
toplevel $w
wm title $w "Арабские << >> Римские!"
frame  $w.one
label  $w.one.label    -text "Это приложение переводит числа из арабской системы \
                             счисления в римскую и обратно!"
pack   $w.one.label    -side left
 
frame  $w.two
label  $w.two.label           -text " Арабское  число:"
entry  $w.two.entry           -textvar Arab  -fg red   -validate  all  -vcmd {Valid_Int %P}
ttk::button $w.two.button     -text "Вычислить!"  -command {$w.three.entry  insert 0 "[eval {Arab_Rim $Arab}]"}
bind   $w.two.entry     <Return>  {$w.three.entry  insert 0 "[eval {Arab_Rim $Arab}]"}
ttk::button $w.two.button1    -text "Очистить!"   -command {$w.two.entry   delete 0 end}
bind   $w.two.entry     <Delete>  {$w.two.entry  delete  0 end}
 
frame  $w.three
label  $w.three.label         -text " Римское    число:"
entry  $w.three.entry         -textvar Rim   -fg blue  -validate  all  -vcmd {Valid_Rim  %P}         
ttk::button $w.three.button   -text "Вычислить!"  -command {$w.two.entry    insert 0 "[eval {Rim_Arab $Rim }]"}
bind   $w.three.entry   <Return>  {$w.two.entry    insert 0 "[eval {Rim_Arab $Rim }]"}              
ttk::button $w.three.button1  -text "Очистить!"   -command {$w.three.entry delete 0 end}
bind   $w.three.entry   <Delete>  {$w.three.entry delete 0 end}
 
pack   $w.two.label    $w.two.entry    $w.two.button     $w.two.button1    -side left
pack   $w.three.label  $w.three.entry  $w.three.button   $w.three.button1  -side left
pack   $w.one  $w.two  $w.three    -side top

#chisla_arab_rim.tcl
proc Arab_Rim {Arab} {
source [file join [file dirname [info script]] data_arab_rim.tcl]
set E 0; set Rim ""
while {0 < $Arab} {
 while {[lindex $arab $E] <= $Arab} {
  append Rim [lindex $rim $E]
  set Arab [expr {$Arab - [lindex $arab $E]}]
      }
      incr E
   }
   return $Rim
}

# data_arab_rim.tcl
set arab {1000 900 500 400 100 90 50 40 10 9 5 4 1}
set rim  {M CM D CD C XC L XL X IX V IV I}

#Valid_Int.tcl
proc Valid_Int {Arab} {return [expr {[string is integer $Arab] && [expr {$Arab < 4000}]}]}

#chisla_rim_arab.tcl
proc Rim_Arab {Rim} {
source [file join [file dirname [info script]] data_rim_arab.tcl]
set RimCM [string map {IV IIII IX VIIII XL XXXX XC LXXXX CD CCCC CM DCCCC} $Rim]
set RimN  [split $RimCM {}]
set Qwer 0; foreach P $RimN {set Qwer [expr {$Qwer + $r_a($P)}]}
set Arab $Qwer 
}

#data_rim_arab.tcl
set r_a(I) 1;   set r_a(V) 5;   set r_a(X) 10; set r_a(L) 50
set r_a(C) 100; set r_a(D) 500; set r_a(M) 1000

#Valid_Rim.tcl
proc Valid_Rim {Rim} {return [regexp {^(M{0,3})(C[MD]|D?C{0,3})(X[CL]|L?X{0,3})(I[XV]|V?I{0,3})$} $Rim]}

#Live.tcl
label       .label     -text     "Введите размерность жизненого пространства:" 
entry       .entry     -textvar  razmer        -validate   all     -vcmd  {Valid %P}
ttk::button .button_1  -text     "Вычислить!"  -command    {source [file join [file dirname [info script]] forma.tcl]}
bind        .entry     <Return>                            {source [file join [file dirname [info script]] forma.tcl]}
ttk::button .button_2  -text     "Очистить!"   -command    {.entry delete 0 end}
bind        .entry     <Delete>  {.entry delete 0 end}
pack        .label  .entry  .button_1  .button_2    -side   left
# --------------------------------------------------------------------------------------------------
proc Valid {razmer} {
     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})$} $razmer]
}

#forma.tcl
source [file join [file dirname [info script]] tablica.tcl]
source [file join [file dirname [info script]] spisok.tcl]
 
set u [format "%d" $razmer]
set d [expr {1.0 / $u}]
set t [expr {pow($u, 2)}]
set order [Spisok $t]
 
package require Tk
set w .puzzle
catch {destroy $w}
toplevel $w  
set font 04ddd84
label $w.msg  -font  $font  -wraplength  4i  -justify  left  -text  "Жизненное пространство - $u на $u."
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
 
tablica $order

#tablica.tcl
source [file join [file dirname [info script]] pokolenie.tcl]
 
proc tablica {order } {
 global  i u d w t
 for {set i 0} {$i < $t} {incr i} {
 destroy  $w.frame.$i
 set num [lindex  $order $i]
 set xpos($i) [expr {($i%$u)*$d}]
 set ypos($i) [expr {($i/$u)*$d}]
ttk::button  $w.frame.$i   -text  $num        -command   {set order [pokolenie $order]; tablica $order}
place        $w.frame.$i   -relx  $xpos($i)   -rely   $ypos($i)   -relwidth  $d   -relheight  $d
   }
}

#pokolenie.tcl
proc pokolenie {order} {    
 global   u t
 set Q {lindex $order $f}
 set W {set Xs [expr {$Xs+1}]}
 set E {set order1 [lappend order1 "" ]}
 set R {set order1 [lappend order1 "X"]}
  for {set i 0} {$i < $t} {incr i} {           
          set Xs 0; set q [expr {($i+1)%$u}]
   if {([set f [expr {$i-$u}]]    >= 0              && [eval $Q] == "X" && [eval $W]) |
       ([set f [expr {$i-$u+1}]]  >= 0 &&  $q != 0  && [eval $Q] == "X" && [eval $W]) |  
       ([set f [expr {$i+1}]]     < $t &&  $q != 0  && [eval $Q] == "X" && [eval $W]) |
       ([set f [expr {$i+$u+1}]]  < $t &&  $q != 0  && [eval $Q] == "X" && [eval $W]) |
       ([set f [expr {$i+$u}]]    < $t              && [eval $Q] == "X" && [eval $W]) |
       ([set f [expr {$i+$u-1}]]  < $t &&  $q != 1  && [eval $Q] == "X" && [eval $W]) | 
       ([set f [expr {$i-1}]]     >= 0 &&  $q != 1  && [eval $Q] == "X" && [eval $W]) |
       ([set f [expr {$i-$u-1}]]  >= 0 &&  $q != 1  && [eval $Q] == "X" && [eval $W])} {  
    switch -- $Xs {
     1 {eval $E}
     2 {if {[lindex  $order  $i] == "X"} then {eval $R} else {eval $E}}
     3 {eval $R}
     4 {eval $E}
     5 {eval $E}
     6 {eval $E}
     7 {eval $E}
     8 {eval $E}
}     
      } else {eval $E}
   }
    return $order1
}

#spisok.tcl
proc Spisok {t} {    
 for {set i 0} {$i < $t} {incr i} {        
  set n [expr {round(rand()*1)}] 
   if {$n == 1} then {set order [lappend order "X"]} \
                 else {set order [lappend order ""]}     
   }
   return $order    
}