maze.tcl

是一个迷人的探险游戏。可以单独运行(maze.tcl) 或者以支持网络的客户端/服务器形式运行（其它3个文件

#! /usr/local/bin/wish
wm title . "Maze Explorer"
wm resizable . 1 0
wm minsize . 300 300
wm maxsize . 300 300

proc chooseRandomItem {list} {
    lindex $list [expr {int([llength $list]*rand())}]
}

# must be odd!
set WIDTH 31
set HEIGHT 31

set DEBUG 1

# Magic adjustment parameter.  It corresponds to the probability that
# the next section of maze to be added will be connected to the one
# just added.  Larger values make maze creation slower and maze
# solution more difficult.  Smaller values make maze creation quicker,
# but the maze itself is easier to solve if you can figure out where
# the middle is.  (The effect on the time to create is non-linear,
# BTW.)  Mazes created by people feel like the mazes created when this
# parameter takes on large values, but the rest of the game is
# virtually unplayable at that setting...
set SHAPEMAGIC 0.75

set avatarDefinitions {
    avatar1 red
    avatar2 green
    avatar3 blue
    avatar4 yellow
    avatar5 purple
    avatar6 orange
}

# ----------------------------------------------------------------------

### WALL DISPLAY ENGINE ###

pack [canvas .c -width 300 -height 300 -background skyblue \
	-highlightthickness 0] -side left
.c create rectangle 0 60 300 300 -outline {} -fill forestgreen -tags floor
foreach {tag col x1 y1 x2 y2 x3 y3 x4 y4 off} {

    L8  #e08f1f   24  53    60  53    60  89    24  89  {7 -6}
    ll8 #e08f1f   60  53    96  53    96  89    60  89  {7 -4}
    l8  #e08f1f   96  53   132  53   132  89    96  89  {7 -2}
    m8  #e08f1f  132  53   168  53   168  89   132  89  {7  0}
    r8  #e08f1f  168  53   204  53   204  89   168  89  {7  2}
    rr8 #e08f1f  204  53   240  53   240  89   204  89  {7  4}
    R8  #e08f1f  240  53   276  53   276  89   240  89  {7  6}

    LL7 #c09f3f  -24  50    24  53    24  89   -24 100  {6 -7}
    L7	#c09f3f   24  50    60  53    60  89    24 100  {6 -5}
    ll7	#c09f3f   74  50    96  53    96  89    74 100  {6 -3}
    l7	#c09f3f  125  50   132  53   132  89   125 100  {6 -1}
    RR7 #c09f3f  326  50   276  53   276  89   326 100  {6  7}
    R7	#c09f3f  276  50   240  53   240  89   276 100  {6  5}
    rr7	#c09f3f  226  50   204  53   204  89   226 100  {6  3}
    r7	#c09f3f  175  50   168  53   168  89   175 100  {6  1}

    L6  #a0af5f	 -10  50    24  50    24 100   -10 100  {5 -6}
    ll6	#a0af5f	  24  50    74  50    74 100    24 100  {5 -4}
    l6	#a0af5f	  74  50   125  50   125 100    74 100  {5 -2}
    m6	#a0af5f	 125  50   175  50   175 100   125 100  {5  0}
    r6	#a0af5f	 175  50   226  50   226 100   175 100  {5  2}
    rr6	#a0af5f	 226  50   276  50   276 100   226 100  {5  4}
    R6  #a0af5f	 276  50   310  50   310 100   276 100  {5  6}

    L5  #80bf7f	 -60  43    24  50    24 100   -60 127	{4 -5}
    ll5	#80bf7f	  24  43    74  50    74 100    24 127	{4 -3}
    l5	#80bf7f	 108  43   125  50   125 100   108 127	{4 -1}
    R5  #80bf7f	 360  43   276  50   276 100   360 127	{4  5}
    rr5	#80bf7f	 276  43   226  50   226 100   276 127	{4  3}
    r5	#80bf7f	 192  43   175  50   175 100   192 127	{4  1}

    ll4 #60cf9f	 -60  43    24  43    24 127   -60 127  {3 -4}
    l4  #60cf9f	  24  43   108  43   108 127    24 127  {3 -2}
    m4  #60cf9f	 108  43   192  43   192 127   108 127  {3  0}
    r4  #60cf9f	 192  43   276  43   276 127   192 127  {3  2}
    rr4 #60cf9f	 276  43   360  43   360 127   276 127  {3  4}

    ll3 #40dfbf -228  10    24  43    24 127  -228 260  {2 -3}
    l3  #40dfbf   24  10   108  43   108 127    24 260  {2 -1}
    rr3 #40dfbf  528  10   276  43   276 127   528 260  {2  3}
    r3  #40dfbf  276  10   192  43   192 127   276 260  {2  1}

    l2  #20efdf -228  10    24  10    24 260   -10 260  {1 -2}
    m2  #20efdf   24  10   276  10   276 260    24 260  {1  0}
    r2  #20efdf  276  10   528  10   528 260   276 260  {1  2}

    l1  #00ffff  -10  -3    24  10    24 260   -10 314  {0 -1}
    r1  #00ffff  310  -3   276  10   276 260   310 314  {0  1}
} {
    .c create polygon $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4 \
	    -outline {} -fill $col -tag [list $tag wall]
    set fill($tag) $col
    lappend walls $tag
    set offset($tag) $off
}
focus .c
proc showWalls {wlist} {
    global walls fill
    .c itemconfigure wall -outline {} -fill {}
    foreach wall $wlist {
	.c itemconfigure $wall -outline $fill($wall) -fill $fill($wall)
    }
}

