原文： http://zetcode.com/gui/tcltktutorial/nibbles/

在 Tcl/Tk 教程的这一部分中，我们将创建一个贪食蛇游戏克隆。

贪食蛇是较旧的经典视频游戏。 它最初是在 70 年代后期创建的。 后来它被带到 PC 上。 在这个游戏中，玩家控制蛇。 目的是尽可能多地吃苹果。 蛇每次吃一个苹果，它的身体就会长大。 蛇必须避开墙壁和自己的身体。

开发

蛇的每个关节的大小为 10px。 蛇由光标键控制。 最初，蛇具有三个关节。 游戏立即开始。 游戏结束后，我们在窗口中心显示"Game Over"消息。

我们使用canvas小部件来创建游戏。 游戏中的对象是图像。 我们使用画布命令创建图像项。 我们使用画布命令使用标签在画布上查找项目并进行碰撞检测。

  1. #!/usr/bin/wish
  3. # ZetCode Tcl/Tk tutorial
  4. #
  5. # This is simple Nibbles game clone.
  6. #
  7. # author: Jan Bodnar
  8. # last modified: March 2011
  9. # website: www.zetcode.com
  11. package require Img
  13. set WIDTH 300
  14. set HEIGHT 300
  15. set DELAY 100
  16. set DOT_SIZE 10
  17. set ALL_DOTS [expr $WIDTH * $HEIGHT / ($DOT_SIZE * $DOT_SIZE)]
  18. set RAND_POS 27
  20. canvas .c -width $WIDTH -height $HEIGHT -background black
  21. pack .c 
  23. proc initGame {} {
  25.     set ::left false        
  26.     set ::right true
  27.     set ::up false
  28.     set ::down false
  29.     set ::inGame true
  30.     set dots 3
  31.     set ::apple_x 100
  32.     set ::apple_y 190
  34.     for {set i 0} {$i<$dots} {incr i} {
  35.         set x($i) [expr 50 - $i * 10]
  36.         set y($i) 50
  37.     }
  39.     set ::idot [image create photo img1 -file "dot.png"]
  40.     set ::ihead [image create photo img2  -file "head.png"]
  41.     set ::iapple [image create photo img3 -file "apple.png"]
  43.     createObjects
  44.     locateApple
  46.     bind . "<Key>" "onKeyPressed %K"        
  48.     after $::DELAY onTimer
  49. }
  51. proc createObjects {} {
  53.     .c create image $::apple_x $::apple_y \
  54.         -image $::iapple -tag apple -anchor nw
  55.     .c create image 50 50 -image $::ihead -tag head -anchor nw
  56.     .c create image 30 50 -image $::idot -tag dot -anchor nw
  57.     .c create image 40 50 -image $::idot -tag dot -anchor nw
  58. }
  60. proc checkApple {} {
  62.     set apple [.c find withtag apple]
  63.     set head [.c find withtag head]
  65.     set l [.c bbox head]
  66.     set overlap [eval .c find overlapping $l]
  68.     foreach over $overlap {
  70.         if {$over == $apple} {
  71.             set crd [.c coords $apple]
  72.             set x [lindex $crd 0]
  73.             set y [lindex $crd 1]
  74.             .c create image $x $y -image $::idot -anchor nw -tag dot
  75.             locateApple
  76.         }
  77.     }
  78. }
  80. proc doMove {} {
  82.     set dots [.c find withtag dot]      
  83.     set head [.c find withtag head]
  84.     set items [concat $dots $head]                
  86.     set z 0    
  88.     while {$z < [expr [llength $items] - 1]} {
  90.         set c1 [.c coords [lindex $items $z]]
  91.         set c2 [.c coords [lindex $items [expr $z+1]]]
  93.         .c move [lindex $items $z] [expr [lindex $c2 0]  - [lindex $c1 0] ] \
  94.             [expr [lindex $c2 1]  - [lindex $c1 1] ]
  95.         incr z 
  96.     }
  98.     if { [string compare $::left true] == 0} {
  99.         .c move head -$::DOT_SIZE 0
  100.     }
  102.     if {[string compare $::right true] == 0} {
  103.         .c move head $::DOT_SIZE 0
  104.     }
  106.     if {[string compare $::up true] == 0} {
  107.         .c move head 0 -$::DOT_SIZE
  108.     }
  110.     if {[string compare $::down true] == 0} {
  111.         .c move head 0 $::DOT_SIZE 
  112.     }      
  113. }
  115. proc checkCollisions {} {
  117.     set dots [.c find withtag dot]      
  118.     set head [.c find withtag head]
  120.     set l [.c bbox head]
  121.     set overlap [eval .c find overlapping $l]    
  123.     foreach dot $dots {
  125.         foreach over $overlap {
  126.             if {$over == $dot} {
  127.                  set ::inGame false
  128.             }
  129.         }
  130.     }
  132.     set x1 [lindex $l 0]
  133.     set y1 [lindex $l 1]
  135.     if {$x1 < 0} {
  136.          set ::inGame false
  137.     }
  139.     if {$x1 > [expr $::WIDTH - $::DOT_SIZE]} {
  140.          set ::inGame false
  141.     }
  143.     if {$y1 < 0} {
  144.         set ::inGame false
  145.     }
  147.     if {$y1 > [expr $::HEIGHT - $::DOT_SIZE]} {
  148.         set ::inGame false
  149.     }
  150. }
  152. proc locateApple {} {
  154.     set apple [.c find withtag apple]
  155.     .c delete lindex apple 0     
  157.     set r [expr round(rand() * $::RAND_POS)]
  158.     set ::apple_x [expr $r * $::DOT_SIZE]
  159.     set r [expr round(rand() * $::RAND_POS)]
  160.     set ::apple_y [expr $r * $::DOT_SIZE]
  162.     .c create image $::apple_x $::apple_y -anchor nw \
  163.         -image $::iapple -tag apple     
  164. }
  166. proc onKeyPressed {key} {
  168.     set a1 [ expr [string compare $key Left] == 0]
  169.     set a2 [ expr [string compare $::right true] != 0]
  171.     if { $a1 && $a2 } {
  173.         set ::left true
  174.         set ::up false
  175.         set ::down false
  176.     }
  178.     set b1 [ expr [string compare $key Right] == 0]
  179.     set b2 [ expr [string compare $::left true] != 0]
  181.     if {  $b1 && $b2 } {
  183.         set ::right true
  184.         set ::up false
  185.         set ::down false
  186.     }
  188.     set c1 [ expr [string compare $key Up] == 0]
  189.     set c2 [ expr [string compare $::down true] != 0]
  191.     if { $c1 && $c2 } {
  193.         set ::up true
  194.         set ::left false
  195.         set ::right false
  196.     }
  198.     set d1 [ expr [string compare $key Down] == 0]
  199.     set d2 [ expr [string compare $::up true] != 0]
  201.     if { $d1 && $d2 }  {
  203.         set ::down true
  204.         set ::left false
  205.         set ::right false
  206.     }
  207. }
  209. proc onTimer {} {
  211.     if {$::inGame} {
  212.         checkCollisions
  213.         checkApple
  214.         doMove
  215.         after $::DELAY onTimer    
  216.     } else {
  217.         gameOver
  218.     }
  219. }
  221. proc gameOver {} {
  223.    .c delete all
  225.    set x [ expr [winfo width .] / 2 ]
  226.    set y [ expr [winfo height .] / 2]
  228.    .c create text $x $y  -text "Game over" -fill white
  229. }
  231. initGame
  233. wm title . "Nibbles" 
  234. wm geometry . +150+150

