mazeclient.tcl

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

#! /usr/local/bin/wish

set VERSION    1.2                  ;# What server version to talk to?
set FONT       {Helvetica -14}      ;# Font for text
set HOSTNAME   localhost            ;# Default host
set PORTNUMBER ???                  ;# Default port


# ----------------------------------------------------------------------

### INITIAL SETUP ###

wm title . "Maze Explorer Client: Version $VERSION"

pack [frame .f]
grid [label .f.l1 -text "Hostname:"] [entry .f.e1 -textvar HOSTNAME] -sticky w
grid [label .f.l2 -text "Port:"]   [entry .f.e2 -textvar PORTNUMBER] -sticky w
grid [button .f.b -text "CONNECT" -command {set go 1} -default active] - \
	-sticky ew
wm protocol . WM_DELETE_WINDOW {exit}
bind . <Return> {set go 1}
bind . <Escape> {exit}
tkwait visibility .
focus -force .f.e2
.f.e2 selection range 0 end
.f.e2 icursor end
vwait go
destroy .f
bind . <Return> {}
bind . <Escape> {}

# ----------------------------------------------------------------------

### COLOUR UTILITIES ###

proc rgb2col {r g b} {format "#%0.4x%0.4x%0.4x" $r $g $b}
proc darken {colour {pr 0.9} {pg 0.9} {pb 0.9} {w .}} {
    foreach {r g b} [winfo rgb $w $colour] {break}
    rgb2col [expr {int($r*$pr)}] [expr {int($g*$pg)}] [expr {int($b*$pb)}]
}
proc lighten {colour {pr 0.9} {pg 0.9} {pb 0.9} {w .}} {
    foreach {r g b} [winfo rgb $w $colour] {break}
    set r [expr {int($r/$pr)}]
    set g [expr {int($g/$pg)}]
    set b [expr {int($b/$pb)}]
    rgb2col [expr {$r>0xffff?0xffff:$r}] \
	    [expr {$g>0xffff?0xffff:$g}] \
	    [expr {$b>0xffff?0xffff:$b}]
}
proc scaleDistance {d col args} {
    if {[llength $args]} {
	foreach {r2 g2 b2  r3 g3 b3} $args {break}
    } else {
	foreach {r2 g2 b2} [winfo rgb .c [.c cget -background]] {break}
	foreach {r3 g3 b3} [winfo rgb .c [.c itemcget floor -fill]] {break}
    }
    foreach {r1 g1 b1} [winfo rgb .c $col] {break}
    rgb2col [expr {int(($r1*$d+$r2+$r3)/($d+2))}] \
	    [expr {int(($g1*$d+$g2+$g3)/($d+2))}] \
	    [expr {int(($b1*$d+$b2+$b3)/($d+2))}]
}

# ----------------------------------------------------------------------

### 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
    }
}

# ----------------------------------------------------------------------

### WALL DISPLAY ENGINE ###

pack [canvas .c -width 300 -height 300 -background skyblue \
	-highlightthickness 0] -side top
pack [entry .e] -side top -fill x

wm resizable . 0 0
wm minsize . 300 [expr {300+[winfo reqheight .e]}]
wm maxsize . 300 [expr {300+[winfo reqheight .e]}]