foreach {tag below scale dx posn} {
    al1 l1  1.05 -200  {0 -2}
    am1 {}  1.05    0  {0 0}
    ar1 r1  1.05  200  {0 2}

    aL2 ll3 0.55 -252  {2 -4}
    al2 l3  0.55 -126  {2 -2}
    am2 m2  0.55    0  {2 0}
    ar2 r3  0.55  126  {2 2}
    aR2 rr3 0.55  252  {2 4}

    Al3 L5  0.22 -177  {4 -6}
    aL3 ll5 0.22 -118  {4 -4}
    al3 l5  0.22  -59  {4 -2}
    am3 m4  0.22    0  {4 0}
    ar3 r5  0.22   59  {4 2}
    aR3 rr5 0.22  118  {4 4}
    Ar3 R5  0.22  177  {4 6}

    AL4 LL7 0.14 -158  {6 -8}
    Al4 L7  0.14 -119  {6 -6}
    aL4 ll7 0.14  -79  {6 -4}
    al4 l7  0.14  -40  {6 -2}
    am4 m6  0.14    0  {6 0}
    ar4 r7  0.14   40  {6 2}
    aR4 rr7 0.14   79  {6 4}
    Ar4 R7  0.14  119  {6 6}
    AR4 RR7 0.14  158  {6 8}
} {
    set id [.c create polygon  150 300  100 100  150 75  125 50  175 50  150 75 200 100 \
	    -tags [list $tag avatar] -outline white -fill red -width 0]
    .c scale $id 150 60 $scale $scale
    .c move $id $dx 0
    if {[string length $below]} {
	.c lower $id $below
    }
    set avshow($posn) $tag
}
.c itemconfigure avatar -outline {} -fill {}

# ----------------------------------------------------------------------

### LCD NUMBER DISPLAY ENGINE ###

# The shapes of individual elements of a digit
array set lcdshape {
    a {3.0 5 5.2 3 7.0 5 6.0 15 3.8 17 2.0 15}
    b {6.3 2 8.5 0 18.5 0 20.3 2 18.1 4 8.1 4}
    c {19.0 5 21.2 3 23.0 5 22.0 15 19.8 17 18.0 15}
    d {17.4 21 19.6 19 21.4 21 20.4 31 18.2 33 16.4 31}
    e {3.1 34 5.3 32 15.3 32 17.1 34 14.9 36 4.9 36}
    f {1.4 21 3.6 19 5.4 21 4.4 31 2.2 33 0.4 31}
    g {4.7 18 6.9 16 16.9 16 18.7 18 16.5 20 6.5 20}
}
# Which elements are turned on for a given digit?
array set llcd {
    0 {a b c d e f}
    1 {c d}
    2 {b c e f g}
    3 {b c d e g}
    4 {a c d g}
    5 {a b d e g}
    6 {a b d e f g}
    7 {b c d}
    8 {a b c d e f g}
    9 {a b c d e g}
    - {g}
    { } {}
}
# Which elements are turned off for a given digit?
array set ulcd {
    0 {g}
    1 {a b e f g}
    2 {a d}
    3 {a f}
    4 {b e f}
    5 {c f}
    6 {c}
    7 {a e f g}
    8 {}
    9 {f}
    - {a b c d e f}
    { } {a b c d e f g}
}

