Script of Saga III 設置支援 - 不具合の修正 Ver b2.0 -

不具合ではないけどやってみたことです。

インフォメーション作成で文字実体参照が使えるように(問題が起こりそうなのでやらないほうがいいかも)

master.cgiを開く

sub edit_information:
    $t1 =~ s/<br>/\n/g;
↓
    $t1 =~ s/<br>/\n/g;
    $t1 =~ s/&/&amp;/g;

sub make_information:
    $F{in} =~ s/&lt;/</g;
    $F{in} =~ s/&gt;/>/g;
↓
    $F{in} =~ s/&lt;/</g;
    $F{in} =~ s/&gt;/>/g;
    $F{in} =~ s/&amp;/&/g;

library/base.cgiを開く

sub decode:
        $V =~ s/</&lt;/g;
        $V =~ s/>/&gt;/g;
↓
        $V =~ s/&/&amp;/g;
        $V =~ s/</&lt;/g;
        $V =~ s/>/&gt;/g;

【リストへ戻る】

ホームページに戻るリンクがないような気がしたので。

library/rights.cgiを開く

sub rights:
    print qq|<br>Edit：$set::edt\n| if $set::edt;
↓
    print qq|<br><a href="$set::rtn">Edit：$set::edt</a>\n| if $set::edt;

【リストへ戻る】

Spetial Thanksのアンカーを無効に。

library/rights.cgiを開く

sub rights:
    print qq|<a href="#" onClick="GetView('creators')">$creators_label</a>\n| if !$set::stv;
↓
    print qq|<a href="#" onClick="GetView('creators');return false">$creators_label</a>\n| if !$set::stv;

【リストへ戻る】

死亡しているときはVITを回復しないように。

library/main.cgiを開く

sub main:
    # VITの回復
    $I->{Vt}  = int((time - $precode) / $set::rcv) / 10;
    $I->{vt} += $I->{Vt};
    $I->{vt}  = $I->{Mvt} if $I->{vt} > $I->{Mvt};
↓
    # VITの回復
    if ($I->{da} ne 'Dd' && $set::rcv) {
        $I->{Vt}  = int((time - $precode) / $set::rcv) / 10;
        $I->{vt} += $I->{Vt};
        $I->{vt}  = $I->{Mvt} if $I->{vt} > $I->{Mvt};
    }

【リストへ戻る】

戦闘時のメッセージをちょっと整形してみる。

library/fight.cgiを開く

sub fight_player:
        &M("$I->{Nm}が暴\走した！");
↓
        &M("$I->{Nm}が暴\走した！");
        &M();

sub fight_player:
        &concrete_battle($A,$D,'の攻撃。');
        &concrete_battle($D,$A,'の攻撃。');
↓
        &concrete_battle($A,$D,'の攻撃。');
        &concrete_battle($D,$A,'の攻撃。');
        &M();

sub fight_player:
        &concrete_battle($A,$D,'のカウンター！');
↓
        &concrete_battle($A,$D,'のカウンター！');
        &M();

sub first_battle:
    if ($S->{Sk}{Sa}) {
        &concrete_battle($S,$O,'による闇討ち！',1);
    }
    elsif ($V1) {
        &initiative($V1);
        if ($A->{Rh}{cl} eq 'Bo') {
            &concrete_battle($A,$D,'の先制攻撃！',1);
        }
    }
    elsif ($V2) {
        &initiative($V2);
        &throw_weapon($A,$D,"は$A->{Rh}{nm}を投げた！",1);
    }
    elsif ($V3) {
        &initiative($V3);
        if (&skill_roll($A,$set::sQg,$A->{in} * 3)) {
            &concrete_battle($A,$D,"は$SK{Qg}を放った！",1);
        }
    }
    elsif ($V4) {
        &initiative($V4);
        if (&skill_roll($A,$set::sQd,$A->{in} * 3)) {
            &concrete_battle($A,$D,"の$SK{Qd}！",1);
            $V5 = $V4 * -1;
            $set::frd--;
        }
    }
↓
    if ($S->{Sk}{Sa}) {
        &concrete_battle($S,$O,'による闇討ち！',1);
        &M();
    }
    elsif ($V1) {
        &initiative($V1);
        if ($A->{Rh}{cl} eq 'Bo') {
            &concrete_battle($A,$D,'の先制攻撃！',1);
            &M();
        }
    }
    elsif ($V2) {
        &initiative($V2);
        &throw_weapon($A,$D,"は$A->{Rh}{nm}を投げた！",1);
        &M();
    }
    elsif ($V3) {
        &initiative($V3);
        if (&skill_roll($A,$set::sQg,$A->{in} * 3)) {
            &concrete_battle($A,$D,"は$SK{Qg}を放った！",1);
            &M();
        }
    }
    elsif ($V4) {
        &initiative($V4);
        if (&skill_roll($A,$set::sQd,$A->{in} * 3)) {
            &concrete_battle($A,$D,"の$SK{Qd}！",1);
            &M();
            $V5 = $V4 * -1;
            $set::frd--;
        }
    }

交戦の後に &M() で改行を入れました

【リストへ戻る】

接触した相手がログイン中の場合に戻るボタンを表示してみる。

library/base.cgiを開く

sub login_check:
my  $T = shift; # true -> return true, false -> error
↓
my  $T = shift; # mode -> say, true -> return true, false -> error

sub login_check:
        if ($T) { return 1 }
↓
        if ($T =~ /\D/) { &say("$S->{nm}は現在ログイン中です",$T) }
        if ($T) { return 1 }

library/bounty.cgiを開く

sub bounty_after:
    &login_check($U);
↓
    &login_check($U,'bounty_before');

library/buy.cgiを開く

sub buy_before:
    &login_check($U);
↓
    &login_check($U,'contact_before');

sub buy_after:
    &login_check($U);
↓
    &login_check($U,'contact_before');

library/contact.cgiを開く

sub contact_after:
    &login_check($U);
↓
    &login_check($U,'contact_before');

library/cure.cgiを開く

sub cure_before:
    &login_check($U);
↓
    &login_check($U,'contact_before');

sub cure_after:
    &login_check($U);
↓
    &login_check($U,'contact_before');

library/destone.cgiを開く

sub destone:
    &login_check($U);
↓
    &login_check($U,'contact_before');

library/fight.cgiを開く

sub fight_player:
    &login_check($U);
↓
    &login_check($U,'contact_before');

library/trade.cgiを開く

sub trade_before:
    &login_check($U);
↓
    &login_check($U,'contact_before');

【リストへ戻る】

モンスターの出る地域でお金を拾えるようにしてみる。

library/find.cgiを開く

sub find:
        &found($I,"monster_$I->{pl}",$set::fvt,'探索','つ手に入れました',0,'monster');
↓
        &found($I,"monster_$I->{pl}",$set::fvt,'探索','つ手に入れました',1,'monster');

sub find:
    &reload_data('gl') if !$I->{Pl}{ev}{Ms};
↓
    &reload_data('gl');

【リストへ戻る】

耐久力を減少させてみる。

戦闘・生産時に一定の確率で装備の耐久力を減少させます。
戦闘時は装備している全てのアイテムの耐久力が減少します。
生産時は使用した装備品の耐久力が減少します。

set.cgiを開く

# その他 Others ###################################### #
$edb = 10;                   # 生産時の装備耐久度減少確率(n%)
$fdb = 10;                   # 戦闘時の装備耐久度減少確率(n%)

library/base.cgiを開く

# Sub Set Equipment #
sub set_equipment {
my  $S = shift;
my  $Si = shift;

    $S->{$Si->{eq}} = "$Si->{nm}/$Si->{cl}/$Si->{ql}/$Si->{ef}/$Si->{db}/$Si->{im}/$Si->{gd}/$Si->{pl}/$Si->{cr}";
}

を追加。

library/break.cgiを開く

sub break_check:
        undef $S->{$E};
        &reload_data($e);
        return 1;
    }
↓
        undef $S->{$E};
        &reload_data($e);
        return 1;
    }
    elsif (&roll_dice(100) <= $set::edb) {
        foreach $Ii (@{$S->{Bg}}) {
            if ($Ii->{eq} eq $e) {
                &M("$S->{$E}{nm}の耐久力が下がりました。");
                $Ii->{db}--;
                &set_equipment($S,$Ii);
                last;
            }
        }
        return 1;
    }

library/consumption.cgiを開く

sub consumption_check:
            else {
                &change_status($I,'bg',-$Si->{wt});
                $Si->{qn} = 0;
            }
            $I->{$Si->{eq}} = '';
            &reload_data($Si->{eq});
        }
