mazerobot.tcl

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

#! /usr/local/bin/wish

set VERSION    1.2                  ;# What server version to talk to?
set HOSTNAME   localhost            ;# Default host
set PORTNUMBER ???                  ;# Default port
set QUEUEDELAY 270		    ;# Time between robot events
set ACTDELAY   654		    ;# Time between robot actions

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

### INITIAL SETUP ###

wm title . "Maze Explorer Robot 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> {}

set algorithm random
grid [radiobutton .random -text "Random" -variable algorithm \
	-value random] -sticky w
grid [radiobutton .walll -text "Wall Follower (left)" -variable algorithm \
	-value leftFollower] -sticky w
grid [radiobutton .wallr -text "Wall Follower (right)" -variable algorithm \
	-value rightFollower] -sticky w
grid [radiobutton .smart -text "Smart Guy" -variable algorithm \
	-value smartguy] -sticky w
grid [label .l -textvariable score] -sticky ew

# ----------------------------------------------------------------------

### USEFUL CODE ###

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

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

### COMPLEX RESPONSE HANDLERS ###

proc followWall {{wall left}} {
    global localwall
    if {$localwall($wall) < 0} {
	$wall
	forward
    } elseif {$localwall(mid) < 0} {
	forward
    } elseif {$wall == "right"} {
	left
    } else {
	right
    }
}

proc act {} {
    global algorithm localwall visibleAvatars target
    switch $algorithm {
	random {
	    eval [chooseRandomItem {forward forward forward left right}]
	}
	leftFollower {
	    followWall left
	}
	rightFollower {
	    followWall right
	}
	smartguy {
	    set nof 0
	    if {
		[info exists target] &&
		[string length $target] &&
		$localwall(mid) < 0
	    } then {
		array set a $visibleAvatars
		if {[info exist a(am1)]} {
		    if {$target == $a(am1)} {
			forward
			return
		    } else {
			set nof 1
		    }
		} elseif {[info exist a(am2)]} {
		    if {$target == $a(am2)} {
			forward
			return
		    } else {
			set nof 1
		    }
		} elseif {[info exist a(am3)]} {
		    if {$target == $a(am3)} {
			forward
			return
		    } else {
			set nof 1
		    }
		} elseif {[info exist a(am4)]} {
		    if {$target == $a(am4)} {
			forward
			return
		    } else {
			set nof 1
		    }
		}
	    }
	    if {$nof} {
		right
		if {$localwall(right)} {
		    forward
		} else {
		    right
		}
		return
	    }		    
	    followWall
	}
	default {
	    return -code error "I don't know algorithm \"$algorithm\""
	}
    }
}
proc smartAlec {message} {
    set m [string tolower $message]
    if {[string match *eccles* $m] && [string match *kettle* $m]} {
	broadcast "But it doesn't fit!"
    } elseif {[string match "*get you*" $m]} {
	broadcast "You and who's army?"
    } elseif {[string match "*i'll be back*" $m]} {
	broadcast "But only in the reruns..."
    } elseif {
	[string match *what* $m] &&
	[string match *multiply* $m] &&
	[string match *six* $m] &&
	[string match *nine* $m]
    } then {
	broadcast "Forty-two."
	broadcast "I always thought there was something fundamentally wrong\
		with the universe"
    } elseif {[string match *seeketh* $m] && [string match *findeth* $m]} {
	broadcast "Anyone seekething *me* had better be prepared for trouble!"
    } elseif {[string match *charge!* $m]} {
	broadcast "Run away! Run away!"
    }
}
proc bored {} {
    randomBroadcast {
	"He that seeketh, findeth."
	"What do you get if you multiply six by nine?"
	"Eccles, put the kettle on!"
	"Charge! Charge!"
    }
}

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

### NETWORK/BASIC RESPONSE HANDLERS ###

## Incoming Messages
# display {wall wall ...} {avtype avcol avtype avcol ...} direction
# ouch newScore
# bump newScore
# target colour
# message colour messageString
# colour colour
# vanished colour

## Outgoing Messages
# forward
# backward
# left
# right
# broadcast messageString

proc forward {} {sendMessage "forward"}
proc left    {} {sendMessage "left"}
proc right   {} {sendMessage "right"}
proc broadcast {message} {
    sendMessage [list \
	    "broadcast" [lindex [split [string trim $message] "\n"] 0]]
}
proc randomBroadcast list {
    broadcast [chooseRandomItem $list]
}
proc printConsole {message} {
    # Skips the queue...
    global socket
    if {[string length $socket]} {
	foreach line [split $message "\n"] {
	    puts $socket [list "printConsole" $line]
	}
    }
}

