TCL/TK脚本 扫雷(源码一)

    大四实习时自学了几天TCL/TK脚本，当时为了面试华为，可惜没工作经验被BS了一把 ^_^ 。感觉TK画窗体比较方便，还能跨平台跑，当时来兴趣就写了这个小程序，TCL的语法和很多shell脚本一样简单，不过功能可不容小视哦，可以写测试脚本，还可写窗体程序，嘿嘿~~  以下是源码一:

源码二:http://blog.chinaunix.net/u1/46016/showart_2007305.html

#------------------------------------------------------------------------
#
# @Des:       TCL/TK扫雷程序
# @Author:    UCfree
# @Date:      2009-04-22
# @funtion:   点击鼠标右键标记；左键挖雷；中键(而不是左右键齐按)展开
#
#-------------------------------------------------------------------------


#-------------------------------------------------------------
# 程序初始化
#-------------------------------------------------------------
proc init {} {
        global row col MineBody mines flags FmHead;
        set row 16;
        set col 30;
        set mines 100;
        set flags 0;

        if {$MineBody(StartFlag) == 0} {
                set MineBody(StartFlag) 1;
        } else {
                DestroyBody;
        }

        Setting;
        InitMineData;
        DrawBody;
        Events;
}


#-------------------------------------------------------------
# 销毁窗体部件
#-------------------------------------------------------------
proc DestroyBody {} {
        global row col MineBody;
        
        for {set i 1} {$i <= $row} {incr i} {
                for {set j 1} {$j <= $col} {incr j} {
                        destroy $MineBody($i,$j,NameOfBtn);
                }
        }
        
        unset MineBody;
        global MineBody;
        set MineBody(StartFlag) 1;
}


#-------------------------------------------------------------
# 设置，(Todo: 在此添加菜单等功能)
#-------------------------------------------------------------
proc Setting {} {
        global row col mines MineBody FmHead flags;

        $FmHead.msg config -text " ";
        $FmHead.minecnt config -text "剩余:[expr $mines - $flags]";
}


#-------------------------------------------------------------
# 数据初始化
#-------------------------------------------------------------
proc InitMineData {} {
        global row col mines MineBody;
        global flags;
        set flags 0;

        randomInit [clock seconds];
        
        set TopBorder 0;
        set BottomBorder [expr $row + 1];
        set LeftBorder 0;
        set RightBorder [expr $col + 1];
        for {set i $TopBorder} {$i <= $BottomBorder} {incr i} {
                for {set j $LeftBorder} {$j <= $RightBorder} {incr j} {
                        if {$i == $TopBorder || $j == $LeftBorder || \
                                $i == $BottomBorder || $j == $RightBorder} {
                                set MineBody($i,$j,val) -1;
                        } else {
                                set MineBody($i,$j,val) 0;
                                set MineBody($i,$j,status) "UNDO";
                        }
                }
        }
        
        FillMines $row $col $mines;
        FillAroundMines $row $col;
}


#-------------------------------------------------------------
# 随机产生雷并填充
#-------------------------------------------------------------
proc FillMines {x y mines} {
        global MineBody;
        set randx {};
        set randy {};

        for {set counter 0} {$counter < $mines} {incr counter} {
                set randx [expr [RandomRange $x] + 1];
                set randy [expr [RandomRange $y] + 1];
               
                if {$MineBody($randx,$randy,val) == "*"} {
                        incr counter -1
                        continue;
                }
               
                set MineBody($randx,$randy,val) "*";
        }
}

#-------------------------------------------------------------
# 填充雷周围格子的数据
#-------------------------------------------------------------
proc FillAroundMines {x y} {
        global MineBody;

        for {set i 1} {$i <= $x} {incr i} {
                for {set j 1} {$j <= $y} {incr j} {
                        if {$MineBody($i,$j,val) == "*"} {
                                continue;
                        }

                        set AroundMines 0;
                        for {set m [expr $i - 1]} {$m <= [expr $i + 1]} {incr m} {
                                for {set n [expr $j - 1]} {$n <= [expr $j + 1]} {incr n} {
                                        if {$MineBody($m,$n,val) == "*"} {
                                                incr AroundMines;
                                        }
                                }
                        }
                        set MineBody($i,$j,val) $AroundMines;
                }
        }
}

