之前玩ES2 时用的地图.

vase 发表于 2015-4-8 20:40:45

很粗糙不过手动辅助还算能用

<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE muclient>





<muclient>
<plugin
name="es2_map"
id="17bc23ea8b108255c54637fc"
language="PerlScript"
save_state="y"
date_written="2014-07-02 17:44:58"
requires="4.84"
version="1.0"
>

</plugin>



<include name="constants.pl"/>



<triggers>
<trigger
enabled="y"
group="map"
lines_to_match="15"
match="(.+) - \n((?:((?! - ).)*\n){1,14}?)(?: .+\n)?(?: 這裡沒有任何明顯的出路。| 這裡.+的出口是 (.+)。)\n\z"
multi_line="y"
regexp="y"
script="onMapLog"
sequence="100"
>
</trigger>
<trigger
enabled="y"
group="map"
match="指令錯誤，請用 help cmds 查詢可用的指令。"
script="clearPath"
sequence="100"
>
</trigger><trigger
enabled="y"
group="map"
match="要移動請你先用 halt 終止你正在做的事。"
script="clearPath"
sequence="100"
>
</trigger>
<trigger
enabled="y"
group="map"
match="這個方向沒有出路。"
script="clearPath"
sequence="100"
>
</trigger>
</triggers>



<aliases>
<alias
name="MAP_checkAsciiOn"
match="MAP_checkASCIIOn"
enabled="y"
group="map"
send_to="12"
sequence="100"
>
<send>setVariable("asciiCheck", 1);
setAliasOption ("MAP_checkAsciiOn", "menu", "n");
setAliasOption ("MAP_checkAsciiOff", "menu", "y");
note("ascii check turn on");</send>
</alias>
<alias
name="MAP_checkAsciiOff"
match="MAP_checkAsciiOff"
enabled="y"
group="map"
send_to="12"
menu="y"
sequence="100"
>
<send>setVariable("asciiCheck", 0);
setAliasOption ("MAP_checkAsciiOn", "menu", "y");
setAliasOption ("MAP_checkAsciiOff", "menu", "n");
note("ascii check turn off");</send>
</alias>
<alias
name="MAP_mapLogOn"
script="logOn"
match="MAP_logOn"
enabled="y"
menu="y"
sequence="100"
>
</alias>
<alias
name="MAP_mapLogOff"
script="logOff"
match="MAP_logOff"
enabled="y"
sequence="100"
>
</alias>
<alias
script="delete"
match="#d (\w+) ([\d,]+)"
enabled="y"
regexp="y"
sequence="100"
>
</alias>
<alias
match="#mp *"
enabled="y"
send_to="12"
sequence="100"
>
<send>&main::markAsPuzzle("%1")</send>
</alias>
<alias
match="^#ad (\d+) (\d+)"
enabled="y"
regexp="y"
send_to="12"
sequence="100"
>
<send>&main::addDoor("%1", "%2")</send>
</alias>
<alias
match="^#gp (\d+) (\d+)"
enabled="y"
regexp="y"
send_to="12"
sequence="100"
>
<send>&main::getPaths("%1", "%2", 1)</send>
</alias>
<alias
match="^#wtf (\d+)$"
enabled="y"
regexp="y"
send_to="12"
sequence="99"
>
<send>&main::getPathsForIdAndWalkTo("%1", 0.3)</send>
</alias>
<alias
match="^#wtf (+)$"
enabled="y"
regexp="y"
send_to="12"
sequence="100"
>
<send>&main::getPathsForAliasAndWalkTo("%1", 0.3)</send>
</alias>
<alias
match="^#aa (+) (\d+)$"
enabled="y"
regexp="y"
send_to="12"
sequence="100"
>
<send>&main::alias("%2", "%1")</send>
</alias>
<alias
match="^#aag (+) (\d+)$"
enabled="y"
regexp="y"
send_to="12"
sequence="100"
>
<send>&main::aliasGlobal("%2", "%1")</send>
</alias>
<alias
match="^#da (\d+)$"
enabled="y"
regexp="y"
send_to="12"
sequence="100"
>
<send>&main::delAlias("%1")</send>
</alias>
<alias
name="MAP_showAlias"
match="#sa"
omit_from_command_history="y"
enabled="y"
send_to="12"
menu="y"
sequence="100"
>
<send>&main::showAlias()</send>
</alias>
<alias
match="^#sp( (\d+))?$"
enabled="y"
regexp="y"
send_to="12"
sequence="100"
>
<send>
if("%2" eq ""){
&main::walkTo(getVariable("sp1"), 0.3);
}else{
&main::walkTo(getVariable("sp%2"), 0.3);
}
</send>
</alias>
<alias
name="MAP_closeDB"
script="closeDB"
match="MAP_closeDB"
enabled="y"
omit_from_command_history="y"
sequence="100"
>
</alias>
<alias
name="MAP_openDB"
script="openDB"
match="MAP_openDB"
enabled="y"
sequence="100"
>
</alias>
<alias
name="MAP_usage"
script="usage"
match="MAP_usage"
enabled="y"
sequence="100"
menu="y"
>
</alias>
<alias
name="MAP_debug"
script="debug"
match="MAP_debug"
enabled="y"
sequence="100"
menu="y"
>
</alias>
</aliases>



<variables>
<variable name="sqlDebug">0</variable>
<variable name="logOn">0</variable>
<variable name="cancelWalk">0</variable>
<variable name="autoFill">0</variable>
<variable name="asciiCheck">1</variable>
<variable name="pathSpliter">、| 和 </variable>
<variable name="asciiCheckChars"> -~</variable>
<variable name="lastRoom">-1</variable>
<variable name="DBI">1</variable>
<variable name="curRoom">-1</variable>
<variable name="asciiCheckLength">3</variable>
</variables>