↓
            else {
                &change_status($I,'bg',-$Si->{wt});
                $Si->{qn} = 0;
            }
            $I->{$Si->{eq}} = '';
            &reload_data($Si->{eq});
        }
        elsif (&roll_dice(100) <= $set::edb) {
            &M("$Si->{nm}の耐久力が下がりました。");
            $Si->{db}--;
            &set_equipment($I,$Si);
        }

library/equip.cgiを開く

sub fitting_room:
    $I->{$E} = "$Si->{nm}/$Si->{cl}/$Si->{ql}/$Si->{ef}/$Si->{db}/$Si->{im}/$Si->{gd}/$Si->{pl}/$Si->{cr}";
    $Si->{sp} = $Si->{rs} = '';
    $Si->{eq} = $E;
↓
    $Si->{sp} = $Si->{rs} = '';
    $Si->{eq} = $E;
    &set_equipment($I,$Si);

library/fight.cgiを開く

sub fight_player:
    # 奪取チェック #
    &steal_check($I) if !$U->{Op}{Sc};
↓
    # 奪取チェック #
    &steal_check($I) if !$U->{Op}{Sc};

    # 装備耐久度減少チェック #
    &equip_wear_check($I);
    &equip_wear_check($U);
    &M();

sub fight_creature:
    &baggage_check($I) if ref $I->{BI};
↓
    &equip_wear_check($I);
    &baggage_check($I) if ref $I->{BI};

sub baggage_check:
        next if !$F;
↓
        next if !$F;
        if ($F == 2) {
            if (--$Ii->{db} > 0) {
                &set_equipment($S,$Ii);
            }
            else {
                $S->{ucfirst($Ii->{eq})}{db}--;
                &destruction_check($S,$Ii->{eq});
                $F = 1;
            }
        }
        next if $F == 2;

# Sub Equip Wear Check #
sub equip_wear_check {
my  $S = shift;
my ($e,$E);

    return if !$set::fdb;
    return if $S->{Op}{Ub};

    undef $S->{WO};

    foreach $e (keys %set::eqp) {
        $E = ucfirst($e);
        next if $S->{$e} eq '';
        next if $S->{BI}{$e};

        if (&roll_dice(100) <= $set::fdb) {
            $S->{BI}{$e} = 2;
            &get_equipment($S,$e);
            &M("$S->{Nm}の$S->{$E}{nm}の耐久力が減少した。");
        }
    }
}

を追加

【リストへ戻る】

銀行に指定個数取引/銀行自動整理機能追加。

javascript/GetCookie.jsを開く

function GetValue:
	document.loginform.ps.value = GetCookie("ps");
↓
	document.loginform.ps.value = GetCookie("ps");
	document.loginform.bk.value = GetCookie("bk");

function BankAutoCheck() {
	document.bank.bk.checked = GetCookie("bk") != "" ? true : false;
}

を追加

library/base.cgiを開く

sub set_cookie:
    $ck = "id\:$F{id}\,ps\:$F{ps}\,";
↓
    $ck = "id\:$F{id}\,ps\:$F{ps}\,bk\:$F{bk}\,";

library/bank.cgiを開く

sub bank_before:
        $t1 .= qq|<input type=checkbox name=o$i class=checkbox> |;
        $t1 .= &decorate_item($Ii);
↓
        $t1 .= qq|<tr>\n<td>\n|;
        $t1 .= qq|<input type=checkbox name=o$i class=checkbox> |;
        $t1 .= &decorate_item($Ii);
        $t1 .= qq|</td>\n<td class=r>|;
        $Ii->{qn} ||= 1;
        $t1 .= qq|<input type=textbox name=ot$i class=textbox size=5 value=$Ii->{qn}>|;
        $t1 .= qq|</td>\n</tr>\n|;

sub bank_before:
        $t2 .= qq|<input type=checkbox name=$i class=checkbox> |;
        $t2 .= &decorate_item($Ii);
↓
        $t2 .= qq|<tr>\n<td>\n|;
        $t2 .= qq|<input type=checkbox name=$i class=checkbox> |;
        $t2 .= &decorate_item($Ii);
        $t2 .= qq|</td>\n<td class=r>|;
        $Ii->{qn} ||= 1;
        $t2 .= qq|<input type=textbox name=it$i class=textbox size=5 value=$Ii->{qn}>|;
        $t2 .= qq|</td>\n</tr>\n|;

sub bank_before:
    &header(CSS=>'sub',JavaScript=>'GetView');
↓
    &header(CSS=>'sub',JavaScript=>'GetCookie,GetView',Body=>' onLoad="BankAutoCheck();"');

sub bank_before:
    <form method=post action=$set::cgi_url>
↓
    <form name=bank method=post action=$set::cgi_url>

sub bank_before:
    $I->{Sp}{Bk}{nm}からアイテムを出す<br>
    <br>
    $t1
↓
    <table class=item>
    <tr class=first>
    <td>$I->{Sp}{Bk}{nm}からアイテムを出す</td>
    <td class=r>引出個数</td>
    </tr>
    $t1
    </table>

sub bank_before:
    $I->{Sp}{Bk}{nm}にアイテムを保管する<br>
    <br>
    $t2
↓
    <table class=item>
    <tr class=first>
    <td>$I->{Sp}{Bk}{nm}にアイテムを保管する</td>
    <td class=r>預入個数</td>
    </tr>
    $t2
    </table>

sub bank_before:
    <tt>荷物スロット：$I->{bs}</tt><br>
↓
    <tt>荷物スロット：$I->{bs}</tt><br>
    <tt>パックスキル：$I->{pc}</tt>

sub bank_before:
    <select id=mode name=md class=select onChange="DisableObject('input','o','mode','bank_after','normal');">
↓
    <tt>銀行自動整理：<input type=checkbox name=bk class=checkbox></tt><br>
    <br>
    <select id=mode name=md class=select onChange="DisableObject('input','o','mode','bank_after','normal');">

sub bank_after:
my  $Ui;
↓
my  $Ui;
my  $Si;

sub bank_after:
        &say("$Ii->{nm}は装備中です。",'bank_before') if $Ii->{eq};
↓
        &say("$Ii->{nm}は装備中です。",'bank_before') if $Ii->{eq};
        &say("$Ii->{nm}：数値以外は使用出来ません。",'bank_before') if $F{"it$i"} =~ /\D/;

sub bank_after:
        $I->{bg} -= $Ii->{qn} * $Ii->{wt};
        $Ii->{sp} = $Ii->{rs} = '';
        push(@{$U->{Bg}},$Ii);
        undef $Ii;
↓
        $F{"it$i"} = $Ii->{qn} if $F{"it$i"} > $Ii->{qn};
        $F{"it$i"} = 1         if $F{"it$i"} <= 0;
        $I->{bg} -= $F{"it$i"} * $Ii->{wt};
        $Ii->{sp} = $Ii->{rs} = '';
        $Ii->{qn} -= $F{"it$i"};

        $Si = {%$Ii};
        $Si->{qn} = $F{"it$i"};
        push(@{$U->{Bg}},$Si);
        if (!$Ii->{qn}) { undef $Ii }

sub bank_after:
        $U->{Sl}--;
        $I->{bg} += $Ui->{qn} * $Ui->{wt};
        push(@{$I->{Bg}},$Ui);
        undef $Ui;
↓
        &say("$Ui->{nm}：数値以外は使用出来ません。",'bank_before') if $F{"ot$i"} =~ /\D/;
        $F{"ot$i"} = $Ui->{qn} if $F{"ot$i"} > $Ui->{qn};
        $F{"ot$i"} = 1         if $F{"ot$i"} <= 0;
        $I->{bg} += $F{"ot$i"} * $Ui->{wt};
        $Ui->{qn} -= $F{"ot$i"};

        $Si = {%$Ui};
        $Si->{qn} = $F{"ot$i"};
        push(@{$I->{Bg}},$Si);
        if (!$Ui->{qn}) { undef $Ui; $U->{Sl}-- }

sub bank_after:
    &say("$I->{Sp}{Bk}{nm}スロットがいっぱいです。",'bank_before') if $U->{Sl} > $I->{bk};
↓
    if ($F{bk}) {
        require "$set::lib_dir/pack.cgi";
        &auto_pack($I,$U->{Bg},$U);
    }

    &say("$I->{Sp}{Bk}{nm}スロットがいっぱいです。",'bank_before') if $U->{Sl} > $I->{bk};

sub bank_after:
    &set_user($I);
↓
    &set_user($I);

    &set_cookie;

library/top.cgiを開く

sub top:
<input type=hidden name=md value="main">
↓
<input type=hidden name=md value="main">
<input type=hidden name=bk>

