&error(0,"「$lastwordletter」から始めてください！") unless ($firstletter eq $lastwordletter);↓
&genten(1,"","「$lastwordletter」から始めてください！","6:$FORM{'word'}") unless ($firstletter eq $lastwordletter);
1点以上減点したい場合は、赤の数字を減点したい点数に変更してください。半角で。
if (length $FORM{'word'}>2*10){&error(0,"規定文字数を超えています。<br>10字以内の言葉にしてね。");}
if (length $FORM{'imi'}>2*20){&error(0,"規定文字数を超えています。<br>20字以内の言葉にしてね。");}
赤の数字のところが上限文字数です。文字数は全角で数えます。
#@pointletters=(); #ここで設定した文字を含むものが得点単語になる。'で囲んで,で区切ることでいくつでも可。 #$specialletterpoint=2; #@pointlettersで設定した文字を含む言葉を回答したときの得点。↓
@pointletters=('赤','青'); #ここで設定した文字を含むものが得点単語になる。'で囲んで,で区切ることでいくつでも可。
$specialletterpoint=2; #@pointlettersで設定した文字を含む言葉を回答したときの得点。
得点単語としたい文字と、そのときの得点を設定します。赤字の部分です。文字はいくつでも増やせます。反対に一つだけでも可。
#foreach (@settei::pointletters){
# if ($FORM{'word'} =~ /$_/ && $getpoint==1){$getpoint=$settei::specialletterpoint;last;}
#}
↓
foreach (@settei::pointletters){
if ($FORM{'word'} =~ /$_/ && $getpoint==1){$getpoint=$settei::specialletterpoint;last;}
}
foreach (@settei::pointletters){
if ($FORM{'yomi'} =~ /$_/ && $getpoint==1){$getpoint=$settei::specialletterpoint;last;}
}
当然、設定ファイルで@pointlettersを設定するときは、ひらがなで。
それから、注意して欲しいのですが、この方法で得点単語を設定する場合、得点単語一覧には表示されませんが、回答ログの方に得点が$specialletterpointの点数が反映されます。（他の特別チャンスやキリ番はプラス得点や倍の得点が回答ログに反映されません。参加者名簿には反映されます。）
つまり、たとえ不適切な回答であっても、2点以上得点されているのが他の方にわかるというわけで・・・
これ、私的には好ましくないのですが、どうなのでしょうね？ そのあたりを考慮にいれて、お使い下さい。
なお、管理用CGI Ver.0.7より、回答ログを削除すると、その回答の点数に応じて名簿から減点します。（これまでは一律に1点減点でした。）
#$special=1 if ($no%100==0); #←*00番をキリ番にする。↓
$special=1 if ($no%100==0); #←*00番をキリ番にする。
my @points = &open_file($settei::pointfile,"得点単語ファイル");
my (%times,%score);
foreach (@points){
chomp;
my @datas = split("\t",$_);
if ($datas[5] && $datas[3]){
$times{"$datas[5]"}++;
$score{"$datas[5]"}+=$datas[2];
}
}
if (%times){
print "<h4>得点単語回答者ランキング</h4>\n";
print "得点は、得点単語で得た得点の合計点です。<br>\n";
print "平均は、得点単語で得た得点の平均（得点÷回数）です。<br>\n";
print "<table border=1 cellspacing=0><tr><th>順位</th><th>お名前</th><th>回数</th><th>得点</th><th>平均</th></tr>\n";
my $i=1;my $k=1;my @p;
foreach (sort {$times{$b}<=>$times{$a} or $score{$b}<=>$score{$a}} keys %times){
($times{"$_"}==$p[0] && $score{"$_"}==$p[1]) || ($i=$k);
print "<tr";
($c_name eq $_) && print " class=\"myranking\"";
my $heikin = (int $score{"$_"}*10/$times{"$_"})/10;
print "><td>$i位</td><td>$_さん</td><td>$times{\"$_\"}回</td><td>$score{\"$_\"}点</td><td>$heikin点</td></tr>\n";
@p = ($times{"$_"},$score{"$_"});
$k++;
}
print "</table>\n";
}
得点単語を誰も答えていない場合は表示されません。
$settei::body ←BODYタグ。設定ファイルで設定しています。 [<a href=\"$settei::home\">HOME</a>] ←戻り先リンク。$setteii::homeは設定ファイルで設定（$homeとして） <center> ←センタリング <hr> ←罫線。スタイルシート外部ファイル（shiritori.css）で定義可 <div class=\"titlestyle\">$title</div> ←$titleはタイトル。スタイルシート外部ファイルでclass="titlestyle"を定義。 <hr> ←罫線。 <br> ←改行罫線を画像にしてもいいですね。<img src="line.gif"><br>なんて感じで。もちろんなくしてもいい。
$time = sprintf("%04d年%01d月%01d日\($week[$wday]\)%02d:%02d",$year+1900,$mon+1,$dy,$hour,$min);
↓
$time = sprintf("%01d月%01d日\%01d時%01d分%01d秒",$mon+1,$dy,$hour,$min,$sec);
これだと、2004年1月30日(土)15:05ではなく、1月30日15時5分10秒のように表されます。
# if ($^T > $kigen && $^T < $end || -e "$settei::piriod_dir" && $^T< $end){
# print "ただいま賞品表\示期間中です。<p>\n";
# print "これまでに$settei::minscore点以上の得点を取っていれば、賞品が表\示されます。<p>\n";
# }
# if ($^T >= $end){print &gettime($end)."を持って、賞品表\示期間も終了しています。\n";}
elsif ($nameflag==0){&entername;} #名前とパスの入力画面
↓if ($nameflag==0){&entername;} #名前とパスの入力画面
print "<table border=1 cellspacing=0 cellpadding=5><tr><td>\n";
if ($cdata[2] < $settei::minscore){
print "<center>$settei::minscore点以上の得点を取っていれば、ここに賞品が表\示されます。<br>\n";
中略
print $settei::omedetou2;
print "</td></tr></table>\n";
}
}
unless (-e "$settei::piriod_dir") {print "ゲームは".&gettime($kigen)."まで、<br>\n";}
print "賞品の表\示期間は".&gettime($end)."までです。<p>\n";
↓
unless (-e "$settei::piriod_dir") {print "ゲームは".&gettime($kigen)."までです。<br>\n";}
#print "賞品の表\示期間は".&gettime($end)."までです。<p>\n";
#print "<OPTION VALUE=\"price_view\">賞品の表\示確認</option>\n";
&tsuika_file("$no\t$FORM{'word'}\t$FORM{'yomi'}\t$FORM{'imi'}\t$FORM{'name'}\t$^T\t$getpoint\n",$settei::wordfile,"しりとり回答記録ファイル");
↓
&tsuika_file("$no\t$FORM{'word'}\t$FORM{'yomi'}\t".&tagok($FORM{'imi'})."\t$FORM{'name'}\t$^T\t$getpoint\n",$settei::wordfile,"しりとり回答記録ファイル");
sub tagok{ #タグを戻す。
my ($comment) =@_;
study $comment;
$comment =~ s/"/"/gi; "を"に変換する。
$comment =~ s/<b>(.*?)<\/b>/<b>$1<\/b>/gi; #<b>タグ（強調）を有効にする。
$comment =~ s/<i>(.*?)<\/i>/<i>$1<\/i>/gi; #<i>タグ（斜体）を有効にする。
$comment =~ s/<s>(.*?)<\/s>/<s>$1<\/s>/gi; #<s>タグ（打ち消し線）を有効にする。
$comment =~ s/<sup>(.*?)<\/sup>/<sup>$1<\/sup>/gi; #<sup>タグ（上付文字）を有効にする。
$comment =~ s/<font(.*?)>(.*?)<\/font>/<font$1>$2<\/font>/gi; #<font>タグ（フォント）を有効にする。
return $comment;
}
sub rev{
my ($word) = @_;
my @new;
(substr($word,-2,2) eq "ー") || push(@new,substr($word,-2,2));
for (my $i=4;;$i+=2){
my $value = substr($word,-1*$i,2);
($value eq "") && last;
push(@new,$value);
}
$word = join("",@new);
return $word;
}
if ($letter eq "ゃ" || $letter eq "ゅ" || $letter eq "ょ"){$letter = substr($word,-4-$ifi,4);}
$letter =~ tr/ぁぃぅぇぉ/あいうえお/;
↓
#if ($letter eq "ゃ" || $letter eq "ゅ" || $letter eq "ょ"){$letter = substr($word,-4-$ifi,4);}
$letter =~ tr/ゃゅょ/やゆよ/;
($lastwordletter) ? (print "「<big>$lastwordletter</big>」で始まる言葉をどうぞ。<br><p>\n") : (print "好きな言葉で初めてくださっていいですよ。<p>\n");↓
($lastwordletter) ? (print "「<big>$lastwordletter</big>」で終わる言葉をどうぞ。<br><p>\n") : (print "好きな言葉で初めてくださっていいですよ。<p>\n");
my $lastwordletter = &lastletter($lastword{"yomi"},$lastword{'no'});
↓
my $lastwordletter = substr($lastword{"yomi"},0,2);
my $firstletter;
(length $lastwordletter==4) ? ($firstletter = substr($FORM{'yomi'},0,4)):($firstletter = substr($FORM{'yomi'},0,2));
if ($lastwordletter){
&error(0,"「$lastwordletter」から始めてください！") unless ($firstletter eq $lastwordletter);
}
↓
my $firstletter = &lastletter($FORM{'yomi'},$no);
#(length $lastwordletter==4) ? ($firstletter = substr($FORM{'yomi'},0,4)):($firstletter = substr($FORM{'yomi'},0,2));
if ($lastwordletter){
&error(0,"「$lastwordletter」で終わってください！") unless ($firstletter eq $lastwordletter);
}
print "<tr><td colspan=\"5\" align=\"center\">○「$list_index[$i]」から始まる得点単語データ○</td></tr>\n";↓
print "<tr><td colspan=\"5\" align=\"center\">○「$list_index[$i]」で終わる得点単語データ○</td></tr>\n";
@list_start = ('','い','う','え','お','か','き','く','け','こ','さ','し','す','せ','そ','た','ち','つ','て','と','な','に','ぬ','ね','の','は','ひ','ふ','へ','ほ','ま','み','む','め','も','や','ゆ','よ','ら','り','る','れ','ろ','わ') ;
@list_end = ('い','う','え','お','か','き','く','け','こ','さ','し','す','せ','そ','た','ち','つ','て','と','な','に','ぬ','ね','の','は','ひ','ふ','へ','ほ','ま','み','む','め','も','や','ゆ','よ','ら','り','る','れ','ろ','わ','黑') ;
↓
@list_start = ('','ぃ','ぅ','ぇ','ぉ','か','き','く','け','こ','さ','し','す','せ','そ','た','ち','つ','て','と','な','に','ぬ','ね','の','は','ひ','ふ','へ','ほ','ま','み','む','め','も','ゃ','ゅ','ょ','ら','り','る','れ','ろ','わ') ;
@list_end = ('ぃ','ぅ','ぇ','ぉ','か','き','く','け','こ','さ','し','す','せ','そ','た','ち','つ','て','と','な','に','ぬ','ね','の','は','ひ','ふ','へ','ほ','ま','み','む','め','も','ゃ','ゅ','ょ','ら','り','る','れ','ろ','わ','黑') ;
my @list_start = ('','か','さ','た','な','は','ま','や','ら','わ') ;
my @list_end = ('か','さ','た','な','は','ま','や','ら','わ','黑') ;
↓
my @list_start = ('','か','さ','た','な','は','ま','ゃ','ら','わ') ;
my @list_end = ('か','さ','た','な','は','ま','ゃ','ら','わ','黑') ;
if ($settei::timelimit && $cdata[5]+$settei::timelimit*60-$^T>0 && $c_name ne $settei::kanri){
print "時間制限がありますので、".&gettime($cdata[5]+$settei::timelimit*60)."を過ぎてから回答してくださいね。<br>\n";
}
sub wordcheck{ #しりとりの回答適合チェック（終わり文字、文字数等）
my ($word,$yomi) = @_;
my ($letter,$ifi);
my @cantval;
($yomi) || push(@cantval,"読みがない");
(length $yomi>2*$settei::kiteiletters) && push(@cantval,"読みの規定文字数超過");
$letter = substr($yomi,-2,2);$ifi=0;
if ($letter eq "ー"){$letter = substr($yomi,-4,2);$ifi = 2;}
if ($letter eq "ゃ" || $letter eq "ゅ" || $letter eq "ょ"){$letter = substr($yomi,-4-$ifi,4);}
(!$settei::nok && $letter =~ /ん$/) && push(@cantval,"「ん」で終了");
($letter eq "ー") && push(@cantval,"終わりが「ー」連続");
($letter eq "っ") && push(@cantval,"終わりが「っ」");
($yomi =~ /\s/) && push(@cantval,"読みの途中にスペースが入っている");
($yomi =~ /[a-zA-Z0-9]/) && push(@cantval,"読みに記号・半角文字が入っている");
for(my $l=0;;$l++){
my $let = substr($yomi,$l*2,2);
($let eq "") && last;
($let ne "ー" && ($let lt "ぁ"|| $let gt "ん")) && push(@cantval,"読みに記号・全角かな以外の文字が入っている");
}
$word =~ s/^「//; $word =~ s/」$//; $word =~ s/。$//;
return @cantval;
}
my (@newdatas,$value,@cantdatas);
for (my $i=0;$i<10;$i++){
($FORM{"word_$i"}) || next;
my @cantval = &wordcheck($FORM{"word_$i"},$FORM{"yomi_$i"});
($FORM{"point_$i"}) || push(@cantval,"点数がない");
(grep($FORM{"word_$i"} eq (split /\t/)[0] || $FORM{"yomi_$i"} eq (split /\t/)[1],@datas)) && push(@cantval,"登録済み");
(grep($FORM{"word_$i"} eq (split /\t/)[1] || $FORM{"yomi_$i"} eq (split /\t/)[2],@worddatas)) && push(@cantval,"既出");
($FORM{"point_$i"} =~ /[^0-9\-]/) && push(@cantval,"ポイント設定が半角数字でない");
my $cantvalue = join(":",@cantval);
$value = "$FORM{\"word_$i\"}\t$FORM{\"yomi_$i\"}\t$FORM{\"point_$i\"}\t0\t".&tagok($FORM{"msg_$i"})."\n";
(@cantval) ? (push(@cantdatas,"$cantvalue\t$value")) :push (@newdatas,$value);
}
(@newdatas) && &tsuika_file(\@newdatas,$settei::pointfile,"得点単語ファイル");
&html_header("得点単語リスト登録");
(@newdatas) && print "<table><tr><td><dl>\n";
foreach (@newdatas){
my @dat = split(/\t/,$_);
print "<dt><li>「<ruby><rb>$dat[0]<rp>（<rt>$dat[1]<rp>）</ruby>」（$dat[2]点）<br>\n";
print "<dd><small>$dat[4]</small><br>\n";
}
(@newdatas) && print "</dl>を登録しました。</td></tr></table><p>\n";
(@cantdatas) && print "次の言葉は登録できませんでした。<table><tr><td><dl>\n";
foreach (@cantdatas){
my @dat = split(/\t/,$_);
print "<dt><li>「<ruby><rb>$dat[1]<rp>（<rt>$dat[2]<rp>）</ruby>」（$dat[3]点）<br>\n";
print "<dd><small>$dat[5]</small><br>\n";
print "登録できなかった理由---";
foreach (split(/:/,$dat[0])){
print "$_,";
}
}
(@cantdatas) && print "</dl></td></tr></table><p>\n";
(!$settei::renzoku_ok && $lastword{'name'} eq $c_name) && print "<small>でも、連続回答は認められていないので、 $lastword{'name'}さんは答えられません。<br>\n他の方が答えるのを待ってください。</small><br>\n";
#if ($c_name eq $dat[0] && &solve_pass($c_pass,$dat[1])){
# $dat[5] -= $d;
# $dat[6] = $^T unless $dat[6];
# $_ = join("\t",@dat);
#}
&html_header("減点です！");
print "<p><FONT SIZE=4><B>$msg</B></FONT><P>\n";
print "$c_nameさん、残念ながら$d点の減点になります。<p>\n";
if ($plus ne "" && $settei::ad_point_ok){print "そして、その単語を前に答えたのは$plusさんなので、<br>$plusさんに1点が追加されます。\n";}
を、↓のようにする。 &html_header("お知らせ");
print "<p><FONT SIZE=4><B>$msg</B></FONT><P>\n";
if ($plus ne "" && $settei::ad_point_ok){print "なお、その単語を前に答えたのは$plusさんなので、<br>$plusさんに1点が追加されます。\n";}
my ($who,$datas)=@_;
my $juni=1;
my $kanridata;
my @tmp1 = my @tmp2 = my @tmp3 = my @namedata = ();
foreach (@$datas) {
if ($settei::kanri eq (split /\t/)[0]){
$kanridata = $_;
$_ = "";
next;
}
push(@tmp1, (split /\t/)[5]);
push(@tmp2, (split /\t/)[4]);
push(@tmp3, (split /\t/)[3]);
}
を↓のようにする。
my ($who,$datas)=@_;
my $juni=1;
my $kanridata;
my @tmp1 = my @tmp2 = my @tmp3 = my @namedata = ();
my @newdata;
foreach (@$datas) {
if ($settei::kanri eq (split /\t/)[0]){
$kanridata = $_;
next;
}
push(@tmp1, (split /\t/)[5]);
push(@tmp2, (split /\t/)[4]);
push(@tmp3, (split /\t/)[3]);
push(@newdata,$_);
}
@$datas = @newdata;