<script>
<![CDATA[
#use strict;my $world;my $dbh;# open it if need do check
# 19:34
use DBI;
use utf8;
use Encode qw(encode decode);
my $curRoomKey = "curRoom";

my $asciiCheckKey = "asciiCheck";
my $asciiCheckLengthKey = "asciiCheckLength";
my $asciiCheckCharsKey = "asciiCheckChars";

my $logOnKey = "logOn";
my $autoFillCommandKey = "autoFill";

my $sqlDebugKey = "sqlDebug";

my $cmdSpliter = ";";

my $cancelWalkKey = "cancelWalk";
my $shortPath2Path = {
e => "east",
w => "west",
s => "south",
n => "north",
u => "up",
d => "down",
se => "southeast",
ne => "northeast",
sw => "southwest",
nw => "northwest",
eu => "eastup",
wu => "westup",
su => "southup",
nu => "northup",
ed => "eastdown",
wd => "westdown",
sd => "southdown",
nd => "northdown",
};
my $path2short = {
east    => "e",
west    => "w",
south    => "s",
north    => "n",
up       => "u",
down    => "d",
southeast=> "se",
northeast=> "ne",
southwest=> "sw",
northwest=> "nw",
eastup => "eu",
westup => "wu",
southup => "su",
northup => "nu",
eastdown => "ed",
westdown => "wd",
southdown=> "sd",
northdown=> "nd",
};
my $path2reverse = {
west => "east",
east => "west",
north => "south",
south => "north",
down => "up",
up => "down",
northwest => "southeast",
southwest => "northeast",
northeast => "southwest",
southeast => "northwest",
westdown => "eastup",
eastdown => "westup",
northdown => "southup",
southdown => "northup",
westup => "eastdown",
eastup => "westdown",
northup => "southdown",
southup => "northdown",
enter => "out",
in => "out",
out => "enter",
camp => "out"
};

my $EM_CHECK_PATH_NO_PATH = 0;
my $EM_CHECK_PATH_FROM_ONLY = 1;
my $EM_CHECK_PATH_TO_ONLY = 2;
my $EM_CHECK_PATH_BOTH = 3;

my $dbName = "es2hell";

sub debug{
my $debugging = getVariable($sqlDebugKey);
if($debugging == 0){
setVariable($sqlDebugKey, 1);
note("sql debug mode on");
}else{
setVariable($sqlDebugKey, 0);
note("sql debug mode off")
}
}

sub usage{
note("functions");
note("#d - delete data from table by id");
note("#ad - add door between room1 and room2 ");
note("#mp       - mark room as puzzle room ");
note("#gp - get paths from room 1 to room 2");
note("#wtf       - walk fast from current room to specified room");
note("#wtf    - walk fast from current room to specified alias ");
note("#aa - add room alias for current world");
note("#aag - add room alias for global");
note("#da       - delete all alias for room");
note("#sa             - show all valid aliases ");
note("#sp - goto the special path by the index. ");
note("                      if do not specify the path it will ");
note("                      try to get the first special path");
note("other functions can be shown by click mouse with ctrl");
}

sub miniMap{
my ($lastRoom, $curRoom, $reacheds, $unreacheds, $paths) = @_;
my %dirs = ();
my @normals = qw (northwest north northeast west east southwest south southeast
eastup eastdown westup westdown southup southdown northup northdown enter out up down);
my @specials = ();
for my $command (keys %$reacheds){
my $short = path2short($command);
my ($toRoomId, $toPuzzleRoom, $hasDoor) = @{$reacheds->{$command}};
my $isLastRoom = $lastRoom == $toRoomId;
my $str;
if ($toPuzzleRoom) {
$str = "???";
}else{
$str = "$toRoomId";
}
if($command ~~ @$paths){
$hasDoor = 0;
}
if ($isLastRoom) {
$dirs{$command} = $toPuzzleRoom ?
   ($hasDoor ? YELB("$short($str)"):YEL("$short($str)")) :
   ($hasDoor ? YELB("$short($str)"):CYN("$short($str)"));
}else{
$dirs{$command} = $toPuzzleRoom ?
   ($hasDoor ? YELB("$short($str)") : YEL("$short($str)")) :
   ($hasDoor ? YELB("$short($str)") : MAG("$short($str)"));
}
if ($command ~~ @normals) {

}else{
push @specials, $command;
}

}
for my $command (@$unreacheds){
my $short = path2short($command);
$dirs{$command} = YEL("$short(?)");
}
my $spaces = "%20s";
my $empty = WHT(). "" . NOR();
my $format = "$spaces $spaces $spaces $spaces $spaces";
for my $normal (@normals){
if(not exists $dirs{$normal}){
$dirs{$normal} = $empty;
}
}
note(sprintf($format, $dirs{'northwest'},          $empty, $dirs{'north'}, $dirs{'northup'}, $dirs{'northeast'}));
note(sprintf($format, $dirs{'westup'} , $dirs{'northdown'},    $dirs{'up'},       $empty, $dirs{'eastup'}));
note(sprintf($format, $dirs{'west'} , $dirs{'enter'},WHT("[$curRoom]"), $dirs{'out'},    $dirs{'east'}));
note(sprintf($format, $dirs{'westdown'} ,          $empty, $dirs{'down'}, $dirs{'southup'},$dirs{'eastdown'}));
note(sprintf($format, $dirs{'southwest'}, $dirs{'southdown'}, $dirs{'south'},       $empty, $dirs{'southeast'}));
if (@specials != 0) {
note("specials " . CYN("[". (join "], [", @specials) . "]"));
my $i = 1;
for my $sp (@specials){
   setVariable("sp$i", $sp);
$i++;
}
}else{
for my $i (1 .. 10){
   deleteVariable("sp$i");
}
}
####################
#    \nd\n /nu/    |       nu/nd
#w (room)e|wu/wd in/out eu/ed
#       s    |       su/sd
######################
}
#########################################
#### trigger using
#########################################
sub onMapLog{
# try to save room info and reset variable "current room";
my $lastRoomId = getVariable($curRoomKey);
my ($isPuzzle, $isNewRoom, $curRoomId, $paths)= logRoom(@_);
if ($isNewRoom == -1) {
return;
}
$world->setVariable($curRoomKey, $curRoomId);
# find reached paths and unreached paths.
my ($reacheds, $unreacheds) = checkRoomForPaths($isPuzzle, $curRoomId, $paths);
# if last room is not same as current room, try to save path info.
my $noteStr;
if ($isNewRoom) {
$noteStr .=RED("==new==");
}
$noteStr .= "[$curRoomId] ";
#if (keys %$reacheds != 0) {
# for my $key (keys %$reacheds){
# my $room = $reacheds->{$key};
# $noteStr .= "$key -> room $room";
# }
#}

if (@$unreacheds == 0) {
$noteStr .= "all rooms arrived."
}elsif($isPuzzle){
$noteStr .= RED("in puzzle room.");
}else{
$noteStr .= "unreached paths = <". YEL(). join(NOR(). "> <" . YEL(), @$unreacheds) . NOR(). ">";
}

if (getVariable($asciiCheckKey) == 0 and getVariable($logOnKey) != 0) {
$noteStr .= YEL("<ascii check off>");
}

note ($noteStr);

miniMap($lastRoomId, $curRoomId, $reacheds, $unreacheds, $paths);

#if(getVariable($randomWalkKey)){
# my ($walkCmd) = @$walkCmds;
# if (@$unreacheds == 0) {
# #to next uncompleted room
# my $uncompletedRooms = getUncompletedRooms();
# note ("uncompletedRooms = [@$uncompletedRooms]");
# for my $room (@$uncompletedRooms){
# my $cmds = getPaths($curRoomId, $room);
# if ($cmds ne "") {
# note ("find paths to room $room [$cmds]");
# randomWalkOff();
# walkTo($cmds, 1, "randomWalkOn()");
# last;
# }
# }
# }else{
# randomWalk($walkCmd, $unreacheds, $paths);
# }
#}
if (getVariable($logOnKey)) {
#note("auto log mode");
my $walkCmds = [];

if($lastRoomId != $curRoomId){
$walkCmds = commitPath($lastRoomId, $curRoomId);
}else{
note ("last room id $lastRoomId equal room id $curRoomId, just looking ?");
clearPath();
}
if (@$unreacheds == 0) {
# no unreached. to try do search
#note ("no unreached. to try do search");
my $direction = searchUncompletedArea($curRoomId, $paths);
#note("searched direction = $direction");
if ($direction) {
fillCommand($direction, 1);
}else{
fillCommand("");
clearPath();
}
}else{
# if have unreached.
my $walkCmd = @$walkCmds != 1 ? "" : $walkCmds->;
my $cmd = getRandomWalkPath($walkCmd, $unreacheds, $paths);
#note("cmd = $cmd");
clearPath();
fillCommand($cmd, 1);
}
}

return 1;
}

sub searchUncompletedArea{
my ($room, $paths) = @_;
my $direction;
for my $path (@$paths){
my ($row) = selectDB("select to_room from path where from_room = $room and command = '$path'");
my ($toRoom) = @{$row->};
my $num = getInvalidPathsNumber($toRoom);

#note ("[$path] fromRoom = $room toRoom = $toRoom, valid path number = $num");
if ($num != 0) {
$direction = $path;
last;
}
}
return $direction;
}

sub getInvalidPathsNumber{
my ($roomId) = @_;
return getField("select count(*) from path where from_room = $roomId and to_room <= 0");
}

sub getUncompletedRooms(){
my ($rows) = selectDB("select from_room from path where to_room <= 0");
my %rooms = ();
for my $row (@$rows){
my ($uncompletedRoomId) = @$row;
$rooms{$uncompletedRoomId} = 1;
}
my @allRooms = keys %rooms;
return \@allRooms;
}

sub getRandomWalkPath{
my ($walkCmd, $unreacheds, $paths) = @_;
#note("walk cmd = $walkCmd" );
my $reversedWalkCmd = path2reverse($walkCmd);
#note("reversed walk cmd = $reversedWalkCmd" );
my @possibleWalks = ();
#note("unreached = [@$unreacheds]");
#note("all paths = [@$paths]");
if($reversedWalkCmd){
if(@$unreacheds == 0){
push @possibleWalks, @$paths;
}elsif($reversedWalkCmd ~~ @$unreacheds){
push @possibleWalks, $reversedWalkCmd;
}else {
my $removed = removeFromArray($unreacheds, $reversedWalkCmd);
push @possibleWalks, @$removed;
}
}else{
if(@$unreacheds == 0){
push @possibleWalks, @$paths;
}else {
push @possibleWalks, @$unreacheds;
}
}
return getRandomEle(\@possibleWalks);
}
sub randomWalk {
my ($walkCmd, $unreacheds, $paths) = @_;
my $path = getRandomWalkPath(@_);
my $randomCmd = "*#wa 2000;$path";
Execute($randomCmd);
#note("walk to $possibleWalks[$randWalkPathIndex]...");
$world->setVariable($randomWalkPathKey, $randomCmd);
}

sub short2path{
my ($short) = @_;
return exists $shortPath2Path->{$short} ?
$shortPath2Path->{$short} : $short;
}

sub path2short{
my ($path) = @_;
return exists $path2short->{$path} ?
$path2short->{$path} : $path;
}
sub path2reverse{
my ($path) = @_;
return exists $path2reverse->{$path} ?
$path2reverse->{$path} : "";
}

sub pathCheck{
my($from, $to) = @_;
my $fromOnly = getField("select path_id from path where from_room = $from and to_room = $to");
my $toOnly = getField("select path_id from path where from_room = $to and to_room = $from");
if ($fromOnly and $toOnly) {
return $EM_CHECK_PATH_BOTH;
}elsif($fromOnly){
return $EM_CHECK_PATH_FROM_ONLY;
}elsif($toOnly){
return $EM_CHECK_PATH_TO_ONLY;
}else{
return $EM_CHECK_PATH_NO_PATH;
}
}

sub newPathCheck{
my ($from, $to, $command) = @_;
return {
from => $from,
to => $to,
cmd => $command,
report => pathCheck($from, $to),
};
}

sub checkRoomForPaths{
my ($isPuzzle, $roomId, $paths) = @_;
if ($isPuzzle) {
my %puzzleReached = (); #set puzzle reached as empty;
my @puzzleUnreacheds = @$paths; # set puzzle unreached as paths;
return (\%puzzleReached, \@puzzleUnreacheds);
}
if(getVariable("$logOnKey")){
for my $path (@$paths) {
my ($row) = selectDB("select path_id from path where from_room = $roomId and command = '$path'");
if (@$row == 0) {
# do not have record. do insert
execDB(qq{insert into path values (null, $roomId, -1, '$path',"", 0, -1)});
}
}
}
my @results = ();
my ($from_room_rows) = selectDB(qq{
select p.path_id, p.to_room, r.puzzle, p.door, p.command
   from path p, room r
where p.from_room = '$roomId' and p.to_room = r.room_id
});

my %reacheds = ();
if (@$from_room_rows > @$paths) {
note (RED("============== existing paths number greater than look ==========="));
}
for my $re (@$from_room_rows){
my ($path_id, $toRoom, $toPuzzleRoom, $hasDoor, $cmd) = @$re;
#note("[$path_id] to room = $toRoom, command = $command");
my $convertedCmd = short2path($cmd);
if ($toRoom > 0) {
my $roomInfo = [$toRoom, $toPuzzleRoom, $hasDoor];
$reacheds{$convertedCmd} = $roomInfo;
}
if ($convertedCmd ~~ @$paths) {
#note("[$path_id] to room = $toRoom, command = $convertedCmd");
}else{
note(RED("*[$path_id] to room = $toRoom, command = $convertedCmd"));
}

}

#note("reachs = @reacheds");
my @unreacheds = ();
for my $command (@$paths){
if(exists $reacheds{$command}){
#note("cmd [$command] have in paths @$paths");
# if the command have record in database. do nothing.
}else{
#note("[$command] have not in paths @$paths, add it into unreach list");
push @unreacheds, $command;
}
#note("unreached paths = @unreacheds");
}
return (\%reacheds, \@unreacheds);
}

sub checkHaveAscii{
my ($str) = @_;
my $check = getVariable($asciiCheckKey);
if (not $check) {
return 0;
}

my $checkPattern = getVariable($asciiCheckCharsKey); # default = " -~"; # do not contains 2c[,], 2e[.], 20[ ], 21[!], 3f[?]
my $checkLength = getVariable($asciiCheckLengthKey); # default as 1

my $gbkAsciiCheck = "([^$checkPattern]{$checkLength}[$checkPattern][^$checkPattern]{$checkLength})";

my $gbkStr = decode("gbk", $str);
if ($gbkStr =~ /$gbkAsciiCheck/) {
note ("checkPattern = $gbkAsciiCheck");
note ("matched ". encode("gbk", $1) . RED($2) . encode("gbk", $3));
return 1;
}else{
return 0;
}
}
sub logRoom{
my ($thename, $theoutput, $wildcards) = @_;
my $roomName = GetTriggerInfo($thename, 101);
my $description = GetTriggerInfo($thename, 102);
my $pathsStr = GetTriggerInfo($thename, 104); #
my $pathSpliter = GetVariable("pathSpliter");
my @paths = split /$pathSpliter/, $pathsStr;
if(getVariable($logOnKey)){
if (checkHaveAscii($roomName) or checkHaveAscii($description)) {
note (RED("have ascii chars, ignore it"));
return (-1, -1);
}
}

# check is new room
my $roomId = getField(
   qq{select room_id from room where short_name = '$roomName' and description = '$description'}
);
my $isPuzzle = getField(
   qq{select puzzle from room where short_name = '$roomName' and description = '$description'}
);
my $isNewRoom;
if($roomId){
}else{
$isNewRoom = 1;
}

if($isNewRoom && getVariable($logOnKey)){
#if is new room. insert it into the database.
#note("did not find room id, try to save it into database");
execDB(qq{insert into room values (null, '$roomName', '$description', 0)});
$roomId = checkInsertedRoomId();
#note("inserted room id = $roomId");
#showRooms($roomId);
}else{
#note("room id is $roomId");
}
return ($isPuzzle, $isNewRoom, $roomId, \@paths);
}
############
## must be used after inserted immediately. or it will occurs an error.
##
############
sub checkInsertedRoomId{
if(getLastInsertId() != getLastRoomId()){
note ("insert room failed");
return 0;
}else{
return getLastInsertId();
}
}

############
## must be used after inserted immediately. or it will occurs an error.
##
############
sub checkInsertedPathId{
if(getLastInsertId() != getLastPathId()){
note ("insert path failed");
return 0;
}else{
return getLastInsertId();
}
}

sub getLastInsertId{
return getField(
qq {select last_insert_rowid()});
}

sub getLastRoomId{
return getField(
   qq{select room_id from room order by room_id desc limit 1}
);
}

sub getLastPathId{
return getField(
   qq{select path_id from path order by path_id desc limit 1}
);
}
sub commitPath{
my ($lastRoomId, $curRoomId, $isPuzzle) = @_;
my $isPuzzleForLast = getField(
   qq{select puzzle from room where room_id = $lastRoomId}
);
if ($isPuzzleForLast) {
clearPath();
}

my $wholeCmds = getWholeCmd();
if($wholeCmds){
my ($rows) = selectDB(qq{select path_id, to_room from path where from_room = $lastRoomId and command = '$wholeCmds'});
if (@$rows == 0) {
   execDB(qq{insert into path values (null, '$lastRoomId', '$curRoomId', '$wholeCmds', "", 0, -1)});
my $pathId = checkInsertedPathId();
note ("new $pathId:[$lastRoomId]-".RED($wholeCmds).">[$curRoomId]");
}else{
my ($existPathId, $existToRoomId) = @{$rows->};
if($existToRoomId == -1){
execDB(qq{update path set to_room = $curRoomId where path_id = $existPathId});
note ("update $existPathId:[$lastRoomId]-". CYN($wholeCmds).">[$curRoomId]");
}elsif ($existToRoomId != $curRoomId) {
execDB(qq{delete from path where path_id = $existPathId});
note ("deleted unexpecting path ". RED($existPathId));
}else{
note ("existing path from room $lastRoomId to $curRoomId with cmd [$wholeCmds]");
}
}
}else{
note("command list is empty.. ignore the commit");
}

clearPath();
return $wholeCmds;
}

sub clearPath{
if($world->getVariable($logOnKey)){
DeleteCommandHistory();
#note("path history have cleared");
}else{
   setVariable($cancelWalkKey, 1);
}
}

sub getWholeCmd{
my $cmds = findValidCommands();
my @longCmds = map {short2path($_)} @$cmds;
my $wholeCmd = join $cmdSpliter, @longCmds;
return $wholeCmd;
}

sub findValidCommands{
if($world->getVariable($randomWalkKey)){
my $walkPath = $world->getVariable($randomWalkPathKey);
#note("A: next step [$walkPath]");
my @walkCmds = ($walkPath);
return \@walkCmds;
}else{
my $commands = $world->GetCommandList(10);
#note("M: [@$commands]");
my @validCmds = ();
for my $i (reverse (0 .. $#$commands)){
my @splited = split /\n/, $commands->[$i];
for my $command (@splited){
# note("$i -> $command");
if(isValidCommand($command)){
push @validCmds, $command;
# note("cmds is valid : @validCmds");
}else{
# note("cmds is not valid : @validCmds");
}
}
}
return \@validCmds;
}
}

sub isValidCommand{
my ($cmd) = @_;
if ($cmd =~ //) {
return 0;
}elsif ($cmd =~ /open .+/){
return 0;
}elsif ($cmd =~ /quit.*/){
return 0;
}
return 1;
}

sub logOn{
$world->setVariable($logOnKey, 1);
setAliasOption ("MAP_mapLogOn", "menu", "n");
setAliasOption ("MAP_mapLogOff", "menu", "y");
note("set map log on.");
}

sub logOff{
$world->setVariable($logOnKey, 0);
setAliasOption ("MAP_mapLogOn", "menu", "y");
setAliasOption ("MAP_mapLogOff", "menu", "n");
note("set map log off.");
}
my $searchMobKey = "searchingMob";
my $searchNameKey = "searchingName";
my $searchDesKey = "searchingDes";

sub findRoom {
note("trying to find room ");
my ($para) = @_;
my ($mob, $name, $description) = (GetVariable($searchMobKey),
GetVariable($searchNameKey), GetVariable($searchDesKey));
note("mob = $mob, name = $name, description = $description");
my @whereQuerys = ();
if($mob){

}
if($name){
push @whereQuerys, qq{ short_name like '%$name%'};
}

if($description){
push @whereQuerys, qq{ description like "%$description%"};
}
my $wholeWhereQuery = "select room_id from room where " . join " and ", @whereQuerys;
note("query = $wholeWhereQuery");
my ($rows) = selectDB($wholeWhereQuery);
if(@$rows == 0){
note ("did not find any room with query $wholeWhereQuery");
}else {
my @roomIds = map {@{$_}} @$rows;
note("find rooms " . join (", " , @roomIds));
showRooms(@roomIds);
}
}

sub findTheWay{
my ($fromRoomId, $toRoomId) = @_;
if($fromRoomId == $toRoomId){
   note (RED("from room is same as to room."));
return;
}
my %arrivedRooms = ();
$arrivedRooms{$fromRoomId} = 1;
#my @nextSteps = ($fromRoomId);
my @allPaths = ([$fromRoomId]);
my $curStepNum = 1;
#note ("searching from $fromRoomId to $toRoomId ...");
while (1) {
#note("checking paths with step $curStepNum");
my @curStepPaths = ();
my $invalidNumInStep = 0;
my $walkingNumInStep = 0;
my $stoppedNumInStep = 0;
for my $paths (@allPaths){
#note ("paths = @$paths");
if ($curStepNum != @$paths) {
# consider it as an ignored list
$invalidNumInStep++;
next;
}
my $lastPath = $paths->[$#$paths];
my $allPassedPaths = join "," , @$paths;
my($rows) = selectDB(qq{select to_room from path where from_room = $lastPath
and to_room not in ($allPassedPaths)});

if (@$rows == 0) {
#did not find any more
$stoppedNumInStep++;
}else{
for my $row (@$rows){
my ($validPathTo) = @$row;
#note ("validPathTo = [$validPathTo]");
my @new_paths = ();
push @new_paths, @$paths;
push @new_paths, $validPathTo;
$arrivedRooms{$validPathTo} = 1;
if ($validPathTo == $toRoomId) {
#note ("Success : find the path from $fromRoomId to $toRoomId");
#note (join "\n", @new_paths);
return (\@new_paths, scalar(keys(%arrivedRooms)));
}else{
push @curStepPaths, \@new_paths;
}
$walkingNumInStep++;
}
}
}
if ($walkingNumInStep == 0) {
#note("Failed : did not find the path from $fromRoomId to $toRoomId");
return ([], scalar(keys(%arrivedRooms)));
}
@allPaths = @curStepPaths;
$curStepNum++;
}
}

sub getPaths {
my($fromRoom, $toRoom, $show) = @_;
if($show){
note("trying to show path from $fromRoom to $toRoom");
}
my ($paths, $searchedSize) = findTheWay($fromRoom, $toRoom);
if($show){
note("paths = @$paths");
}
if (@$paths > 0) {
my @cmds = ();
for my $i (1 .. $#$paths){
my $priorRoomId = $paths->[$i - 1];
my $curRoomId = $paths->[$i];
#note("check path from $priorRoomId to $curRoomId");
my $rows = selectDB(qq{select command, door from path where
   from_room = $priorRoomId and to_room = $curRoomId});
my ($command, $door) = @{$rows->};
#note("command = $command, door = $door");
if ($command) {
if($door){
push @cmds, "open $command";
}
push @cmds, $command;
}else{
if($show){
note ("ERROR: can not find the command from $priorRoomId to $curRoomId");
}
return;
}
}
my $cmds = join $cmdSpliter, @cmds;
if($show){
note ("cmds : $cmds");
}
return $cmds;
}else{
if($show){
note ("search $searchedSize rooms but did not find the way from $fromRoom to $toRoom");
}
return;
}
}

##########################################
## alias functions
#########################################
sub deleteRoom{
my ($roomId) = @_;
checkRoom($roomId);
my $delQuery1 = qq{
delete from room where room_id in ($roomId);
};
execDB($delQuery1);
my $delQuery2 = qq{
delete from path where from_room in ($roomId);
};
execDB($delQuery2);
my $delQuery3 = qq{
delete from path where to_room in ($roomId);
};
execDB($delQuery3);
note(RED("deleted room $roomId and related paths"));
}
sub delete{
my ($thename, $theoutput, $wildcards) = @_;
my $tableName = $wildcards->;
my $ids = $wildcards->;
my $delQuery = qq{delete from $tableName where ${tableName}_id in ($ids)};
note($delQuery);
execDB($delQuery);
}
###################
###paras are room ids
###showRooms(1, 3, 15) - to show room detail for 1, 3, 15
###################
sub showRooms{
my $query = "select * from room where room_id in (". (join ",", @_) . ")";
printForSelectDB(selectDB($query));
}
###################
###paras are room id
###showRooms(1) - to show room detail and paths info for 1
###################
sub checkRoom{
my ($roomId) = @_;
my $query1 = "select * from room where room_id = $roomId";
printForSelectDB(selectDB($query1));
my $query2 = "select * from path where from_room = $roomId";
printForSelectDB(selectDB($query2));
my $query3 = "select * from path where to_room = $roomId";
printForSelectDB(selectDB($query3));
}

sub addDoor{
my ($fromRoom, $toRoom) = @_;
my $whereClause1 = "where from_room = $fromRoom and to_room = $toRoom";
my $whereClause2 = "where from_room = $toRoom and to_room = $fromRoom";

my $rows = selectDB(qq{select path_id from path where
(from_room = $fromRoom and to_room = $toRoom)
or
(from_room = $toRoom and to_room = $fromRoom)
});
my @pathIds = ();
for my $row (@$rows){
my ($pathId) = @$row;
push @pathIds, $pathId;
}

if (@pathIds != 0 ) {
execDB(qq{update path set door = 1 where from_room = $fromRoom and to_room = $toRoom});
execDB(qq{update path set door = 1 where from_room = $toRoom and to_room = $fromRoom});
note ("added door for [". (join "][", @pathIds) . "] between $fromRoom and $toRoom");
}else{
note ("did not find any path between $fromRoom and $toRoom");
}

}
sub markAsPuzzle{
my ($roomId) = @_;
my $query = "update room set puzzle = 1 where room_id = $roomId";
execDB($query);
removePathsForPuzzle();
note(CYN("marked room [$roomId] as puzzle"));
}

sub removePathsForPuzzle{
execDB(qq{delete from path where from_room in (select room_id from room where puzzle = 1)});
}
######################################
### commands
######################################
sub getPathsForAliasAndWalkTo{
my($aliasName, $second) = @_;
my $worldName = getInfo(2);
my $query = qq{select room from alias where alias_name = '$aliasName' and (world_name is null or world_name = '$worldName')};
my $roomId = getField($query);
if($roomId == 0){
   note(RED("Did not find the room for with alias $aliasName"));
   return;
}
my $curRoom = getVariable($curRoomKey);
my $cmd = getPaths($curRoom, $roomId, 1);
if($cmd ne ""){
   walkTo($cmd, $second, "'[$curRoom] -> [$roomId] done");
}
}
sub getPathsForIdAndWalkTo{
my($toRoom, $second) = @_;
my $curRoom = getVariable($curRoomKey);
my $cmd = getPaths($curRoom, $toRoom, 1);
if($cmd ne ""){
   walkTo($cmd, $second, "'[$curRoom] -> [$toRoom] done");
}
}

sub walkTo {
my ($cmds, $second, $afterWalkFinished) = @_;
if (!defined $second) {
$second = 2;
}
setVariable($cancelWalkKey, 0);
#note ("trying to walk to $cmds, second = $second, afterWalkFinished = $afterWalkFinished");
if($cmds ne ""){
my @splited = split /$cmdSpliter/, $cmds;
#note("@splited");
my $cmd = shift @splited;
#note("cmd = $cmd");
my $otherCmds = join $cmdSpliter, @splited;
#note("other cmds = $otherCmds");
my $cancel = getVariable($cancelWalkKey);
#note("cancel = $cancel");
my $tempCurCmdVarName = "temp_". GetUniqueNumber();
my $tempOtherCmdsVarName = "temp_". GetUniqueNumber();

setVariable("$tempCurCmdVarName", $cmd);
setVariable("$tempOtherCmdsVarName", $otherCmds);
my $script = qq{
if(getVariable("$cancelWalkKey")){
note ("have set cancel walk. ignored others");
}else{
         #note("exec .... [" . getVariable("$tempCurCmdVarName") . "]");
execute(encode("big5", decode("gbk", getVariable("$tempCurCmdVarName"))));
walkTo(getVariable("$tempOtherCmdsVarName"), $second, "$afterWalkFinished");
deleteVariable("$tempCurCmdVarName");
deleteVariable("$tempOtherCmdsVarName");
}
};
#note ($script);
my $res = DoAfterSpecial($second, $script, 12);
#note("$res");
}elsif($afterWalkFinished ne ""){
note (qq{cmd [$cmds] have done, try to call $afterWalkFinished});
DoAfterSpecial($second, $afterWalkFinished, 12);
}
}

sub alias{
my ($roomId, $alias) = @_;
my $worldName = getInfo(2);
my $query = qq{insert into alias values (null, '$alias', $roomId, '$worldName')};
note("inserting world alias [$alias] = [$roomId] for [$worldName]");
execDB($query);
}

sub aliasGlobal{
my ($roomId, $alias) = @_;
my $query = qq{insert into alias values (null, '$alias', $roomId, null)};
note("inserting global alias [$alias] = [$roomId]");
execDB($query);
}

sub delAlias{
my($roomId) = @_;
my $worldName = getInfo(2);
my $query = qq{delete from alias where room = $roomId and (world_name is null or world_name = '$worldName')};
note($query);
execDB($query);
}
sub showAlias{
my $worldName = getInfo(2);
my $query = qq{select * from alias where world_name is null or world_name = '$worldName'};
note (" showing all alias.. ");
my $rows = selectDB($query);
my $format = "%-20s %10s %30s";
note (sprintf($format, "Alias", "Room", "Global"));
for my $row (sort sortForAlias @$rows){
my ($id, $aliasName, $roomId, $worldName) = @$row;
if($worldName){
note(sprintf($format, $aliasName, $roomId));
}else{
note(CYN(sprintf($format, $aliasName, $roomId, "*")));
}
}
note (" ----------------------- ");
}
sub sortForAlias{
$a-> cmp $b->
or
$a-> cmp $b->
or
$a-> <=> $b->
or
$a-> <=> $b->
}
#############################################
## basic utils
#############################################
sub removeFromArray{
my ($array, $obj) = @_;
my @new_array = ();
for my $e (@$array){
if($e ne $obj){
push @new_array, $e;
}
}
return \@new_array;
}

sub getRandomEle{
my ($arr) = @_;
my $re = int(rand() * @$arr);
return $arr->[$re];
}

#############################################
## mush relation functions
#############################################
sub fillCommand{
my ($cmd, $select) = @_;
$world->SetCommandSelection(1, -1);
$world->pasteCommand($cmd);
if ($select) {
$world->SetCommandSelection(1, -1);
}
}

sub note{
my ($s) = @_;
$world->ANSINote($world->ANSI (1).NOR().$s);
}

#############
## 30: Black
## 31: Red
## 32: Green
## 33: Yellow
## 34: Blue
## 35: Magenta
## 36: Cyan
## 37: White
#############
##############
### foreground
##############
sub RED{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (31);
}else{
return $world->ANSI (31) . $str . NOR();
}
}
sub YEL{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (33);
}else{
return $world->ANSI (33) . $str . NOR();
}
}
sub YELB{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (43);
}else{
return $world->ANSI (43) . $str . NORB();
}
}
sub BLU{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (34);
}else{
return $world->ANSI (34) . $str . NOR();
}
}
sub MAG{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (35);
}else{
return $world->ANSI (35) . $str . NOR();
}
}
sub CYN{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (36);
}else{
return $world->ANSI (36) . $str . NOR();
}
}
sub CYNB{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (46);
}else{
return $world->ANSI (46) . $str . NORB();
}
}
sub WHT{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (37);
}else{
return $world->ANSI (37) . $str . NOR();
}
}
sub WHTB{
my ($str) = @_;
if ($str eq "") {
return $world->ANSI (47);
}else{
return $world->ANSI (47) . $str . NORB();
}
}
sub NOR{
return $world->ANSI (32);
}
sub NORB{
return $world->ANSI (40);
}
######################################
### Database operations
###
######################################