sub.cssを開く

/* アイテム */
.item {
  width: 100%;
}
.item .first td {
  padding-bottom: 5px;
  font-size: 11px;
  font-family: monospace;
  color: #005533;
}
.item td {
  margin: 0;
  padding: 0;
  font-size: 12px;
}
.item td.r {
  vertical-align: bottom;
}


を追加

【リストへ戻る】

アイテムの購入フォームを統一してみる。

市場・闇市・農場・パートナーで、購入フォームの仕様を統一します。
買いたいアイテムにチェックを入れ、欲しい数を指定して購入します。
複数の種類のアイテムを同時に購入することが出来るようになります。

パックスキルを超えたパックを許可するかの設定が出来ます。
購入個数を指定できるようにするかの設定が出来ます。
「値段を設定する」で単価を入力するか全体価格を入力するかの設定が出来ます。

set.cgiを開く

# 市場 Market ######################################## #
$uop = 1;                    # 値段を設定するで単価を入力する(yes=1,no=0)
%mpc = (Mk=>0,Fm=>0,         # 市場,農場,闇市,対人での購入でパックスキルを超えてのパックを許可する(yes=1,no=0)
        Bm=>0,Xx=>0);
%mif = (Mk=>1,Fm=>1,         # 市場,農場,闇市,対人での購入で購入個数を指定出来るようにする(yes=1,no=0)
        Bm=>1,Xx=>1);

data/place.cgiを開く

    'Bm' => { 'nm' => '闇市'},
↓
    'Bm' => { 'md' => 'blackmarket_before',
              'nm' => '闇市'},

library/purchase.cgiを作成する

# --------------------------------------------------- #
# Script of Saga III Purchase.cgi Version 2 (2.0)
# 
# --------------------------------------------------- #

# Sub Purchase Item #
sub purchase_item {
my  $V1 = shift; # item ref [catalog]
my  $V2 = shift; # item ref
my  $P = shift; # place
my  $R = shift; # return mode
my  $T;
my  $G;
my  $M;
my  $Ii;
my  $Ui;
my  $buyitemflag;
my ($i,$n);
my ($keychck,$keytext);

    $I->{Ap} ||= 1;

    $R ||= $I->{Sp}{$P}{md};

    $T = $P eq 'Xx' ? 2 :
         $P eq 'Bm' ? 1 : 0;

    $G = !$T || $T == 2 && !$set::mif{$P} ? 1 : 0;

    foreach $Ui (@$V1) {
        $Ui = $V2->{$Ui} if $V2;
        $i++;
        $keychck = $T == 2 ?   "$i-$Ui->{id}-$Ui->{sp}" :   "$Ui->{id}_$Ui->{gd}";
        $keytext = $T == 2 ? "t-$i-$Ui->{id}-$Ui->{sp}" : "t_$Ui->{id}_$Ui->{gd}";

        $F{$keytext} = !$set::mif{$P} ? $T == 2 ? $Ui->{qn} : 1 : $F{$keytext};

        next if !$F{$keychck} || !$F{$keytext};

        if ($T == 1 && $F{dl}) {
            $Ui->{qn} = 0;
            $buyitemflag = 1;
            $M .= "管理者権限により$Ui->{nm}を削除しました<br>\n";
            &M("管理者権限により$Ui->{nm}を削除しました") && next;
        }

        &error('Price Error') if $T == 2 && !$Ui->{sp};
        &error('Quantity Error') if !$Ui->{qn};


        if ($F{$keytext} =~ /\D/) {
            $T == 2 && &M("$Ui->{nm}：数値以外は使用出来ません") && next;
            &say("$Ui->{nm}：数値以外は使用出来ません",$R);
        }
        $F{$keytext} = $Ui->{qn} if $T && $F{$keytext} > $Ui->{qn};

        $Ui->{Qn} = $T ? $F{$keytext} : $Ui->{qn} * $F{$keytext};
        $Ui->{Wt} = $Ui->{wt} * $Ui->{Qn};
        $Ui->{sp} = $T != 2 ? $T == 1 ? $Ui->{bp} * $set::mtp + $set::mpp : $Ui->{bp} : $Ui->{sp};
        $Ui->{sp}/= $Ui->{qn} if $T == 2 && !$set::uop;
        $Ui->{sP} = int($Ui->{sp});
        $Ui->{Sp} = $Ui->{sP} * $Ui->{Qn};
        $Ui->{SP} = $G ? int($Ui->{sP} * $Ui->{qn} * $I->{Ap})
                       : int($Ui->{sP} * $I->{Ap}) * $Ui->{Qn};
        $Ui->{SP}*= $F{$keytext} if !$T;


        if ($Ui->{rs} && $Ui->{rs} ne $I->{id}) {
            $T == 2 && &M("$Ui->{nm}は他の人に予\約されています。") && next;
            &say("$Ui->{nm}は他の人に予\約されています",$R);
        }
        elsif ($I->{bg} + $Ui->{Wt} > $I->{Mbg}) {
            $T == 2 && &M("これ以上は重くて持てません。") && next;
            &say('これ以上は重くて持てません',$R);
        }
        elsif ($Ui->{SP} > $I->{gl}) {
            $T == 2 && &M("$Ui->{nm}を買うお金がありません。") && next;
            &say('お金が足りません',$R);
        }


        undef $I->{BG};

        # パック不可アイテムの場合バラで追加 #
        if (&item_class_check($Ui) ne 'M') {
            $Ii = {%$Ui};
            $Ii->{sp} = '';
            $Ii->{rs} = '';
            push (@{$I->{BG}},$Ii) foreach 1 .. $F{$keytext};
        }
        # パックスキルを超えてのパックが許可されている場合 #
        elsif ($set::mpc{$P}) {
            $Ii = {%$Ui};
            $Ii->{qn} = $Ui->{Qn};
            $Ii->{sp} = '';
            $Ii->{rs} = '';
            push (@{$I->{BG}},$Ii);
        }
        # パックスキルを超えてのパックが許可されていない場合 #
        else {
            $Ui->{QN} = $Ui->{Qn};
            $Ui->{qN} = !$T ? $Ui->{qn} : 1; # フラグがなければパックの状態をひとつとして、そうでなければバラで判定

            # 購入個数ぶん荷物に収まるまで追加 #
            while ($Ui->{QN} > 0) {
                # パックスキルをチェックし、できるだけパック #
                foreach (1 .. $F{$keytext}) {
                    $n = $_;
                    $n-- && last if $Ui->{qN} * $n > $I->{pc};
                }
                $n = 1 if $n < 1;

                $Ii = {%$Ui};
                $Ii->{qn} = $Ui->{qN} * $n;
                $Ii->{sp} = '';
                $Ii->{rs} = '';
                push (@{$I->{BG}},$Ii);

                $F{$keytext} -= $n;
                $Ui->{QN} -= $Ii->{qn};
            }
        }


        if (@{$I->{Bg}} + @{$I->{BG}} > $I->{bs}) {
            $T == 2 && &M("荷物スロットが一杯です。") && next;
            &say("荷物スロットが一杯です",$R);
        }
        push (@{$I->{Bg}},@{$I->{BG}});

        $M .= &beat_price($Ui) if $T == 2;

        &change_status($U,'gl',$Ui->{Sp});
        &change_status($I,'bg',$Ui->{Wt});
        &change_status($I,'gl',-$Ui->{SP});
        &change_status($U,'bg',-$Ui->{Wt});

        $Ui->{qn}-= $Ui->{Qn};
        $Ui->{sp}*= $Ui->{qn} if $T == 2 && !$set::uop;
        $Ui->{Im} = &item_image($Ui);

        $M .= "$Ui->{Im}$I->{nm}は$Ui->{nm}を$Ui->{Qn}つ、$Ui->{Sp} $set::mnyで購入しました。<br>\n";
        &M("$Ui->{Im}$Ui->{nm}を$Ui->{Qn}つ、$Ui->{SP} $set::mnyで購入しました。");

        $buyitemflag = 1;
    }

    return $buyitemflag ? $M : '';
}