.c create rectangle 0 60 300 300 -outline {} -fill forestgreen -tags floor
proc makeWalls {} {
    global walls fill offset
    foreach {tag col x1 y1 x2 y2 x3 y3 x4 y4 off} {
	L8  1	24  53    60  53    60  89    24  89  {7 -6}
	ll8 1	60  53    96  53    96  89    60  89  {7 -4}
	l8  1	96  53   132  53   132  89    96  89  {7 -2}
	m8  1  132  53   168  53   168  89   132  89  {7  0}
	r8  1  168  53   204  53   204  89   168  89  {7  2}
	rr8 1  204  53   240  53   240  89   204  89  {7  4}
	R8  1  240  53   276  53   276  89   240  89  {7  6}

	LL7 2  -24  50    24  53    24  89   -24 100  {6 -7}
	L7  2	24  50    60  53    60  89    24 100  {6 -5}
	ll7 2	74  50    96  53    96  89    74 100  {6 -3}
	l7  2  125  50   131  52   131  90   125 100  {6 -1}
	RR7 2  326  50   276  53   276  89   326 100  {6  7}
	R7  2  276  50   240  53   240  89   276 100  {6  5}
	rr7 2  226  50   204  53   204  89   226 100  {6  3}
	r7  2  175  50   169  52   169  90   175 100  {6  1}

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

	L5  4  -60  43    24  50    24 100   -60 127  {4 -5}
	ll5 4	24  43    74  50    74 100    24 127  {4 -3}
	l5  4  108  43   124  49   124 101   108 127  {4 -1}
	R5  4  360  43   276  50   276 100   360 127  {4  5}
	rr5 4  276  43   226  50   226 100   276 127  {4  3}
	r5  4  192  43   176  49   176 101   192 127  {4  1}

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

	ll3 6 -228  10    24  43    24 127  -228 260  {2 -3}
	l3  6   24  10   107  42   107 128    24 260  {2 -1}
	rr3 6  528  10   276  43   276 127   528 260  {2  3}
	r3  6  276  10   193  42   193 128   276 260  {2  1}

	l2  7 -228  10    24  10    24 260   -10 260  {1 -2}
	m2  7   24  10   276  10   276 260    24 260  {1  0}
	r2  7  276  10   528  10   528 260   276 260  {1  2}

	l1  8  -10  -3    24  10    24 260   -10 314  {0 -1}
	r1  8  310  -3   276  10   276 260   310 314  {0  1}
    } {
	set fill($tag) [scaleDistance [expr {$col*2-1}] [darken darkgreen]]
	.c create polygon $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4 \
		-outline {} -fill $fill($tag) -tag [list $tag wall]
	lappend walls $tag
	set offset($tag) $off
    }
}

proc showWalls {wlist} {
    global walls fill
    .c itemconfigure wall -outline {} -fill {}
    foreach wall $wlist {
	.c itemconfigure $wall -outline $fill($wall) -fill $fill($wall)
    }
}

proc makeAvatars {} {
    global colourscale
    foreach {tag below scale dx posn tailoff} {
	al1 l1  1.05 -200  {0 -2}  5.5
	am1 {}  1.05    0  {0 0}   5.5
	ar1 r1  1.05  200  {0 2}   5.5

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

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

	AL4 LL7 0.14 -158  {6 -8}  1
	Al4 L7  0.14 -119  {6 -6}  1
	aL4 ll7 0.14  -79  {6 -4}  1
	al4 l7  0.14  -40  {6 -2}  1
	am4 m6  0.14    0  {6 0}   1
	ar4 r7  0.14   40  {6 2}   1
	aR4 rr7 0.14   79  {6 4}   1
	Ar4 R7  0.14  119  {6 6}   1
	AR4 RR7 0.14  158  {6 8}   1
    } {
	set cid [.c create oval \
		100 280  200 320 \
		-outline white  -fill red  -width 0  -tags [list c$tag dots]]
	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 $cid 150 60 $scale $scale
	.c move $cid $dx 0
	.c scale $id 150 60 $scale $scale
	.c move $id $dx 0
	if {[string length $below]} {
	    .c lower $id $below
	    .c lower $cid $id
	}
	# posn is really ignored here, as it is only needed on the server;
	# it is kept for commonality of data with standalone version...
	set colourscale(c$tag) $tailoff
    }
    .c itemconfigure avatar -outline {} -fill {}
    .c itemconfigure dots -outline {} -fill {}
}

proc showAvatars {avs} {
    .c itemconfigure avatar -fill {} -outline {}
    foreach {av col} $avs {
	.c itemconfigure $av -fill $col -outline white
    }
}
proc showDots {dots} {
    #COMPILER HACK
    set r2 [set g2 [set b2 [set r3 [set g3 [set b3 [set t [set c {}]]]]]]]

    global colourscale
    foreach {r2 g2 b2} [winfo rgb .c [.c cget -background]] {break}
    foreach {r3 g3 b3} [winfo rgb .c [.c itemcget floor -fill]] {break}
    foreach {t c} $dots {
	if {[string length $c]} {