sub showLastError{
my $error = $world->DatabaseError ("$dbName");
if($error ne "not an error"){
note("DBError : $error");
}
}

sub openDB{
if($world->getVariable("DBI")){
openDB_DBI();
}else{
if(DatabaseOpen($dbName, GetInfo(66)."/worlds/$dbName.db3", 6) == 0){
Note("----------- Connected to database $dbName.db3 now -----------");
setAliasOption ("MAP_openDB", "menu", "n");
setAliasOption ("MAP_closeDB", "menu", "y");
setAliasOption ("MAP_closeDB", "menu", "y");
}else{
Note("Load '$dbName.db3' failed!")
}
}
}

sub closeDB{
if($world->getVariable("DBI")){
closeDB_DBI();
}else{
if(DatabaseClose($dbName) == 0){
Note("----------- Disonnected to database $dbName.db3 now -----------");
setAliasOption ("MAP_openDB", "menu", "y");
setAliasOption ("MAP_closeDB", "menu", "n");
}else{
Note("Close '$dbName.db3' failed!")
}
}
}

sub openDB_DBI{
my $dsn = "DBI:SQLite:dbname=" . GetInfo(66)."/worlds/$dbName.db3";
my $userid = "";
my $password = "";
$dbh = DBI->connect($dsn, $userid, $password, { RaiseError => 1 });
if($dbh){
Note("----------- Connected to database $dbName.db3 now -----------");
setAliasOption ("MAP_openDB", "menu", "n");
setAliasOption ("MAP_closeDB", "menu", "y");
setAliasOption ("MAP_closeDB", "menu", "y");
}else{
Note("Load '$dbName.db3' failed! $DBI::errstr")
}
return $dbh;
}