# Sub Purchase Pet #
sub purchase_pet {
my  $V1 = shift; # item ref [catalog]
my  $V2 = shift; # item ref
my  $P = shift; # place
my  $R = shift; # return mode
my  $T;
my  $Q;
my  $Ii;
my  $Ui;
my  $buypetsflag;
my ($i,$n);
my ($keychck,$keytext);

    $I->{Ap} ||= 1;

    $R ||= $I->{Sp}{$P}{md};

    $T = $P eq 'Xx' ? 2 :
         $P eq 'Bm' ? 1 : 0;

    $Q = $T == 2 || !$set::mif{$P} ? 1 : 0;

    foreach $Up (@$V1) {
        $Up = $V2->{$Up} if $V2;
        $i++;
        $keychck = $T == 2 ?   "$i-$Up->{id}-$Up->{sp}" :   "$Up->{id}_$Up->{gd}";
        $keytext = $T == 2 ? "t-$i-$Up->{id}-$Up->{sp}" : "t_$Up->{id}_$Up->{gd}";
        $F{$keytext} = 1 if $Q;
        next if !$F{$keychck} || !$F{$keytext};
        &error('Price Error') if $T == 2 && !$Up->{sp};

        if ($T == 1 && $F{dl}) {
            $Up->{id} = '';
            $buypetsflag = 1;
            $M .= "管理者権限により$Up->{nm}を削除しました<br>\n";
            &M("管理者権限により$Up->{nm}を削除しました") && next;
        }

        if ($F{$keytext} =~ /\D/) {
            $T == 2 && &M("$Ui->{nm}：数値以外は使用出来ません") && next;
            &say("$Ui->{nm}：数値以外は使用出来ません",$R);
        }

        $Up->{Qn} = $F{$keytext};
        $Up->{Sl} = $Up->{sl} * $Up->{Qn};
        $Up->{sp} = $T != 2 ? $T == 1 ? $Ui->{bp} * $set::mtp + $set::mpp : $Up->{bp} : $Up->{sp};
        $Up->{Sp} = $Up->{sp} * $Up->{Qn};
        $Up->{SP} = int($Up->{sp} * $I->{Ap}) * $Up->{Qn};

        if ($Up->{rs} && $Up->{rs} ne $I->{id}) {
            $T == 2 && &M("$Up->{nm}は他の人に予\約されています。") && next;
            &say("$Up->{nm}は他の人に予\約されています",$R);
        }
        elsif ($I->{px} + $Up->{Sl} > $I->{Mpx}) {
            &M("$Up->{nm}のためのスロットが空いていません。") && next;
            &say("スロットの空きが足りません",$R);
        }
        elsif ($Up->{SP} > $I->{gl}) {
            $T == 2 && &M("$Up->{nm}を買うお金がありません。") && next;
            &say('お金が足りません',$R);
        }

        $M .= &beat_price($Up);

        &change_status($U,'gl',$Up->{Sp});
        &change_status($I,'px',$Up->{Sl});
        &change_status($I,'gl',-$Up->{SP});
        &change_status($U,'px',-$Up->{Sl});

        $Up->{Im} = &item_image($Up);

        $M .= "$Up->{Im}$I->{nm}は$Up->{nm}を$Up->{Sp} $set::mnyで購入しました。<br>\n";
        &M("$Up->{Im}$Up->{nm}を$Up->{Qn}匹、$Up->{SP} $set::mnyで購入しました。");

        $Up->{sp} = '';
        $Up->{rs} = '';
        foreach (1 .. $F{$keytext}) {
            if ($T != 2) {
                $Up->{up} = $Up->{bt} = time;
                $Up->{pd} = time if $Up->{pd};
                $Up->{ch} = &roll_dice(4) - 1;
            }
            push (@{$I->{Pt}},{%$Up});
        }
        $Up->{id} = '';
        $buypetsflag = 1;
    }

    return $buypetsflag ? $M : '';
}

# Beat the Price #
sub beat_price {
my  $Si = shift;

    # 値切り #
    if ($I->{Sk}{Bp} && &roll_dice(100 + $I->{Map} - $I->{ap}) <= $set::sBp) {
        $Si->{sp} -= int($Si->{sp} * $set::uBp / 100);
        $Si->{Sp} -= int($Si->{Sp} * $set::uBp / 100);
        &M("$U->{nm}は$Si->{nm}を$set::uBp%引きの$Si->{Sp} $set::mnyにしてくれました。");
        return "$Si->{nm}を$set::uBp%引きにしてあげました。<br>\n";
    }
    return '';
}

# --------------------------------------------------- #
1;

上を purchase.cgi という名前で保存。libraryに収納

library/base.cgiを開く

sub decorate_item:
my  $T = shift; # Blackmarket = 1
↓
my  $T = shift; # Buy, Blackmarket = 1, Market = 2

sub decorate_item:
    $Z = $Si->{wt} if $T;
↓
    $Z = $Si->{wt} if $T == 1;

sub decorate_item:
    $V .= " x $W" if $W > 1 && !$T
↓
    $V .= " x $W" if $W > 1 && (!$Y || $T == 2);

sub decorate_item:
    $V .= " （$Z$set::wgt）" if $Z;
    $V .= "・・・在庫 $W" if $T;
↓
    $V .= "・・・在庫 $W" if $Y && $W && $T != 2;
    $V .= " （$Z$set::wgt）" if $Z;

library/blackmarket.cgiを開く

sub blackmarket_before:
    &say("めぼしい商品はないようです・・・",'market') if !@{$U->{Bg}};
↓
    &say("めぼしい商品はないようです・・・",'market') if !@{$U->{Bg}};

    $t1 .= <<"    END_OF_HTML" if $set::mif{Bm};
    <tr class=first>
    <td colspan=2 class=r>購入個数</td>
    </tr>
    END_OF_HTML

sub blackmarket_before:
        $t1 .= qq|<input type=radio name=ui class=radio value="$Ui->{id}_$Ui->{gd}"> |;
        $t1 .= &decorate_item($Ui,1);
↓
        $t1 .= qq|<tr>\n<td>\n|;
        $t1 .= qq|<input type=checkbox name=$Ui->{id}_$Ui->{gd} class=checkbox> |;
        $t1 .= &decorate_item($Ui,1);
        $t1 .= qq|</td>\n<td class=r>|;
        $t1 .= qq|<input type=textbox name=t_$Ui->{id}_$Ui->{gd} class=textbox size=5 value=1>| if $set::mif{Bm};
        $t1 .= qq|</td>\n</tr>\n|;

sub blackmarket_before:
    $t1 .= qq|<p><input type=checkbox name=dl class=checkbox> 買わずに削除する</p>\n| if $I->{Sk}{Rm};
↓
    $t1 .= qq|<tr><td colspan=2><br><input type=checkbox name=dl class=checkbox> 買わずに削除する</td></tr>\n| if $I->{Sk}{Rm};

    &get_item($I);

sub blackmarket_before:
    $t1
↓
    <table class=item>
    $t1
    </table>

sub blackmarket_before:
    個数：<input type=textbox name=hm class=textbox size=2 value="1"><br>

を削除

sub blackmarket_before:
    アイテム総重量：$I->{bg}/$I->{Mbg} $set::wgt<br>
↓
    アイテム総重量：$I->{bg}/$I->{Mbg} $set::wgt<br>
    荷物スロット：$I->{Bs}/$I->{bs}<br>
    パックスキル：$I->{pc}<br>

sub blackmarket_after:
my  $Ii;
my  $Ui;

    &say("個数には数値以外使用できません",'blackmarket_before') if $F{hm} =~ /[^\d]/;
    &say("個数を設定して下さい",'blackmarket_before') if !$F{hm};
    &say("商品が選択されていません",'blackmarket_before') if !$F{ui};

    $F{hm} = int($F{hm});

を削除

sub blackmarket_after:
    &lock($I->{Pl}{bm});

    &get_item($I);
    &get_item($U,1);

    foreach $Ui (@{$U->{Bg}}) {
        if ($F{ui} eq "$Ui->{id}_$Ui->{gd}") {
            if ($F{dl}) { $Ui->{qn} = 0; last }
            $F{hm} = $Ui->{qn} if $F{hm} > $Ui->{qn};
            $Ui->{Sp} = int(($Ui->{bp} * $set::mtp + $set::mpp) * $I->{Ap}) * $F{hm};

            &say('これ以上は重くて持てません','blackmarket_before') if $I->{bg} + $Ui->{wt} * $F{hm} > $I->{Mbg};
            &say('お金が足りません','blackmarket_before') if $Ui->{Sp} > $I->{gl};

            &change_status($I,'gl',-$Ui->{Sp});
            &change_status($I,'bg',$Ui->{wt} * $F{hm});

            $Ui->{Im} = &item_image($Ui);

            &M("$Ui->{Im}$Ui->{nm}を$F{hm}つ購入しました。");

            $Ii = {%$Ui};

            $Ui->{qn}-= $F{hm};
            $Ii->{qn} = $F{hm};

            push (@{$I->{Bg}},$Ii);

            undef $F{ui};
            last;
        }
    }

#    &say('売り切れです','blackmarket_before') if !$F{ui};

    &sort_item($I);

    &set_item($I);
    &set_item($U,1);
