#================================================================================
#　　　　　　　　　　　　　　　
#　　　　　　　　　　　　D&D3eオンラインセッション用プラグイン v0.6
#
#　　　　　　　　　　　　　by tori（bbt_tori@ybb.ne.jp）
#
#================================================================================

#メインルーチン開始-----------------------------------------------------------------------------------
sub mapping{
my ($nick,$data) = @_;
my $mess="null";
my $cmd="null";
my $die=0;
my @DICE=();
#環境変数
my $file="file.txt";
my $insvf="insv.txt";
#定義ファイルを読み込む---------------------------------------------------------------------------------
&in::file("$file");
my @FI=@in::file;
#マップファイルを読み込む-------------------------------------------------------------------------------
if($FI[0] ne "" ){
&in::file($FI[0]);
@FILE=@in::file;
my $i=0;
foreach $mfd(@FILE){
if($i<20){
push @MAP, $mfd;
}else{
push @PL, $mfd;
}
$i++;
}
}

#判定処理-------------------------------------------------------------------------------------------
#判定全般(role d20)
$cmd="[*#]";
if($data=~m/^$cmd(.*)( |)(0|[+-]\d\d?) ?([^ ]*)?$/){
if($4 ne ""){$nick="$nick（$4）";}
$die=&dice(20);
my $res=$die+scalar($3);
$mess="$nickの$1は 1d20($die)$3= $res です。";
}
#イニシアチブ処理-------------------------------------------------------------------------------------
#戦闘開始
$cmd="戦闘開始";
&sjis::on($cmd);
if($data=~m/^$cmd$/){
$mess="【敏捷力】の低い順にイニシアチブを登録して下さい。";
}
#戦闘開始
$cmd="順番確認";
&sjis::on($cmd);
if($data=~m/^$cmd$/){
&in::file("$insvf");
my @INSV=@in::file;

}
#イニシアチブ登録
$cmd="イニシアチブ";
&sjis::on($cmd);

if($data=~m/^$cmd( |)(0|[+-]\d\d?) ?([^ ]*)?$/){
if($3 ne ""){$nick="$nick（$3）";}
$die=&dice(20);
my $res=$die+scalar($2);
$mess="$res:$nick\n";
&in::file("$insvf");
my @INSV=@in::file;
foreach $iv(@INSV){unless($iv=~/:$nick\n/){push @newIV,$iv;}}
my $g=0;my $h=0;my $i=0;my $j=0;my $k=0;
my $max=-10;my $min=100;
foreach $iv(@newIV){
if($iv=~/(\d*):/){
$i=scalar($1);
if($i>$res and $h==0){$h++;}
elsif($i<=$res and $h!=0){splice @newIV,$g,0,$mess;$k++;print "1\n";last;}
if($max<$i){$max=$i}
if($min>$i){$min=$i}
$g++;
}
}
if($min>$res or $max<$res){
my $pre=100;
foreach $iv(@newIV){
if($iv=~/^(\d*):/) {
if($1>$pre and $k==0) {
splice @newIV,$j,0,$mess;
$h++;$k++;
print "2\n";
}
else{$pre=$1}
}
$j++;
}
}
if($k==0 and $INSV[0]=~/^$max:/ and $max<$res ){
unshift @newIV,$mess;
print "3\n";
}elsif($k==0){
push @newIV,$mess;
print "3\n";
}
&out::file($insvf,@newIV);
undef @newIV;
$mess="$nickをイニシアチブ$res ($die $2)に登録しました。";

}
#順番に処理
$cmd="次";
&sjis::on($cmd);
if($data=~m/^$cmd$/){
my $pre=0;my $now=0;
&in::file("$insvf");
my @INSV=@in::file;
$mess=$INSV[0];
if($INSV[0] eq ""){$mess="イニシアチブが未登録です。";}
else{
if($INSV[0]=~/(\d*):/){$now=scalar($1);}
if($INSV[-1]=~/(\d*):/){$pre=scalar($1);}
if($pre<$now){$mess=~s/^(\d*):(.*)\n/次のラウンド…イニシアチブ$1で$2の行動順です。/;}
else{$mess=~s/^(\d*):(.*)\n/イニシアチブ$1で$2の行動順です。/;}
}
push @INSV,$INSV[0];
shift @INSV;
&out::file($insvf,@INSV);
print"$pre/$now";
}
#仕切り直し
$cmd="仕切り直し";
&sjis::on($cmd);
if($data=~m/^$cmd( |)(0|[+-]\d\d?) ?([^ ]*)?$/){
if($3 ne ""){$nick="$nick（$3）";}

$die=20;
my $res=$die+scalar($2);
$mess="$res:$nick\n";
&in::file("$insvf");
my @INSV=@in::file;
foreach $iv(@INSV){unless($iv=~/:$nick\n/){push @newIV,$iv;}}
my $g=0;my $h=0;my $i=0;my $j=0;my $k=0;
my $max=-10;my $min=100;
foreach $iv(@newIV){
if($iv=~/(\d*):/){
$i=scalar($1);
if($i>$res and $h==0){$h++;}
elsif($i<=$res and $h!=0){splice @newIV,$g,0,$mess;$k++;print "1\n";last;}
if($max<$i){$max=$i}
if($min>$i){$min=$i}
$g++;
}
}
if($min>$res or $max<$res){
my $pre=100;
foreach $iv(@newIV){
if($iv=~/^(\d*):/) {
if($1>$pre and $k==0) {
splice @newIV,$j,0,$mess;
$h++;$k++;
print "2\n";
}
else{$pre=$1}
}
$j++;
}
}
if($k==0 and $INSV[0]=~/^$max:/ and $max<$res ){
unshift @newIV,$mess;
print "3\n";
}elsif($k==0){
push @newIV,$mess;
print "3\n";
}
my $pre=0;my $now=0;
$mess=$newIV[0];
if($newIV[0]=~/(\d*):/){$now=scalar($1);}
if($newIV[-1]=~/(\d*):/){$pre=scalar($1);}
if($pre<$now){$mess=~s/^(\d*):(.*)\n/$nickを$resに変更しました。次のラウンド…イニシアチブ$1で$2の行動順です。/;}
else{$mess=~s/^(\d*):(.*)\n/$nickを$resに変更しました。イニシアチブ$1で$2の行動順です。/;}
push @newIV,$newIV[0];
shift @newIV;
&out::file($insvf,@newIV);
undef @newIV;
}
#待機の割り込み処理
$cmd="待機行動";
&sjis::on($cmd);
if($data=~m/^$cmd ?([^ ]*)?$/){
if($1 ne ""){$nick="$nick（$1）";}
&in::file("$insvf");
my @INSV=@in::file;
my @newIV=();
unless($INSV[-1]=~/:$nick$/){unshift @INSV,$INSV[-1];pop @INSV;}
foreach $iv(@INSV){unless($iv=~/:$nick\n/){push @newIV,$iv;}}
if($newIV[0]=~/^(\d*):/){
$mess="$1:$nick\n";
}
push @newIV,$mess;
&out::file($insvf,@newIV);
undef @newIV;
$mess=~s/(\d*):(.*)\n/$2の割り込み行動です。/;
}
#遅延行動処理
$cmd="遅延行動";
&sjis::on($cmd);
if($data=~m/^$cmd ?([^ ]*)?$/){
if($1 ne ""){$nick="$nick（$1）";}
&in::file("$insvf");
my @INSV=@in::file;
my @newIV=();
foreach $iv(@INSV){unless($iv=~/$nick/){push @newIV,$iv;}}
if($newIV[-1]=~/^(\d*):/){
my $i=scalar($1);
$mess="$i:$nick\n";
}
unshift @newIV,$mess;
&out::file($insvf,@newIV);
undef @newIV;
$mess="$nickの行動は現在の処理が終わった時点で処理されます。";
}
#イニシアチブ記録クリア
$cmd="戦闘終了";
&sjis::on($cmd);
if($data=~m/^$cmd$/){
my @INSV=();
$mess="戦闘処理を終了します。";
&out::file($insvf,@INSV);
}



#MAP関連処理振り分け----------------------------------------------------------------------------------
#駒を登録(entry)
$cmd="登録";
&sjis::on($cmd);
if($data=~m/^$cmd ([a-tA-t])([1-9]|1\d|20) (.*gif) ?([^ ]*)?$/){
my $pos="$1$2";my $img=$3;my $sub=$4;$mess = &entry($pos,$img,$sub,$nick,$FI[0]);
}elsif($data=~m/^$cmd ([1-9]|1\d|20)([a-tA-t]) (.*gif) ?([^ ]*)?$/){
my $pos="$2$1";my $img=$3;my $sub=$4;$mess = &entry($pos,$img,$sub,$nick,$FI[0]);
}elsif($data=~m/^$cmd ([a-tA-t])([1-9]|1\d|20) ([12346789]) (npc[a-e]|en[a-i])$/){
my $pos="$1$2";my $img="tip/$4$3.gif";my $sub=$4;$mess = &entry($pos,$img,$sub,$nick,$FI[0]);
}elsif($data=~m/^$cmd ([1-9]|1\d|20)([a-tA-t]) ([12346789]) (npc[a-e]|en[a-i])$/){
my $pos="$2$1";my $img="tip/$4$3.gif";my $sub=$4;$mess = &entry($pos,$img,$sub,$nick,$FI[0]);
}
#駒を 移動(move)
$cmd="移動";
&sjis::on($cmd);
if($data=~m/$cmd ([12346789]+) ([12346789]) ?([^ ]*)?/){
my $pos="$1";my $dir=$2;my $sub=$3;$mess = &move2($pos,$dir,$sub,$nick,$FI[0]);
}elsif($data=~m/$cmd ([a-tA-t])([1-9]|1\d|20) ([12346789]) ?([^ ]*)?/){
my $pos="$1$2";
$pos=~tr/A-Z/a-z/;
my $dir=$3;my $sub=$4;$mess = &move($pos,$dir,$sub,$nick,$FI[0]);
}elsif($data=~m/$cmd ([1-9]|1\d|20)([a-tA-t]) ([12346789]) ?([^ ]*)?/){
my $pos="$2$1";
$pos=~tr/A-Z/a-z/;
my $dir=$3;my $sub=$4;$mess = &move($pos,$dir,$sub,$nick,$FI[0]);
}
#駒をリンク(link/band)
$cmd="リンク";
&sjis::on($cmd);
if($data=~m/$cmd ([^ ]*) ?([^ ]*)?/){
my $mod="link";my $tar=$1;my $dir=$2;my $sub=$3;$mess = &link($cmd,$mod,$tar,$dir,$sub,$nick,$FI[0]);
}
$cmd="ロック";
&sjis::on($cmd);
if($data=~m/$cmd ([^ ]*) ?([^ ]*)?/){
my $mod="band";my $tar=$1;my $dir=$2;my $sub=$3;$mess = &link($cmd,$mod,$tar,$dir,$sub,$nick,$FI[0]);
}
#駒を指定して削除(delete)
$cmd="削除";
&sjis::on($cmd);
if($data=~m/^$cmd ?([^ ]*)?$/){$mess = &del($nick,$1,$FI[0]);}
#駒を全て削除(kill)
$cmd="全削除";
&sjis::on($cmd);
if($data=~m/^$cmd$/){$mess = &kill($FI[0]);}
#マップファイルを交換(file)
$cmd="ファイル";
&sjis::on($cmd);
if($data=~m/$cmd ([^ ]*\.txt)/){
my $mod="file";my $mapfile=$1;$mess = &file($mod,$file,$mapfile);
}
#駒は残してマップだけ交換(map)
$cmd="マップ";
&sjis::on($cmd);
if($data=~m/$cmd ([^ ]*\.txt)/){
my $mod="map";my $mapfile=$1;$mess = &file($mod,$file,$mapfile);
}

#駒の配置をコピー(unit)

#終了処理-------------------------------------------------------------------------------------------
undef @FI;
undef @FILE;
undef @MAP;
undef @PL;
return $mess;
}
#メインルーチン終了-----------------------------------------------------------------------------------