sub closeDB_DBI{
if($dbh){
$dbh->disconnect();
Note("----------- Disonnected to database $dbName.db3 now -----------");
setAliasOption ("MAP_openDB", "menu", "y");
setAliasOption ("MAP_closeDB", "menu", "n");
}else{
Note("Close '$dbName.db3' failed!")
}
}

sub execDB{
my($sql) = @_;
if (getVariable($sqlDebugKey)) {
note ("exec DB : $sql" );
}
if($world->getVariable("DBI")){
my $rv = getDBHandler()->do(decode("gbk", $sql));
if($rv < 0){
   note($DBI::errstr);
   note($sql);
}
}else{
my $re = $world->DatabaseExec($dbName, $sql);
showLastError();
}
}

sub printTable{
my ($tableName) = @_;
printForSelectDB(selectDB("select * from $tableName"));
}

sub printForSelectDB{
my ($allValues) = @_;

for my $i (0 .. $#$allValues){
my $values = $allValues->[$i]; # one row
note ("@$values");
}
}

sub getField{
my ($query) = @_;
if (getVariable($sqlDebugKey)) {
note ("getField : $query" );
}
if($world->getVariable("DBI")){
my $sth = getDBHandler()->prepare(decode("gbk", $query) );
my $rv = $sth->execute();
if($rv < 0){
   note($DBI::errstr);
   note($query);
   return;
}
my @row = $sth->fetchrow_array();
my $convertedRow = convert(\@row);
return $convertedRow->;
}else{
my $field = $world->DatabaseGetField($dbName, $query);
showLastError();
return $field;
}
}
sub convert{
my ($rows) = @_;
my @convertedRow = ();
for my $col (@$rows) {
my $convertedCol = encode("gbk", decode("utf8", $col));
push @convertedRow, $convertedCol; ##########################
}
return \@convertedRow;
}