#-------------------------------------------------------------
# 随机函数的实现
#-------------------------------------------------------------
proc randomInit {seed} {
        global rand;
        set rand(ia) 9301;
        set rand(ic) 49297;
        set rand(im) 233280;
        set rand(seed) $seed;
}

proc random {} {
        global rand;
        set rand(seed) \
                [expr ($rand(seed)*$rand(ia) + $rand(ic)) % $rand(im)];
        
        return [expr $rand(seed)/double($rand(im))];
}

proc RandomRange {range} {
        expr int([random]*$range);
}


#-------------------------------------------------------------
# 绘制扫雷窗体
#-------------------------------------------------------------
proc DrawBody {} {
        global MineBody FmBody row col;
        
        for {set i 1} {$i <= $row} {incr i} {
                set RowBtnName {};

                for {set j 1} {$j <= $col} {incr j} {
                        set MineBody($i,$j,NameOfBtn) \
                                [button $FmBody.btn$i-$j -width 2 -height 1];
                        append RowBtnName "$MineBody($i,$j,NameOfBtn) ";
                }
               
                set GridBuf {};
                append GridBuf "grid ";
                append GridBuf $RowBtnName;
                eval $GridBuf;
        }
}


#-------------------------------------------------------------
# 响应鼠标点击事件
#-------------------------------------------------------------
proc Events {} {
        global MineBody row col;

        for {set i 1} {$i <= $row} {incr i} {
                for {set j 1} {$j <= $col} {incr j} {
                        bind $MineBody($i,$j,NameOfBtn) <Button-1> "ClickLeftBtn $i $j";
                        bind $MineBody($i,$j,NameOfBtn) <Button-2> "ClickMidBtn $i $j";
                        bind $MineBody($i,$j,NameOfBtn) <Button-3> "ClickRightBtn $i $j";
                }
        }
}

#-------------------------------------------------------------
# 响应鼠标左键
#-------------------------------------------------------------
proc ClickLeftBtn {x y} {
        global MineBody row col;

        if {$MineBody($x,$y,status) != "UNDO"} {
                return;
        }

        if {$MineBody($x,$y,val) == "*"} {
                GameOver;
                return;
        }
        
        DisplayChanges $x $y $MineBody($x,$y,val) "OPENED" "RELIEF";

        if {$MineBody($x,$y,val) != 0} {
                IsTaskOver;
                return
        }

        for {set i [expr $x - 1]} {$i <= [expr $x + 1]} {incr i} {
                for {set j [expr $y - 1]} {$j <= [expr $y + 1]} {incr j} {
                        if {$MineBody($i,$j,val) == -1 || $MineBody($i,$j,status) != "UNDO"} {
                                continue;
                        }
        
                        DisplayChanges $i $j $MineBody($i,$j,val) "OPENED" "RELIEF";
                        
                        if {$i == $x && $j == $y} {
                                continue;
                        }

                        if {$MineBody($i,$j,val) == 0} {
                                set MineBody($i,$j,status) "UNDO";
                                ClickLeftBtn $i $j;
                        }
                }
        }

        IsTaskOver;
}

#-------------------------------------------------------------
# 格子的凹凸变化
#-------------------------------------------------------------
proc DisplayChanges {x y text status args} {
        global MineBody;
        set color blue;

        if {$args == "RELIEF"} {
                if {$text == 0} {
                        set text {};
                } elseif {$text == "*"} {
                        set color black
                }

                $MineBody($x,$y,NameOfBtn) config -relief sunken \
                        -disabledforeground $color -text $text -state disable;
                set MineBody($x,$y,status) $status;
        } else {
                $MineBody($x,$y,NameOfBtn) config -foreground red -text $text;
                set MineBody($x,$y,status) $status;
        }
}