#MAP関連サブルーチン----------------------------------------------------------------------------------
#登録処理ルーチン-------------------------------------------------------------------------------------
sub entry{
my ($pos,$img,$sub,$entnick,$outFILE) = @_;
my @entPL=();
my $enum="0";
my $chk="";
if($sub ne ""){$entnick="$entnick（$sub）";}
foreach $mfd(@PL){
if($mfd =~/^$pos｜/ and $enum ne "1"){@pldata= split(/｜/,$mfd);$chk="$pldata[1]";$enum="0";}
if($mfd =~/｜$entnick｜/ ){@pldata= split(/｜/,$mfd);$chk="$pldata[0]";$enum="1";}
}
if($chk eq ""){
my $entpl="$pos｜$entnick｜$img｜\n";
@entPL=($entpl,@PL);
@OUT=(@MAP,@entPL);
&out::file($outFILE,@OUT);
undef @entPL;
undef @OUT;
print"$entnick was registered.\n";
return "$entnick($img)を$posへ登録しました。";
}else{
if($enum eq "0"){
print"ERROR!! $entnick has not been registered.\n";
return "指定された座標($pos)にはすでに$chkがいるため登録できません。";

}else{
print"ERROR!! $entnick was already registered.\n";
return "$entnickは既に登録されています。";
}
}}

