PETROOM大改造
【萌え萌えキャラクターズと遊ぼー。】

ちさ様専用:クリア順表示の改造

クリア順に表示する改造、さっそくやっつけてしまいましょう。
ユーザーデータの改造は、必要ありません。
すでに用意されているクリア用の目印$asbclを流用します。

あとはペットデータに変数を一つ追加して、
クリア順表示用に、ユーザーデータの読み込みの所を改造します。

以降、説明に使用しているのは、「遊ぼー。」Ver.A02の最終版ですので、
多少違うところがあるかもしれませんが、ちささんなら大丈夫ですよね、きっと。

では、まず、ペットデータに変数を追加するところから。
下記の所に下記のように追記します、3ヶ所です。

# ------------------------- #
# Sub New Pet
# 新規ペット登場
# ------------------------- #
sub newpet {
    $deadname = $petname;
    $petname = $FORM{'petname'};
#   if ($petname eq "")                          { &error("名前をつけてください"); }
#   if ($petname eq $deadname && $samename == 0) { &error("前と同じ名前はつけられません"); }
    if ( $FORM{'sex'} == 1 )                     { $sex = 'おんな'; }  else { $sex = 'おとこ'; }
    $godfather = $FORM{'name'};
    $name = $FORM{'name'};
    $birth     = time;
    $dead      = 0;
    $lastfeed  = time;
    $lastplay  = time;
    $good      = 100;
    $bad       = 0;
    $out       = 0;
    $out_ame   = 0;
    $outdate   = 0;
    $num++;
    $finoshokuji = '???';
    $finosanpo ='???';
    $osanponame = '???';
    $osanpolove = 0;
    $clrcnt    = 0;
    &openoutpetdata;
#   $gdate = time - $dayhour[$playtime + 1];
#   @new = "$FORM{'name'}<>$FORM{'pass'}<>$gdate<>3<>\n";
#   &openoutuserdata;
    &petform;
}




# ------------------------- #
# Sub Open In Pet Data
# ペットデータの読みこみ
# ------------------------- #
sub openinpetdata {
    &lock;
#   &lockpet;
    open(IN,"$petdata") || &error("Can't open $petdata");
    $line = <IN>;
    close(IN);
    ($petname,$godfather,$birth,$sex,$dead,$lastfeed,$lastplay,$lastvisit,$good,$bad,$out,$outdate,$num,$finoshokuji,$finosanpo,$finvisit,$osanponame,$osanpolove,$out_ame,$clrcnt) = split(/<>/,$line);
}

# ------------------------- #
# Sub Open Out Pet Data
# ペットデータの更新
# ------------------------- #
sub openoutpetdata {
    $lastvisit = time;
    $finvisit = "$nameさん";
    $linec = "$petname<>$godfather<>$birth<>$sex<>$dead<>$lastfeed<>$lastplay<>$lastvisit<>$good<>$bad<>$out<>$outdate<>$num<>$finoshokuji<>$finosanpo<>$finvisit<>$osanponame<>$osanpolove<>$out_ame<>$clrcnt";
    open(OUT,">$petdata") || &error("Can't write $petdata");
    print OUT $linec;
    close(OUT);
}

この新しい変数$clrcntには、現在何人クリアしているか、数字を入れていくことになります。

では次に、クリアしたときの処理について。
現在、誰かがクリアしたときは、
$asbclに1を入れていると思いますが、
それを、こんな感じに置き換えてください。

#   $asbcl = 1;
    if ($asbcl == 0) {
        $clrcnt++;
        $asbcl = $clrcnt;
    }

if文はとりあえず置いといて。
まず、誰かがクリアしたら、$clrcntをプラス1します。
初期値に0を入れる予定ですので、一番最初にクリアした人は、1となります。
それを、$asbclに代入します、順位がそのまま入ることになります。
で、if文ですが、同じ人が繰り返しクリアしたときに順位が更新されてしまわないようにする対策です。
これを入れておかないと、1番でクリアした人が、また後でクリアしたときに、
その時の順位で上書きされてしまい、1番でなくなってしまいます。

では、ユーザーデータの読み込み(sub openinuserdata)の所を改造しましょう。
とりあえず、下記のように追記して下さい。