首先，我们将定义一些在游戏中使用的常量。

WIDTH和HEIGHT常数确定电路板的大小。 DELAY常数确定游戏的速度。 DOT_SIZE是苹果的大小和蛇的点。 ALL_DOTS常数定义了板上可能的最大点数。 RAND_POS常数用于计算苹果的随机位置。

initGame过程初始化变量，加载图像并启动超时过程。

  1. set ::idot [image create photo img1 -file "dot.png"]
  2. set ::ihead [image create photo img2  -file "head.png"]
  3. set ::iapple [image create photo img3 -file "apple.png"]

在这些行中，我们加载图像。 贪食蛇游戏中有三个图像。 头，圆点和苹果。

  1. createObjects
  2. locateApple

createObjects过程在画布上创建项目。 locateApple在画布上随机放置一个苹果。

  1. bind . "<Key>" "onKeyPressed %K"

我们将键盘事件绑定到onKeyPressed过程。 游戏由键盘光标键控制。 %K是所按下键的 Tk 符号名称。 它被传递到onKeyPressed过程。

  1. proc createObjects {} {
  3.     .c create image $::apple_x $::apple_y \
  4.         -image $::iapple -tag apple -anchor nw
  5.     .c create image 50 50 -image $::ihead -tag head -anchor nw
  6.     .c create image 30 50 -image $::idot -tag dot -anchor nw
  7.     .c create image 40 50 -image $::idot -tag dot -anchor nw
  8. }

在createObjects过程中，我们在画布上创建游戏对象。 这些是帆布物品。 它们被赋予初始的 x，y 坐标。 -image选项提供要显示的图像。 -anchor选项设置为nw； 这样，画布项目的坐标就是项目的左上角。 如果我们希望能够在根窗口的边框旁边显示图像，这很重要。 如果您不理解我们的意思，请尝试删除锚点选项。 -tag选项用于识别画布上的项目。 一个标签可用于多个画布项目。