#座標指定移動処理ルーチン-------------------------------------------------------------------------------
sub move{
my ($pos,$dir,$sub,$movnick,$outFILE) = @_;
my @movPL=();
if($sub ne ""){$movnick="$movnick（$sub）";}
my $chk="";
my $chk2="";
foreach $mfd(@PL){
if($mfd =~/^$pos｜/ ){unless($mfd =~/^$pos｜$movnick｜/ ){my @pldata= split(/｜/,$mfd);$chk="$pldata[1]";}}
if($mfd=~/｜$movnick｜/){$chk2="hit";}
}
if($chk eq "" and $chk2 ne ""){
foreach $mfd(@PL){
unless($mfd=~/｜$movnick｜/){
push @movPL,$mfd;
}else{
my @pldata= split(/｜/,$mfd);
$pldata[2]=~s/([12346789]).gif/$dir.gif/;
my $movpl="$pos｜$movnick｜$pldata[2]｜\n";
unshift @movPL,$movpl;
}}
@OUT=(@MAP,@movPL);
&out::file($outFILE,@OUT);
undef @movPL;
undef @OUT;
print"$movnick was moved to $pos($dir).\n";
return "$movnickを$pos($dir)へ移動しました。";
}elsif($chk2 eq ""){
print"ERROR!! $movnick was unmovable.\n";
return "駒($movnick)は登録されていないため移動できません。";
}else{
print"ERROR!! $movnick was unmovable.\n";
return "座標($pos)にはすでに$chkがいるため移動できません。";
}}
#移動方向指定処理ルーチン-------------------------------------------------------------------------------
sub move2{
my ($pos,$dir,$sub,$movnick,$outFILE) = @_;
my @movPL=();
if($sub ne ""){$movnick="$movnick（$sub）";}
my $chk="";
my $chk2="";
my @YOKO=("","a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t");
my @TATE=("","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20");
my $x=0;my $y=0;my $m=0;my $p=0;

foreach $mfd(@PL){
if($mfd=~/([a-z])([1-9]|1\d|20)｜$movnick｜/){
foreach $yo(@YOKO){last if $1 eq $yo;$x++;}
foreach $ta(@TATE){last if $2 eq $ta;$y++;}
my @mvdata= split(//,$pos);
foreach $mv(@mvdata){
if($mv eq "1"){$x--;$y++;$p++;}
elsif($mv eq "2"){$y++;$m++;}
elsif($mv eq "3"){$x++;$y++;$p++;}
elsif($mv eq "4"){$x--;$m++;}
elsif($mv eq "6"){$x++;$m++;}
elsif($mv eq "7"){$x--;$y--;$p++;}
elsif($mv eq "8"){$y--;$m++;}
elsif($mv eq "9"){$x++;$y--;$p++;}
}
$m=5*(int($m+$p*1.5));
$pos="$YOKO[$x]$TATE[$y]";
print "$YOKO[$x]$TATE[$y]/$m feet\n";
          $chk2="hit";last;
     }
}
foreach $mfd(@PL){
     if($mfd =~/^$pos｜/ ){
          unless($mfd =~/^$pos｜$movnick｜/ ){
               my @pldata= split(/｜/,$mfd);
               $chk="$pldata[1]";
          }
     }
}
if($chk eq "" and $chk2 ne ""){
foreach $mfd(@PL){
unless($mfd=~/｜$movnick｜/){
push @movPL,$mfd;
}else{
my @pldata= split(/｜/,$mfd);
$pldata[2]=~s/([12346789]).gif/$dir.gif/;
my $movpl="$pos｜$movnick｜$pldata[2]｜\n";
unshift @movPL,$movpl;
}}
@OUT=(@MAP,@movPL);
&out::file($outFILE,@OUT);
undef @movPL;
undef @OUT;
print"$movnick was moved to $pos($dir).\n";
return "$movnickを$pos($dir)へ$mフィート移動しました。";
}elsif($chk2 eq ""){
print"ERROR!! $movnick was unmovable.\n";
return "駒($movnick)は登録されていないため移動できません。";
}else{
print"ERROR!! $movnick was unmovable.\n";
return "座標($pos)にはすでに$chkがいるため移動できません。";
}}
#リンク処理ルーチン-----------------------------------------------------------------------------------
sub link{
my ($mes,$mod,$tar,$dir,$sub,$linnick,$outFILE) = @_;
my @linPL=();
unless($sub eq ""){$linnick="$linnick（$sub）";}
my $chk="";
foreach $mfd(@PL){
my @pldata= split(/｜/,$mfd);
if($pldata[1] eq $tar){$chk=$mod;}
}
unless($chk eq ""){
foreach $mfd(@PL){
unless($mfd=~/｜$linnick｜/){
push @linPL,$mfd;
}else{
my @pldata= split(/｜/,$mfd);
my $linPL="$mod($tar,$dir)｜$linnick｜$pldata[2]｜\n";
unshift @linPL,$linPL;
}}
@OUT=(@MAP,@linPL);
&out::file($outFILE,@OUT);
undef @linPL;
undef @OUT;
print"$linnick was linked to $tar($dir).\n";
return "$linnickを$tar($dir)へ$mesしました。";
}else{
print"ERROR!! $linnick was unmovable.\n";
return "対象($tar)が存在しないため$mesできません。";
}
}
#削除処理 ルーチン------------------------------------------------------------------------------------
sub del{
my ($delnick,$delsub,$outFILE) = @_;
my @delPL=();
if($delsub ne ""){$delnick="$delnick（$delsub）";}
foreach $mfd(@PL){
unless($mfd=~/｜$delnick｜/){push @delPL,$mfd;}
}
@OUT=(@MAP,@delPL);
&out::file($outFILE,@OUT);
undef @delPL;
undef @OUT;
print"$delnick was removed.\n";
return "$delnickを削除しました。";
}
#全削除処理ルーチン-----------------------------------------------------------------------------------
sub kill{
my ($outFILE)=@_;
@OUT=@MAP;
&out::file($outFILE,@OUT);
undef @OUT;
print"All pieces were removed.\n";
return "駒を全て削除しました。";
}
#ファイル交換処理ルーチン-------------------------------------------------------------------------------
sub file{
my ($mod,$outFILE,$mapFILE)=@_;
@OUT=($mapFILE);
&out::file($outFILE,@OUT);
undef @OUT;
if($mod eq "file"){
print"Map-file was changed.\n";
return "マップファイルを$mapFILEに変更しました。";
}elsif($mod eq "map"){
&in::file($mapFILE);
@MFILE=@in::file;
while($#MFILE>19){pop @MFILE;}
#$MFILE[19]="$MFILE[19]\n";
@OUT=(@MFILE,@PL);
&out::file($mapFILE,@OUT);
undef @OUT;
print"Map was changed.\n";
return "マップを$mapFILEに変更しました。";
}
}
#判定関連サブルーチン----------------------------------------------------------------------------------
sub dice{
my ($d)=@_;
srand(time ^ ($$ + ($$ <<15)));
my $rndres=int(rand $d)+1;
return $rndres;
}

1;