# ------------------------- #
# Sub Open In User Data
# ユーザーデータの読みこみ
# ------------------------- #
sub openinuserdata {
    open(IN,"$userdata") || &error("Can't open $userdata");
    @lines = <IN>;
    close(IN);

    foreach $lineu (@lines) {
        ($name,$pass,$gdate,$love,$asbcl,$lastcom,$combo,$me_cnt,$rme_cnt,$de_cnt,$lastlove,$clrtime,$kusucnt,$hanacnt,$tutucnt,$tokkun1cnt,$tokkun2cnt,$ov200,$dummy7,$dummy8,$dummy9) = split(/<>/,$lineu);

        if ($_[0] eq 'checkname') {
            if ($FORM{'name'} eq $name) {
                $flag = 1; # データの中にユーザーを確認
                if ($FORM{'pass'} ne $pass)
                    { &error("パスワードが間違っています"); }
                last;
            }
        }
        elsif ($_[0] eq 'action') {
            if ($FORM{'name'} eq $name) {
                $gdate = time;
                push(@new,"$FORM{'name'}<>$FORM{'pass'}<>$gdate<>$newlove<>$newasbcl<>$newlastcom<>$newcombo<>$newme_cnt<>$newrme_cnt<>$newde_cnt<>$newlastlove<>$newclrtime<>$newkusucnt<>$newhanacnt<>$newtutucnt<>$newtokkun1cnt<>$newtokkun2cnt<>$newov200<>$newdummy7<>$newdummy8<>$newdummy9<>\n");
            } else {
                if ($gdate >= $goodbye) { push(@new,$lineu); }
            }
        }
        elsif ($_[0] eq 'ownerlist') {
            if ($asbcl != 0) {
                @clrlist[$clrnum] ="$asbcl<>$name";
                $clrnum++;
            }

             if ($love >= $lpkininaru) {
                @sukilist[$sukinum] = "$love<>$name<>$lastcom<>$lastlove";
                $sukinum++;
                if ($FORM{'name'} eq $name) {
                    $ownername = $name;
                    $ownerrank = "<FONT color=deeppink><B>好きな人ですっ♪</B></FONT>";
                    $ownerlove = $love;
                    $ownerimage = 'kt007.gif';
                }
                if ($bestlove < $love) {
                    $bestlove = $love;
                }
            }
            elsif ($love >= $lptomodati) {
                @kininarulist[$kininarunum] = "$love<>$name<>$lastcom<>$lastlove";
                $kininarunum++;
                if ($FORM{'name'} eq $name) {
                    $ownername = $name;
                    $ownerrank = "<FONT color=orangered><B>気になる人ですっ。</B></FONT>";
                    $ownerlove = $love;
                    $ownerimage = 'kt005.gif';
                }
            }
            elsif ($love >= $lpsiriai) {
                @tomodatilist[$tomodatinum] = "$love<>$name<>$lastcom<>$lastlove";
                $tomodatinum++;
                if ($FORM{'name'} eq $name) {
                    $ownername = $name;
                    $ownerrank = "<FONT color=orangered><B>お友達です。</B></FONT>";
                    $ownerlove = $love;
                    $ownerimage = 'kt006.gif';
                }
            }
            elsif ($love >= $lpkirai) {
                @siriailist[$siriainum] = "$love<>$name<>$lastcom<>$lastlove";
                $siriainum++;
                if ($FORM{'name'} eq $name) {
                    $ownername = $name;
                    $ownerrank = "<FONT color=teal><B>お知り合い人です。</B></FONT>";
                    $ownerlove = $love;
                    $ownerimage = 'kt003.gif';
                }
            }
            else {
                @kirailist[$kirainum] = "$love<>$name<>$lastcom<>$lastlove";
                $kirainum++;
                if ($FORM{'name'} eq $name) {
                    $ownername = $name;
                    $ownerrank = "<FONT color=blue><B>嫌いな人です…。</B></FONT>";
                    $ownerlove = $love;
                    $ownerimage = 'kt001.gif';
                }
            }
        }
    }
    if ($_[0] eq 'ownerlist') {
        &unlock;
#        &unlockuser;

        &user_sort(@clrlist);
        @clrlist = @newtxt;

        &user_sort_r(@kirailist);
        @kirailist = @newtxt;

        &user_sort_r(@siriailist);
        @siriailist = @newtxt;

        &user_sort_r(@tomodatilist);
        @tomodatilist = @newtxt;

        &user_sort_r(@kininarulist);
        @kininarulist = @newtxt;

        &user_sort_r(@sukilist);
        @sukilist = @newtxt;

        @alllist = @sukilist;
        push(@alllist,@kininarulist,@tomodatilist,@siriailist,@kirailist);

        foreach $sukicnt (@sukilist) {
            ($love,$name,$lastcom,$lastlove) = split(/<>/,$sukicnt);
            if ($love >= $bestlove) {
                @itibanlist[$itibannum] = "$sukicnt";
                $itibannum++;
            }
        }

        $ownercnt = 1;
        foreach $allcnt (@alllist) {
            ($love,$name,$lastcom,$lastlove) = split(/<>/,$allcnt);
            if ($FORM{'name'} eq $name) {
                last;
            }
            $ownercnt++;
        }
    }
}