↓
    require "$set::lib_dir/purchase.cgi";

    &lock($I->{Pl}{bm});

    &get_item($I);
    &get_item($U,1);

    if (&purchase_item($U->{Bg},'','Bm')) {
        &sort_item($I);
        &set_item($I);
        &set_item($U,1);
    }

library/buy.cgiを開く

sub buy_before:
        $t1 .= "<input type=checkbox name=$i-$Ui->{id}-$Ui->{sp} class=checkbox> ";
        $t1 .= &decorate_item($Ui);
↓
        $t1 .= qq|<tr>\n<td>\n|;
        $t1 .= qq|<input type=checkbox name=$i-$Ui->{id}-$Ui->{sp} class=checkbox> |;
        if ($set::mif{Xx}) {
            $Ui->{Sp} = $set::uop ? $Ui->{sp} : int($Ui->{sp} / $Ui->{qn});
            $t1 .= &decorate_item($Ui,1);
            $t1 .= qq|</td>\n<td class=r>|;
            $t1 .= qq|<input type=textbox name=t-$i-$Ui->{id}-$Ui->{sp} class=textbox size=5 value=1>|;
        }
        else {
            $Ui->{Sp} = $set::uop ? $Ui->{sp} * $Ui->{qn} : $Ui->{sp};
            $t1 .= &decorate_item($Ui,2);
        }
        $t1 .= qq|</td>\n</tr>\n|;

sub buy_before:
        $t2 .= "<input type=checkbox name=$i-$Up->{id}-$Up->{sp} class=checkbox> ";
        $t2 .= &decorate_item($Up);
↓
        $t2 .= qq|<tr>\n<td>\n|;
        $t2 .= qq|<input type=checkbox name=$i-$Up->{id}-$Up->{sp} class=checkbox> |;
        $t2 .= &decorate_item($Up,1);
        $t2 .= qq|</td>\n</tr>\n|;

sub buy_before:
    &get_code;
↓
    $t1 = <<"    END_OF_HTML" if $t1 && $set::mif{Xx};
    <tr class=first>
    <td colspan=2 class=r>購入個数</td>
    </tr>
    $t1
    END_OF_HTML

    &get_code;
    &get_item($I);

sub buy_before:
    $t1
↓
    <table class=item>
    $t1
    </table>

sub buy_before:
    アイテム総重量：$I->{bg}/$I->{Mbg} $set::wgt<br>
↓
    アイテム総重量：$I->{bg}/$I->{Mbg} $set::wgt<br>
    荷物スロット：$I->{Bs}/$I->{bs}<br>
    パックスキル：$I->{pc}<br>

sub buy_before:
    $t2
↓
    <br>
    <table class=item>
    $t2
    </table>

sub buy_after:
my  $i;
my ($Ii,$Ui,$Ip,$Up,$V);
my  $buyitemflag;
my  $buypetsflag;
↓
my  $M;

sub buy_after:
    &get_item($I);
    &get_item($U);

    &set_code;

    foreach $Ui (@{$U->{Bg}}) {
        $i++;
        $Ui->{sp} ||= $Ui->{bp} * $Ui->{qn} + $set::lip if $U->{Sk}{Vm};
        next if !$F{"$i-$Ui->{id}-$Ui->{sp}"};
        &error('Price Error') if !$Ui->{sp};
        $Ui->{Wt} = $Ui->{wt} * $Ui->{qn};
        $Ui->{Sp} = int($Ui->{sp} * $I->{Ap});
        if (@{$I->{Bg}} >= $I->{bs}) {
            &M("荷物スロットが一杯です。") && last;
        }
        elsif ($Ui->{rs} && $Ui->{rs} ne $I->{id}) {
            &M("$Ui->{nm}は他の人に予\約されています。") && next;
        }
        elsif ($I->{bg} + $Ui->{Wt} > $I->{Mbg}) {
            &M("これ以上は重くて持てません。") && next;
        }
        elsif ($Ui->{Sp} > $I->{gl}) {
            &M("$Ui->{nm}を買うお金がありません。") && next;
        }

        $M .= &beat_price($Ui);

        &change_status($U,'gl',$Ui->{sp});
        &change_status($I,'bg',$Ui->{Wt});
        &change_status($I,'gl',-$Ui->{Sp});
        &change_status($U,'bg',-$Ui->{Wt});

        $Ui->{Im} = &item_image($Ui);

        $M .= "$Ui->{Im}$I->{nm}は$Ui->{nm}を$Ui->{qn}つ、$Ui->{sp} $set::mnyで購入しました。<br>\n";
        &M("$Ui->{Im}$Ui->{nm}を$Ui->{qn}つ購入しました。");

        $Ui->{sp} = '';
        $Ui->{rs} = '';

        $Ii = {%{$Ui}};
        push (@{$I->{Bg}},$Ii);
        $Ui->{qn} = 0;
        $buyitemflag = 1;
    }

    if ($buyitemflag) {
        &sort_item($I);
        &set_item($I);
        &set_item($U) if !$U->{Sk}{Ms}; # Mass Selling
    }

    &get_pet($I);
    &get_pet($U);

    undef $i;

    foreach $Up (@{$U->{Pt}}) {
        $i++;
        next if !$F{"$i-$Up->{id}-$Up->{sp}"};
        &error('Price Error') if !$Up->{sp};
        $Up->{Sp} = int($Up->{sp} * $I->{Ap});
        if ($Up->{rs} && $Up->{rs} ne $I->{id}) {
            &M("$Up->{nm}は他の人に予\約されています。") && next;
        }
        elsif ($I->{px} + $Up->{sl} > $I->{Mpx}) {
            &M("$Up->{nm}のためのスロットが空いていません。") && next;
        }
        elsif ($Up->{Sp} > $I->{gl}) {
            &M("$Up->{nm}を買うお金がありません。") && next;
        }

        $M .= &beat_price($Up);

        &change_status($U,'gl',$Up->{sp});
        &change_status($I,'px',$Up->{sl});
        &change_status($I,'gl',-$Up->{Sp});
        &change_status($U,'px',-$Up->{sl});

        $Up->{Im} = &item_image($Up);

        $M .= "$Up->{Im}$I->{nm}は$Up->{nm}を$Up->{sp} $set::mnyで購入しました。<br>\n";
        &M("$Up->{Im}$Up->{nm}を購入しました。");

        $Up->{sp} = '';
        $Up->{rs} = '';

        $Ip = {%{$Up}};
        push (@{$I->{Pt}},$Ip);
        $Up->{id} = '';
        $buypetsflag = 1;
    }

    if ($buypetsflag) {
        &sort_pet($I);
        &set_pet($I);
        &set_pet($U);
    }
↓
    &set_code;

    require "$set::lib_dir/purchase.cgi";

    &get_item($I);
    &get_item($U);

    if ($M .= &purchase_item($U->{Bg},'','Xx')) {
        &sort_item($I);
        &set_item($I);
        &set_item($U) if !$U->{Sk}{Ms}; # Mass Selling
    }

    &get_pet($I);
    &get_pet($U);

    if ($M .= &purchase_pet($U->{Pt},'','Xx')) {
        &sort_pet($I);
        &set_pet($I);
        &set_pet($U);
    }

# Beat the Price #
sub beat_price {
my  $Si = shift;

    # 値切り #
    if ($I->{Sk}{Bp} && &roll_dice(100 + $I->{Map} - $I->{ap}) <= $set::sBp) {
        $Si->{sp} -= int($Si->{sp} * $set::uBp / 100);
        $Si->{Sp} -= int($Si->{Sp} * $set::uBp / 100);
        &M("$U->{nm}は$Si->{nm}を$set::uBp%引きの$Si->{Sp} $set::mnyにしてくれました。");
        return "$Si->{nm}を$set::uBp%引きにしてあげました。<br>\n";
    }
    return '';
}

を削除

library/purchase.cgiのほうに移動しました

library/farm.cgiを開く

sub farm_before:
        $t1 .= qq|<input type=checkbox name=$Ui->{id} class=checkbox> |;
        $t1 .= &decorate_item($Ui);
↓
        $t1 .= qq|<tr>\n<td>\n|;
        $t1 .= qq|<input type=checkbox name=$Ui->{id}_$Ui->{gd} class=checkbox> |;
        $t1 .= &decorate_item($Ui,2);
        if ($set::mif{Fm}) {
            $t1 .= qq|</td>\n<td class=r>|;
            $t1 .= qq|x <input type=textbox name=t_$Ui->{id}_$Ui->{gd} class=textbox size=5 value=1>|;
        }
        $t1 .= qq|</td>\n</tr>\n|;