checkApple过程检查蛇是否击中了苹果对象。 如果是这样，我们添加另一个蛇形接头并称为locateApple。

  1. set apple [.c find withtag apple]
  2. set head [.c find withtag head]

find withtag命令使用其标签在画布上找到一个项目。 我们需要两个项目。 蛇和苹果的头。

  1. set l [.c bbox head]
  2. set overlap [eval .c find overlapping $l]

bbox命令返回项目的边界框点。 find overlapping命令查找给定坐标的冲突项。

  1. foreach over $overlap {
  3.     if {$over == $apple} {
  4.         set crd [.c coords $apple]
  5.         set x [lindex $crd 0]
  6.         set y [lindex $crd 1]
  7.         .c create image $x $y -image $::idot -anchor nw -tag dot
  8.         locateApple
  9.     }
  10. }

如果苹果与头部碰撞，我们将在苹果对象的坐标处创建一个新的点项目。 我们调用locateApple过程，该过程将从画布上删除旧的苹果项目，然后创建并随机放置一个新的项目。

在doMove过程中，我们有了游戏的关键算法。 要了解它，请看一下蛇是如何运动的。 您控制蛇的头。 您可以使用光标键更改其方向。 其余关节在链上向上移动一个位置。 第二关节移动到第一个关节的位置，第三关节移动到第二个关节的位置，依此类推。

  1. set z 0    
  3. while {$z < [expr [llength $items] - 1]} {
  5.     set c1 [.c coords [lindex $items $z]]
  6.     set c2 [.c coords [lindex $items [expr $z+1]]]
  8.     .c move [lindex $items $z] [expr [lindex $c2 0]  - [lindex $c1 0] ] \
  9.         [expr [lindex $c2 1]  - [lindex $c1 1] ]
  10.     incr z 
  11. }

该代码将关节向上移动。

  1. if { [string compare $::left true] == 0} {
  2.     .c move head -$::DOT_SIZE 0
  3. }

将头向左移动。

在checkCollisions程序中，我们确定蛇是否击中了自己或撞墙之一。

  1. set l [.c bbox head]
  2. set overlap [eval .c find overlapping $l]    
  4. foreach dot $dots {
  6.     foreach over $overlap {
  7.         if {$over == $dot} {
  8.               set ::inGame false
  9.         }
  10.     }
  11. }

如果蛇用头撞到关节之一，我们就结束游戏。

  1. if {$y1 > [expr $::HEIGHT - $::DOT_SIZE]} {
  2.     set ::inGame false
  3. }

如果蛇击中了棋盘的底部，我们将结束游戏。

locateApple过程会在板上随机找到一个新苹果，然后删除旧的苹果。

  1. set apple [.c find withtag apple]
  2. .c delete lindex apple 0

在这里，我们找到并删除了被蛇吃掉的苹果。

  1. set r [expr round(rand() * $::RAND_POS)]

我们得到一个从 0 到RAND_POS-1的随机数。

  1. set ::apple_x [expr $r * $::DOT_SIZE]
  2. ...
  3. set ::apple_y [expr $r * $::DOT_SIZE]

这些行设置了apple对象的 x，y 坐标。

在onKeyPressed程序中，我们确定所按下的键。

  1. set a1 [ expr [string compare $key Left] == 0]
  2. set a2 [ expr [string compare $::right true] != 0]
  4. if { $a1 && $a2 } {
  6.     set ::left true
  7.     set ::up false
  8.     set ::down false
  9.     }

如果按左光标键，则将left变量设置为true。 在doMove过程中使用此变量来更改蛇对象的坐标。 还要注意，当蛇向右行驶时，我们不能立即向左转。

  1. proc onTimer {} {
  3.     if {$::inGame} {
  4.         checkCollisions
  5.         checkApple
  6.         doMove
  7.         after $::DELAY onTimer    
  8.     } else {
  9.         gameOver
  10.     }
  11. }

每DELAY ms，将调用onTimer过程。 如果我们参与了游戏，我们将调用三个构建游戏逻辑的过程。 否则，游戏结束。 计时器基于after命令，该命令仅在DELAY ms 之后调用一次过程。 要重复调用计时器，我们递归调用onTimer过程。

  1. proc gameOver {} {
  3.    .c delete all
  5.    set x [ expr [winfo width .] / 2 ]
  6.    set y [ expr [winfo height .] / 2]
  8.    .c create text $x $y  -text "Game over" -fill white
  9. }

如果游戏结束，我们将删除画布上的所有项目。 然后，在屏幕中央绘制"Game Over"。

贪食蛇 - 图1

图：贪食蛇

这是用 Tcl/Tk 创建的贪食蛇电脑游戏。