# ------------------------- #
# Sub User Sort
# ユーザーソート
# ------------------------- #
sub user_sort {
    local(@txt) = @_;
    @newtxt = sort by_number @txt;
}

sub by_number {
    $a <=> $b;
}

# ------------------------- #
# Sub User Sort
# ユーザーソート
# ------------------------- #
sub user_sort_r {
    local(@txt) = @_;
    @newtxt = sort by_reverse_number @txt;
}

sub by_reverse_number {
    if ($a == $b) {
        $a cmp $b;
    }
    else {
        $b <=> $a;
    }
}

上のブロックから説明しますと、

1つ目は、$asbclが0じゃない人、
つまりクリアして何らかの順位が付けられている人がいたら、
その人の順位と名前を抜き出して、新しいリストを作っていきます。

2つ目で、順位を基準にして、その新しいリストをソートします。
これで、リストの中身は、上からクリアした順に並び替わります。

3つ目は、そのソートをするプログラムです。

あとは、ランキング表示でこの新しいリストを表示するだけです。

# ------------------------- #
# Sub Owner List
# 飼い主ランキング
# ------------------------- #
sub ownerlist {
#   &unlockpet;
    &header;
    &title;
    $bestlove = $clrnum = $sukinum = $kininarunum = $tomodatinum = $siriainum = $kirainum = $itibannum = 0;
#   &lockuser;
    &openinuserdata('ownerlist');

    &bodytop('琴音ちゃんの中であなたは…。');
    &tabletop;

    print "$font2<B>一番好きな人</B></font><br>";
    print "<DIV align=right><TABLE border=0 cellpadding=0 cellspacing=0 width=280>\n";
    if ($itibannum == 0) { print "<TR><TD>いません</TD></TR>"; }
    else {
        foreach $owner (@itibanlist) {
            ($love,$name,$lastcom,$lastlove) = split(/<>/,$owner);
            if ($name eq $ownername) {
                print "<TR><TD><FONT color=orangered><B>$name</B></FONT>さんですっ<FONT color=pink face=symbol>ゥ</FONT></TD></TR>\n";
            }
            else {
                print "<TR><TD>$nameさんですっ<FONT color=pink face=symbol>ゥ</FONT></TD></TR>\n";
            }
        }
    }
    print "</TABLE></DIV>\n";
    print "<br><br>\n";

    print "$font2<B>好きな人</B></font><br>";
    print "<DIV align=right><TABLE border=0 cellpadding=0 cellspacing=0 width=280>\n";
    if ($sukinum == 0) { print "<TR><TD>いません</TD></TR>"; }
    else {
        foreach $owner (@sukilist) {
            ($love,$name,$lastcom,$lastlove) = split(/<>/,$owner);
            &lastlovecheck;
            if ($name eq $ownername) {
                print "<TR><TD>$displove<FONT color=orangered><B>$name</B></FONT>さんっ♪</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
            else {
                print "<TR><TD>$displove$nameさんっ♪</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
        }
    }
    print "</TABLE></DIV>\n";
    print "<br><br>\n";

    print "$font2<B>気になる人</B></font><br>";
    print "<DIV align=right><TABLE border=0 cellpadding=0 cellspacing=0 width=280>\n";
    if ($kininarunum == 0) { print "<TR><TD>いません</TD></TR>"; }
    else {
        foreach $owner (@kininarulist) {
            ($love,$name,$lastcom,$lastlove) = split(/<>/,$owner);
            &lastlovecheck;
            if ($name eq $ownername) {
                print "<TR><TD>$displove<FONT color=orangered><B>$name</B></FONT>さん♪</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
            else {
                print "<TR><TD>$displove$nameさん♪</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
        }
    }
    print "</TABLE></DIV>\n";
    print "<br><br>\n";

    print "$font2<B>お友達</B></font><br>";
    print "<DIV align=right><TABLE border=0 cellpadding=0 cellspacing=0 width=280>\n";
    if ($tomodatinum == 0) { print "<TR><TD>いません</TD></TR>"; }
    else {
        foreach $owner (@tomodatilist) {
            ($love,$name,$lastcom,$lastlove) = split(/<>/,$owner);
            &lastlovecheck;
            if ($name eq $ownername) {
                print "<TR><TD>$displove<FONT color=orangered><B>$name</B></FONT>さん</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
            else {
                print "<TR><TD>$displove$nameさん</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
        }
    }
    print "</TABLE></DIV>\n";
    print "<br><br>\n";

    print "$font2<B>お知り合い</B></font><br>";
    print "<DIV align=right><TABLE border=0 cellpadding=0 cellspacing=0 width=280>\n";
    if ($siriainum == 0) { print "<TR><TD>いません</TD></TR>"; }
    else {
        foreach $owner (@siriailist) {
            ($love,$name,$lastcom,$lastlove) = split(/<>/,$owner);
            &lastlovecheck;
            if ($name eq $ownername) {
                print "<TR><TD>$displove<FONT color=orangered><B>$name</B></FONT>さん</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
            else {
                print "<TR><TD>$displove$nameさん</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
        }
    }
    print "</TABLE></DIV>\n";
    print "<br><br>\n";

    print "$font2<B>嫌いな人</B></font><br>";
    print "<DIV align=right><TABLE border=0 cellpadding=0 cellspacing=0 width=280>\n";
    if ($kirainum == 0) { print "<TR><TD>いません</TD></TR>"; }
    else {
        foreach $owner (@kirailist) {
            ($love,$name,$lastcom,$lastlove) = split(/<>/,$owner);
            &lastlovecheck;
            if ($name eq $ownername) {
                print "<TR><TD>$displove<FONT color=orangered><B>$name</B></FONT>さん</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
            else {
                print "<TR><TD>$displove$nameさん</TD><TD align=center>・‥…‥・</TD><TD align=right><SMALL>$lastcom</SMALL></TD></TR>\n";
            }
        }
    }
    print "</TABLE></DIV>\n";
    print "<br><br>\n";

    print "$font2<B>クリアした方々</B></font><br>";
    print "<DIV align=right><TABLE border=0 cellpadding=0 cellspacing=0 width=280>\n";
    if ($clrnum == 0) { print "<TR><TD>いません</TD></TR>"; }
    else {
        foreach $owner (@clrlist) {
            ($asbcl,$name) = split(/<>/,$owner);
            if ($name eq $ownername) {
                print "<TR><TD>$asbcl番</TD><TD> </TD><TD><FONT color=orangered><B>$name</B></FONT>さん</TD><TD align=right></TD></TR>\n";
            }
            else {
                print "<TR><TD>$asbcl番</TD><TD> </TD><TD>$nameさん</TD><TD align=right></TD></TR>\n";
            }
        }
    }
    print "</TABLE></DIV>\n";
    print "<br>\n";

    &tablebottom;
    &bodybottom;
    &footer;
}

# ------------------------- #
# Sub Owner Disp
# 飼い主個人情報
# ------------------------- #
sub ownerdisp {
#   &unlockpet;
    &header;
    $bestlove = $clrnum = $sukinum = $kininarunum = $tomodatinum = $siriainum = $kirainum = $itibannum = 0;
#   &lockuser;
    &openinuserdata('ownerlist');

    &bodytop('琴音ちゃんにとってあなたは…。');
    &tabletop;

個人情報の方の$clrnumのクリアは、使用していないので、なくても問題ないですが、一応。
で、大きなブロックの所ですが、テーブルによるレイアウトは現状に合わせて変えてください。
$asbclに順位、$nameにその人の名前が代入されます。

では、あとは確認なんですが、
もしスクリプトのどこかで、「$asbcl == 1」という条件式を使っている場所がありましたら、
$asbcl != 0」に変更しておいて下さい。
今度からは、クリアしても1が入るとは限らなくなりますので、「0じゃない」という条件にしましょう。

最後に、このスクリプトをアップするときに、
ペットデータ(pet.dat)を一度DLして、一番最後に「<>0」を追加して、
スクリプトと一緒にアップしてください。

んと、こんな感じで分かりましたでしょうか???(^^;;;