sub selectDB {
my ($selectSql) = @_;
if (getVariable($sqlDebugKey)) {
note ("select DB : $selectSql" );
}
if($world->getVariable("DBI")){
my $sth = getDBHandler()->prepare(decode("gbk", $selectSql) );
my $rv = $sth->execute();
if($rv < 0){
   note($DBI::errstr);
   note($selectSql);
   return;
}
my @allValues;
while(my @row = $sth->fetchrow_array()) {
#note("orig row = @row");
push @allValues, convert(\@row);
}
return \@allValues;
}else{
$world->DatabaseFinalize ($dbName );
#note("force to stop last query");
my $re = $world->DatabasePrepare ($dbName, $selectSql);

#note("prepare result = $re");
# find the column names
my $names = $world->DatabaseColumnNames ($dbName);
#note("names = @$names");
# execute to get the first row
my $rc = $world->DatabaseStep ($dbName);# read first row
my @allValues;
# now loop, displaying each row, and getting the next one
while($rc == 100){
my $values = DatabaseColumnValues ($dbName);
push @allValues, $values;
$rc = $world->DatabaseStep ($dbName); #read next row
}
$world->DatabaseFinalize ($dbName);
showLastError();
return \@allValues;
}
}

sub getDBHandler{
#note ("getting db handler ...");
if($world->getVariable("DBI")){
if (defined $dbh) {
return $dbh;
}else{
openDB_DBI();
}
}
}
]]>
</script>

</muclient>

北大侠客行MUD，中国最好的MUD

hkyyxss 发表于 2015-4-8 21:36:03

好长

页: [1]

北大侠客行MUD论坛's Archiver

之前玩ES2 时用的地图.