sub farm_before:
    foreach $Up (@{$LC{$I->{pl}}}) {
↓
    $t1 = $t1 && $set::mif{Fm} ? qq|<td class=r>購入個数</td>\n</tr>\n$t1| : qq|</tr>\n$t1|;

    $t1 = <<"    END_OF_HTML";
    <tr class=first>
    <td>農場で販売しているアイテム</td>
    $t1
    END_OF_HTML

    foreach $Up (@{$LC{$I->{pl}}}) {

sub farm_before:
        $t2 .= qq|<input type=checkbox name=$Up->{id} class=checkbox> |;
        $t2 .= &decorate_item($Up);
↓
        $t2 .= qq|<tr>\n<td>\n|;
        $t2 .= qq|<input type=checkbox name=$Up->{id}_$Ui->{gd} class=checkbox> |;
        $t2 .= &decorate_item($Up,2);
        if ($set::mif{Fm}) {
            $t2 .= qq|</td>\n<td class=r>|;
            $t2 .= qq|x <input type=textbox name=t_$Up->{id}_$Up->{gd} class=textbox size=5 value=1>|;
        }
        $t2 .= qq|</td>\n</tr>\n|;

sub farm_before:
    &get_code;
↓
    $t2 = $t2 && $set::mif{Fm} ? qq|<td class=r>購入頭数</td>\n</tr>\n$t2| : qq|</tr>\n$t2|;

    $t2 = <<"    END_OF_HTML";
    <tr class=first>
    <td>農場で販売している動物</td>
    $t2
    END_OF_HTML

    &get_code;
    &get_item($I);

sub farm_before:
    <tt>農場で販売しているアイテム</tt><br>
    $t1
↓
    <table class=item>
    $t1
    </table>

sub farm_before:
    <div class=r><tt>アイテム総重量：$I->{bg}/$I->{Mbg} $set::wgt</tt></div>
↓
    <div class=r><tt>
    アイテム総重量：$I->{bg}/$I->{Mbg} $set::wgt<br>
    荷物スロット：$I->{Bs}/$I->{bs}<br>
    パックスキル：$I->{pc}
    </tt></div>

sub farm_before:
    <tt>農場で販売している動物</tt><br>
    $t2
↓
    <table class=item>
    $t2
    </table>

sub farm_after:
my  $Ii;
my  $Ui;
my  $Up;
my  $buyitemflag;
my  $buypetsflag;

を削除

sub farm_after:
    &get_appearance($I);
↓
    &get_appearance($I);

    &get_place($I);

sub farm_after:
    &get_item($I);

    foreach $Ui (@{$IC{$I->{pl}}}) {
        $Ui = $FI{$Ui};
        next if !$F{$Ui->{id}};
#        $Ui->{Sp} = $Ui->{bp} * $Ui->{qn};
        $Ui->{Sp} = int($Ui->{bp} * $Ui->{qn} * $I->{Ap});

        &say('これ以上は重くて持てません','farm_before') if $I->{bg} + $Ui->{wt} * $Ui->{qn} > $I->{Mbg};
        &say('お金が足りません','farm_before') if $Ui->{Sp} > $I->{gl};
        &say("荷物スロットが一杯です",'farm_before') if @{$I->{Bg}} >= $I->{bs};

        &change_status($I,'gl',-$Ui->{Sp});
        &change_status($I,'bg',$Ui->{wt} * $Ui->{qn});

        $Ui->{Im} = &item_image($Ui);

        &M("$Ui->{Im}$Ui->{nm}を$Ui->{qn}つ購入しました。");

        push (@{$I->{Bg}},$Ui);
        $buyitemflag = 1;
    }

    if ($buyitemflag) {
        &sort_item($I);
        &set_item($I);
    }

    &get_pet($I);

    foreach $Up (@{$LC{$I->{pl}}}) {
        $Up = $FL{$Up};
        next if !$F{$Up->{id}};
        $Up->{Sp} = $Up->{bp};

        &say('スロットが空いていません','farm_before') if $I->{px} + $Up->{sl} > $I->{Mpx};
        &say('お金が足りません','farm_before') if $Up->{Sp} > $I->{gl};

        &change_status($I,'gl',-$Up->{Sp});
        &change_status($I,'px',$Up->{sl});

        $Up->{Im} = &item_image($Up);

        &M("$Up->{Im}$Up->{nm}を購入しました。");

        $Up->{up} = $Up->{bt} = time;
        $Up->{pd} = time if $Up->{pd};
        $Up->{ch} = &roll_dice(5) - 1;
        push (@{$I->{Pt}},$Up);
        $buypetsflag = 1;
    }

    if ($buypetsflag) {
        &sort_pet($I);
        &set_pet($I);
    }
↓
    require "$set::lib_dir/purchase.cgi";

    &get_item($I);

    if (&purchase_item($IC{$I->{pl}},\%FI,'Fm')) {
        &sort_item($I);
        &set_item($I);
    }

    &get_pet($I);

    if (&purchase_pet($LC{$I->{pl}},\%FL,'Fm')) {
        &sort_pet($I);
        &set_pet($I);
    }

library/shopping.cgiを開く

sub shopping_before:
        $Ui->{Sp} = $Ui->{bp};
        $t1 .= qq|<input type=radio name=ui class=radio value="$Ui->{id}"> |;
        $t1 .= &decorate_item($Ui);
↓
        $Ui->{Sp} = $Ui->{bp} * $Ui->{qn};
        $t1 .= qq|<tr>\n<td>\n|;
        $t1 .= qq|<input type=checkbox name=$Ui->{id}_$Ui->{gd} class=checkbox> |;
        $t1 .= &decorate_item($Ui,2);
        if ($set::mif{Mk}) {
            $t1 .= qq|</td>\n<td class=r>|;
            $t1 .= qq|x <input type=textbox name=t_$Ui->{id}_$Ui->{gd} class=textbox size=5 value=1>|;
        }
        $t1 .= qq|</td>\n</tr>\n|;

sub shopping_before:
    &get_code;
↓
    $t1 = <<"    END_OF_HTML" if $t1 && $set::mif{Bm};
    <tr class=first>
    <td colspan=2 class=r>購入個数</td>
    </tr>
    $t1
    END_OF_HTML

    &get_code;
    &get_item($I);

sub shopping_before:
    $t1
↓
    <table class=item>
    $t1
    </table>

sub shopping_before:
    個数：<input type=textbox name=hm class=textbox size=2 value="1"><br>

を削除

sub shopping_before:
    アイテム総重量：$I->{bg}/$I->{Mbg} $set::wgt<br>
↓
    アイテム総重量：$I->{bg}/$I->{Mbg} $set::wgt<br>
    荷物スロット：$I->{Bs}/$I->{bs}<br>
    パックスキル：$I->{pc}<br>

sub shopping_after:
my  $Ii;
my  $Ui;

    &say("個数には数値以外使用できません",'shopping_before') if $F{hm} =~ /[^\d]/;
    &say("個数を設定して下さい",'shopping_before') if !$F{hm};
    &say("商品が選択されていません",'shopping_before') if !$F{ui};

    $F{hm} = int($F{hm});

を削除

sub shopping_after:
    foreach $Ui (@{$IC{$I->{pl}}}) {
        $Ui = $FI{$Ui};
        if ($F{ui} eq $Ui->{id}) {
            $Ui->{Sp} = int($Ui->{bp} * $I->{Ap}) * $F{hm};

            &say('これ以上は重くて持てません','shopping_before') if $I->{bg} + $Ui->{wt} * $F{hm} > $I->{Mbg};
            &say('お金が足りません','shopping_before') if $Ui->{Sp} > $I->{gl};

            &change_status($I,'gl',-$Ui->{Sp});
            &change_status($I,'bg',$Ui->{wt} * $F{hm});

            $Ui->{Im} = &item_image($Ui);

            &M("$Ui->{Im}$Ui->{nm}を$F{hm}つ購入しました。");

            # バラで追加
            if (&item_class_check($Ui) ne 'M') {
                $Ui->{qn} = 1;
                for (1..$F{hm}) { push(@{$I->{Bg}},$Ui) }
            }
            # パックで追加
            else {
                $Ui->{qn} = $F{hm};
                push(@{$I->{Bg}},$Ui);
            }
            &say("荷物スロットが一杯です",'shopping_before') if @{$I->{Bg}} > $I->{bs};
            last;
        }
    }

    &sort_item($I);

    &set_item($I);
↓
    require "$set::lib_dir/purchase.cgi";

    if (&purchase_item($IC{$I->{pl}},\%FI,'Mk','shopping_before')) {
        &sort_item($I);
        &set_item($I);
    }

library/bag.cgiを開く

        $t1 .= &decorate_item($Ii);
↓
        if ($set::mif{Xx}) {
            $Ii->{Sp} = $set::uop ? $Ii->{sp} : int($Ii->{sp} / $Ii->{qn});
            $t1 .= &decorate_item($Ii);
        }
        else {
            $Ii->{Sp} = $set::uop ? $Ii->{sp} * $Ii->{qn} : $Ii->{sp};
            $t1 .= &decorate_item($Ii,2);
        }

library/compose.cgiを開く

        $t1 .= &decorate_item($Ii);
↓
        if ($set::mif{Xx}) {
            $Ii->{Sp} = $set::uop ? $Ii->{sp} : int($Ii->{sp} / $Ii->{qn});
            $t1 .= &decorate_item($Ii);
        }
        else {
            $Ii->{Sp} = $set::uop ? $Ii->{sp} * $Ii->{qn} : $Ii->{sp};
            $t1 .= &decorate_item($Ii,2);
        }

library/playerlist.cgiを開く

sub playerlist:
            $t2 .= "x$Ui->{qn}" if $Ui->{qn} > 1;
            push(@T,"$t2=$Ui->{sp}$set::mny");
↓
            $t2  = "[$t2=$Ui->{sp}$set::mny]" if $set::mif{Xx};
            $t2 .= "x$Ui->{qn}" if $Ui->{qn} > 1;
            $t2 .= "=$Ui->{sp}$set::mny" if !$set::mif{Xx};
            push(@T,$t2);

sub sales_information:
        &playerlist_decorate_item($T);
↓
        &playerlist_decorate_item($T);
        $T->{qn} ||= 1;
        $T->{sp} = $set::mif{Xx} && !$set::uop ? int($T->{sp} / $T->{qn}) :
                   !$set::mif{Xx} && $set::uop ? $T->{sp} * $T->{qn} : $T->{sp};

library/price.cgiを開く

sub price_before:
my ($t1,$t2);
↓
my ($t1,$t2,$t3);

    $t3 = $set::uop ? 'ひとつ当たりの' : '';

sub price_before:
            $Ii->{qn} = 1 if $F{fl} eq 'pet';
            $Ii->{Sp} = $Ii->{bp} * $Ii->{qn} + $set::lip;
            $t1 .= qq|<input type=textbox name=$i class=textbox size=5 value="$Ii->{Sp}"> |;
            $t1 .= &decorate_item($Ii);
↓
            if ($set::uop) {
                $Ii->{Sp} = $Ii->{bp} + $set::lip;
                $t1 .= qq|<input type=textbox name=$i class=textbox size=5 value="$Ii->{Sp}"> |;
                $t1 .= &decorate_item($Ii,1);
            }
            else {
                $Ii->{qn} = 1 if $F{fl} eq 'pet';
                $Ii->{Sp} = $Ii->{bp} * $Ii->{qn} + $set::lip;
                $t1 .= qq|<input type=textbox name=$i class=textbox size=5 value="$Ii->{Sp}"> |;
                $t1 .= &decorate_item($Ii,2);
            }

sub price_before:
    <tt>数値を入力して値段を設定して下さい。<br>表\示される値段は最低販売価格</tt><br>
↓
    <tt>数値を入力して$t3値段を設定して下さい。<br>表\示される値段は最低販売価格</tt><br>

sub price_after:
            next if !$F{$i};
↓
            next if !$F{$i};
            $Ii->{Bp} = $set::uop ? $Ii->{bp} : $Ii->{bp} * $Ii->{qn};

sub price_after:
            elsif ($F{$i} < $Ii->{bp} * $Ii->{qn} + $set::lip) {
↓
            elsif ($F{$i} < $Ii->{Bp} + $set::lip) {

library/sell.cgiを開く

sub sell_before:
        $t1 .= &decorate_item($Ii);
↓
        $t1 .= &decorate_item($Ii,2);

sub.cssを開く

/* アイテム */
.item {
  width: 100%;
}
.item .first td {
  padding-bottom: 5px;
  font-size: 11px;
  font-family: monospace;
  color: #005533;
}
.item td {
  margin: 0;
  padding: 0;
  font-size: 12px;
}
.item td.r {
  vertical-align: bottom;
}

を追加

銀行に指定個数取引/銀行自動整理機能追加で追加したものと同じです

【リストへ戻る】

対戦相手の履歴に自分が載っていても時間経過していれば再戦可能にしてみる。

set.cgiを開く

# 戦闘 Fight ######################################### #
$elt = 24;                   # 戦闘相手の履歴にあってもn時間経過していれば戦闘可能にする(yes=時間,no=0)

library/fight.cgiを開く

sub fight_player:
    @Den = grep { $_ eq $I->{id} } @Uen;
↓
    @Den = grep { $_->[0] eq $I->{id} &&
                (!$set::elt || time - $_->[1] < $set::elt * 3600) } map  { [split /:/] } @Uen;

sub fight_player:
    $U->{en} = join(',',$I->{id},@Uen);
↓
    $U->{en} = join(',',"$I->{id}:".time,@Uen);

【リストへ戻る】

農場でもAPPによって販売価格が変動するようにしてみる。

library/farm.cgiを開く

# Sub Farm Before #
↓
require "$set::lib_dir/status.cgi";

# Sub Farm Before #

sub farm_before:
    &dead_check($I,'CLOSE');
↓
    &dead_check($I,'CLOSE');

    &get_appearance($I);

sub farm_after:
    $I = &get_user('I');
↓
    $I = &get_user('I');

    &get_appearance($I);

sub farm_after:
        $Ui->{Sp} = $Ui->{bp} * $Ui->{qn};
↓
        $Ui->{Sp} = int($Ui->{bp} * $Ui->{qn} * $I->{Ap});

【リストへ戻る】

オーブの所持個数と足りないオーブを表示してみる。

library/orb.cgiを開く

sub orb_before:
my ($t1,$t2);
↓
my ($t1,$t2,$t3);

sub orb_before:
    @{$I->{Ob}} = split(//,$I->{ob});
↓
    @{$I->{Ob}} = split(//,$I->{ob});

    $total = @{$I->{Ob}};

sub orb_before:
    &get_code;
↓
    foreach ('a' .. 'l') {
        $t3 .= &orb_image($_) if $I->{ob} !~ s/$_//i;
    }

    $t3 ||= 'なし';

    &get_code;

sub orb_before:
    $t1
    <br>
↓
    $t1
    <br>
    <tt>所持している$set::orb{x}</tt>
    $total/$set::mob<br>
    <tt>不足している$set::orb{x}</tt>
    $t3<br>
    <br>

【リストへ戻る】

防具リストに装備・作成の必要能力値を掲載。

armor.lzh：ダウンロードしてお使いください

【リストへ戻る】

複数オーブトレードを実装してみる。

library/trade.cgiを開く

sub trade_before:
my  $checked;
と
    $checked = ' checked';
と
            $checked = '';
を全て削除

sub trade_before:
            $t1 .= qq|<input type=radio name=Iob class=radio value="$_"$checked> |;
↓
            $t1 .= "<input type=checkbox name=I$_ class=checkbox> ";
            $t1 .= "<input type=text size=2 name=tI$_ class=textbox value=1> ";

sub trade_before:
            $t2 .= qq|<input type=radio name=Uob class=radio value="$_"$checked> |;
↓
            $t2 .= "<input type=checkbox name=U$_ class=checkbox> ";
            $t2 .= "<input type=text size=2 name=tU$_ class=textbox value=1> ";

sub trade_before:
    <tt>それぞれトレードする$set::orb{x}を選択してください。</tt><br>
↓
    <tt>それぞれトレードする$set::orb{x}にチェックを入れ、個数をあわせて$set::okbボタンを押してしてください。</tt><br>

sub trade_after:
sub trade_after {
↓
sub trade_after {
my ($t1,$t2);
my ($Itc,$Utc,$count);

sub trade_after:
    unless ($I->{ob} =~ s/$F{Iob}// || $I->{ob} =~ s/$F{Iob}//i) { &say('トレードに失敗しました','trade_before') }
    else { @{$I->{Ob}} = split(//,$I->{ob}.uc($F{Uob})) }
    &set_orb($I);

    unless ($U->{ob} =~ s/$F{Uob}//) { &say('トレードに失敗しました','trade_before') }
    else { @{$U->{Ob}} = split(//,$U->{ob}.uc($F{Iob})) }
    &set_orb($U);
↓
    foreach ('a' .. 'l') {
        $count = 0;
        while ($F{"I$_"} && $count < $F{"tI$_"}) {
            $I->{ob} =~ s/$_// || $I->{ob} =~ s/$_//i || &say("$U->{nm}に渡す$set::orb{$_}$set::orb{x}が足りません",'trade_before');

            $t1 .= &orb_image($_);
            $U->{ob} .= uc($_);

            $Itc++;
            $count++;
        }

        $count = 0;
        while ($F{"U$_"} && $count < $F{"tU$_"}) {
            $U->{ob} =~ s/$_// || &say("$I->{nm}に渡す$set::orb{$_}$set::orb{x}が足りません",'trade_before');

            $t2 .= &orb_image($_);
            $I->{ob} .= uc($_);

            $Utc++;
            $count++;
        }
    }

    &say("トレードする$set::orb{x}の数が一致しません",'trade_before') if $Itc != $Utc;

    @{$I->{Ob}} = split(//,$I->{ob});
    @{$U->{Ob}} = split(//,$U->{ob});

    &set_orb($I);
    &set_orb($U);

sub trade_after:
    lc $F{Iob};
    lc $F{Uob};

    &set_record("$I->{nm}が$set::orb{$F{Iob}}$set::orb{x}を$U->{nm}の$set::orb{$F{Uob}}$set::orb{x}とトレードしました。");
    &partner('',"$set::orb{x}をトレードしました");
↓
    &set_record("$I->{nm}が$set::orb{x}のトレードに来ました。<br>\n$t1：$I->{nm}の出した$set::orb{x}<br>\n$t2：$U->{nm}の出した$set::orb{x}");
    &partner($U->{w10},"$set::orb{x}をトレードしました。<br>\n$t1：$I->{nm}の出した$set::orb{x}<br>\n$t2：$U->{nm}の出した$set::orb{x}");

【リストへ戻る】

いつもの2倍作成に成功したら獲得経験値も2倍にしてみる。

set.cgiを開く

# 合成 Compose ####################################### #
$dex = 2;                    # ダブルロールに成功したときは獲得経験値をn倍にする

library/compose.cgiを開く

sub compose_after:
        &double_roll($I,$Ui->{dt}) if $Ui->{dt}{cl} =~ /(Fd|Mt)/;
↓
        &double_roll($I,$Ui->{dt}) if $Ui->{dt}{cl} =~ /(Fd|Mt)/;
        $Ui->{ex} = int($Ui->{ex} * $set::dex) if $I->{DB};

sub double_roll:
        $Si->{qn} *= $set::ddu;
↓
        $S->{DB} = 1;

応用でエクセレントロールのときも出来ますね。

【リストへ戻る】

投擲武器での先制攻撃のダメージを減少させてみる。

「投擲武器での先制で相手の装備・スキルがほとんど無視されてしまう」の修正を先に行う必要があります。

library/fight.cgiを開く

sub concrete_battle:
        $ADM += $A->{tc} if $F == 2;
↓
        $ADM += &roll_dice($A->{tc}) if $F == 2;

$A->{tc}のプラス値をランダムに。
ランダムなので投擲武器での先制はかなりムラのあるアクションになります。バランス結構変わるはずなので注意。

【リストへ戻る】

ダンジョンで、荷物袋から「全てをパックする」を選択できるようにしてみる。

library/dungeon.cgiを開く

sub dungeon_bag:
    <option value="pack">パックにする</option>
↓
    <option value="pack_all">全てをパックにする</option>

【リストへ戻る】

フレンドの現在地を地図に表示してみる。

フレンドの現在地を地図に表示します。
自分をフレンド登録しているプレイヤーの地図に自分の現在地を表示するかの設定もできます。

library/main.cgiを開く

sub main:
    <input type=hidden name=x value="$X">
    <input type=hidden name=y value="$Y">
    <input type=hidden name=sx value="$I->{sx}">
↓
    <input type=hidden name=id value="$F{id}">
    <input type=hidden name=ps value="$F{ps}">

library/map.cgiを開く

sub mapを以下に置き換え

# Sub Map #
sub map {
my  $V;
my ($X,$Y,$Z);
my  %V;
my  @FR;

    $I = &get_user('I');

    @FR = split(/,/,$I->{fr});
    shift @FR;

    push(@{$V{$I->{pl}}},[$I->{id},$I->{nm},$I->{sx}]);
    foreach (@FR) {
        ($U->{id},$U->{nm}) = split(/\//);
        next unless -e "$set::Udt_dir/$U->{id}.cgi";
        $U = &get_user('U',$U->{id},'unlocked') or next;
        $Z = (split(/,/,$U->{fr},2))[0];
        push(@{$V{$U->{pl}}},[$U->{id},$U->{nm},$U->{sx}]) if $Z eq 'on' || $Z eq 'only' && grep { (split /\//)[0] eq $U->{id} } @FR;
    }

    &header(CSS=>'map',JavaScript=>'Set,MapProgram,MapInformation,MapData',Body=>' onLoad="SetMap()"');
    print qq|<div id=box class=map style="visibility:hidden"></div>\n|;
    print qq|<span id=map></span>\n|;

    require "$set::dat_dir/place.cgi";
    foreach $V (keys %V) {
        ($X,$Y) = split(/,/,$PL{$V}{lc});
        print qq|<span style="position:absolute;top:$Y;left:$X">|;
        foreach $Z (@{$V{$V}}) {
            print qq|<img src=$set::mim_dir/$Z->[2].gif id="$Z->[0]" onMouseOver="Information(this.id,event,'$Z->[0]/$Z->[1]')" onMouseOut="Information(0)">| if $Z->[2];
        }
        print qq|</span>\n|;
    }
    &footer;
}

library/mail.cgiを開く

sub mail_before:
        ($U->{id},$U->{nm}) = split(/\//);
↓
        next unless /\//;
        ($U->{id},$U->{nm}) = split(/\//);

library/friends.cgiを開く

sub friends_before:
my  $t1;
↓
my ($t1,$t2);
my ($V,$T);
my  @FR;

sub friends_before:
    $I = &get_user('I');
↓
    $I = &get_user('I');

    ($T,@FR) = split(/,/,$I->{fr});

sub friends_before:
    $t1 = "現在は誰もいません。" if !$t1;
↓
    $t1 = "現在は誰もいません。<br>" if !$t1;

    $V = $T eq 'on'   ? ' checked' : '';
    $t2 .= "<input type=radio class=radio name=map value=on$V>全てのプレイヤーに通知<br>";
    $V = $T eq 'only' ? ' checked' : '';
    $t2 .= "<input type=radio class=radio name=map value=only$V>フレンド登録者にのみ通知<br>";
    $V = $T eq 'off'  ? ' checked' : '';
    $t2 .= "<input type=radio class=radio name=map value=off$V>通知しない<br>";

sub friends_before:
    $t1
    <br>
↓
    $t1
    <br>
    現在地通知設定<br>
    <tt>自分をフレンド登録しているプレイヤーの地図に現在地を表\示するかの設定を変更します。</tt><br>
    $t2
    <br>

sub friends_after:
my  $FR;
my  @FR;

    $I = &get_user('I');
    @FR = map  { $_->[0] }
          grep { $F{$_->[1]} }
          map  { [$_,(split(/\//))] } split(/,/,$I->{fr});
↓
my  $FR;
my  @FR;
my  $T;

    $I = &get_user('I');
    ($T,@FR) = split(/,/,$I->{fr});
    @FR = map  { $_->[0] }
          grep { $F{$_->[1]} }
          map  { [$_,(split(/\//))] } @FR;

sub friends_after:
    $I->{fr} = join(',',@FR);
↓
    $T = $F{map} eq 'on'   ? 'on'   :
         $F{map} eq 'only' ? 'only' : 'off';

    $I->{fr} = join(',',$T,@FR);

javascript/MapProgram.jsを開く

function Information:
function Information(index,e) {
↓
function Information(index,e,text) {

function Information:
        target.innerHTML  = msg[index];
↓
        target.innerHTML  = text ? text : msg[index];

function Information:
	        target.innerHTML  = msg[index];
↓
	        target.innerHTML  = text ? text : msg[index];

function Information:
	        target.document.write(msg[index]);
↓
	        target.document.write(text ? text : msg[index]);

【リストへ戻る】

グレードを文字で表示してみる。

グレード2以上のアイテムを「木の板:G2」のように表示します。
色分けされていても分かりにくい時にやってみてください。

library/base.cgiを開く

sub decorate_item:
    $V = $Si->{Nm} ? $Si->{Nm} : $Si->{nm};
↓
    $V = $Si->{Nm} ? $Si->{Nm} : $Si->{nm};
    $V .= ":G$Si->{gd}" if $Si->{gd} > 1;

【リストへ戻る】