# Displays a decimal number using LCD digits in the top-left of the canvas
proc showLCD {number {width 5} {colours {#ff8080 #ff0000 #404040 #303030}}} {
    global llcd ulcd lcdshape
    set lcdoffset 0
    .c delete lcd
    foreach {onRim onFill offRim offFill} $colours {break}
    foreach glyph [split [format %${width}d $number] {}] {
	foreach symbol $llcd($glyph) {
	    .c move [eval .c create polygon $lcdshape($symbol) -tags lcd \
		    -outline $onRim -fill $onFill] $lcdoffset 0
	}
	foreach symbol $ulcd($glyph) {
	    .c move [eval .c create polygon $lcdshape($symbol) -tags lcd \
		    -outline $offRim -fill $offFill] $lcdoffset 0
	}
	incr lcdoffset 22
    }
}

# ----------------------------------------------------------------------

### MAZE GENERATOR ###

.c create rectangle 150 150 151 151 -fill grey80 -tag msgbg -outline {}
.c create text 150 150 -text "BUILDING MAZE" -font {Helvetica -14} -tag msg

set NumSpaces [expr {(($WIDTH-1)/2)*(($HEIGHT-1)/2)}]

proc makeWorkArea {} {
    global WIDTH HEIGHT MAZE DEBUG NumSpaces
    set s ""
    # no [string repeat] in Tcl 8.0
    for {set i 0} {$i<$WIDTH} {incr i} {
	append s "#"
    }
    set s [binary format a* $s]
    if {$DEBUG} {
	text .maze -width $WIDTH -height $HEIGHT -font {courier -6} \
		-takefocus 0 -borderwidth 0 -background [. cget -bg]
	.maze tag configure pos(me) -background black
	wm maxsize . [expr {300+[winfo reqwidth .maze]}] 300
    }
    for {set y 0;set i 1} {$i<$HEIGHT} {incr i; incr y} {
	if {$DEBUG} {
	    .maze insert end "$s\n"
	}
	## Fastest to use an array...
	for {set x 0} {$x<$WIDTH} {incr x} {set MAZE($x,$y) 1}
	#set MAZE([expr $i-1]) $s
	#append MAZE $s
    }
    if {$DEBUG} {
	.maze insert end $s
    }
    for {set x 0} {$x<$WIDTH} {incr x} {set MAZE($x,$y) 1}
    #set MAZE([expr $i-1]) $s
    #append MAZE $s
}
proc setat {x y {chr " "} {flag 0}} {
    global MAZE WIDTH DEBUG
    set MAZE($x,$y) $flag
    #set MAZE($y) [binary format a*@${x}a $MAZE($y) $chr]
    #set idx [expr {$y*$WIDTH+$x}]
    #set MAZE [binary format a*@${idx}a $MAZE $chr]
    #set MAZE [string range $MAZE 0 [expr {$idx-1}]]$chr[\
    #	     string range $MAZE [expr {$idx+1}] end]
    if {$DEBUG} {
	set idx [incr y].$x
	.maze delete $idx
	.maze insert $idx $chr
    }
}
proc getat {x y} {
    global WIDTH HEIGHT MAZE DEBUG
    if {$x<0 || $y<0 || $x>=$WIDTH || $y>=$HEIGHT} { return 1 }
    set MAZE($x,$y)
    #binary scan $MAZE($y) @${x}a chr
    #binary scan $MAZE @[expr {$y*$WIDTH+$x}]a chr
    #set chr
    #string index $MAZE [expr {$y*$WIDTH+$x}]
}
proc setInitialPosition {x y} {
    global places activeplaces
    #tk_messageBox -message "initial $x,$y"
    setat $x $y
    set pos [list $x $y]
    lappend places $pos
    set activeplaces($pos) {n s e w}
}

makeWorkArea
setInitialPosition [expr {2*($WIDTH/4)|1}] [expr {2*($HEIGHT/4)|1}]

proc gapto {x y dir} {
    global places activeplaces WIDTH HEIGHT
    if {[getat $x $y]} { return }
    switch $dir {
	n {
	    if {$y<=1 || ![getat $x [expr {$y-2}]]} { return }
	    setat $x [incr y -1]
	    setat $x [incr y -1]
	}
	s {
	    if {$y>=$HEIGHT-2 || ![getat $x [expr {$y+2}]]} { return }
	    setat $x [incr y]
	    setat $x [incr y]
	}
	e {
	    if {$x>=$WIDTH-2 || ![getat [expr {$x+2}] $y]} { return }
	    setat [incr x] $y
	    setat [incr x] $y
	}
	w {
	    if {$x<=1 || ![getat [expr {$x-2}] $y]} { return }
	    setat [incr x -1] $y
	    setat [incr x -1] $y
	}