proc MSG_display {arg} {
    foreach {walls avs dir dots} $arg {break}

    global localwall visibleAvatars

    set localwall(left) [lsearch $walls l1]
    set localwall(right) [lsearch $walls r1]
    set localwall(mid) [lsearch $walls m2]

    set visibleAvatars $avs
}
proc MSG_ouch {arg} {
    global score
    set score [lindex $arg 0]
    # We hit something we shouldn't
    randomBroadcast {
	"I'll get you next time, Gadget!"
	"I'll be back..."
	"Next time, you're mine."
	"Youww be sowwy, youw wascawwy wabbit!"
	"D'oh!"
	"OOooh!  You've deaded me..."
	"Smeg."
    }
}
proc MSG_bump {arg} {
    global score
    set score [lindex $arg 0]
    # We hit something we should
    randomBroadcast {
	"Ho ho ho ho ho!"
	"Hasta la vista, baby!"
	"Just how bodaceous can I get?"
	"This one comes *with* batteries included..."
	"Another one bites the dust!"
    }
}
proc MSG_target {arg} {
    global mycol target
    set target [lindex $arg 0]
    # We are seeking avatar $target
    if {![string length $target]} {return}
    randomBroadcast [list \
	    "Look out, $target, since $mycol is on the trail!" \
	    "I'm coming to get you, ${target}..." \
	    "We seek you here, we seek you there, you d@&ned elusive $target!"\
	    "The time has come, $target, for us to have a little chat..." \
	    "Yoo hoo, $target, where are you?"
    ]
}
proc MSG_message {arg} {
    global mycol boredom
    foreach {col msg} $arg {break}
    # Avatar $col has sent message $msg

    if {[info exists boredom]} {
	after cancel $boredom
    }
    set boredom [after [expr {40000+int(10000*rand())}] bored]
    if {$mycol != $col} {
	smartAlec $msg
    }
}
proc MSG_colour {arg} {
    global mycol
    set mycol [lindex $arg 0]
    # Our colour is $col

    wm title . "Maze Explorer Robot: $mycol"
    global score
    set score 0
}
proc MSG_vanished {arg} {
    set col [lindex $arg 0]
    # Avatar $col has vanished from the server
    broadcast "If you can't take the heat, $col, get out of the kitchen."
}
proc MSG_version {arg} {
    set ver [lindex $arg 0]
    global VERSION socket
    # Use [package vsatisfies] instead??
    if {[string compare $ver $VERSION]} {
	catch {close $socket}
	catch {
	    tk_messageBox -message "mismatched versions: $ver and $VERSION"
	}
	set socket {}
	return
    }
    broadcast "Guess who's here to play?  Nyuk, nyuk, nyuk..."
}

proc rcvMsg {} {
    global socket
    if {[gets $socket line] < 0} {
	close $socket
	set socket {}
	return
    }
    #puts stdout $line
    if {[catch {
	regsub -all {[^a-z]} [lindex $line 0] {} cmd
	set arg [lrange $line 1 end]
	MSG_$cmd $arg
    } msg]} {
	printConsole $::errorInfo
	bgerror $msg
    }
}

proc sendMessage {cmd} {
    global messageQueue
    lappend messageQueue $cmd
}
proc messageSender {} {
    global socket messageQueue QUEUEDELAY
    set msg [lindex $messageQueue 0]
    set messageQueue [lrange $messageQueue 1 end]
    if {[llength $msg] && [string length $socket]} {
	puts $socket $msg
    }
    after $QUEUEDELAY messageSender
}
set messageQueue {}

proc doAction {} {
    global ACTDELAY
    act
    after $ACTDELAY doAction
}

proc runClient {serverhost serverport} {
    global socket ACTDELAY
    set socket [socket $serverhost $serverport]
    fconfigure $socket -buffering line
    fileevent $socket readable rcvMsg
    wm protocol . WM_DELETE_WINDOW {
	# Don't just delete the window...
	catch {puts $socket "broadcast {I'll be back...}"}
	catch {flush $socket}
	catch {close $socket}
	exit
    }
    after $ACTDELAY doAction
    messageSender
    vwait socket
    after 1500 exit
}

#console show
runClient $HOSTNAME $PORTNUMBER