/[suikacvs]/perl/kanzan/kanzan.cgi
Suika

Contents of /perl/kanzan/kanzan.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations) (download)
Wed Sep 4 09:02:38 2002 UTC (22 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.3: +8 -6 lines
2002-09-04  Wakaba <w@suika.fam.cx>

	* kanzan.cgi:
	- (pod:LISENSE): New section.
	- Don't divide with zero.
	- Don't show default value.

1 #!/usr/local/bin/perl
2
3 use strict;
4 require Suika::CGI;
5
6 my %ex_point1 = ();
7 (
8 kokugo => 54,
9 suugaku => 55,
10 eigo => 57,
11 sekaishi => 53,
12 nihonshi => 0,
13 chiri => 0,
14 butsuri => 54,
15 kagaku => 52,
16 seibutsu => 0,
17 _OBJECT => 57,
18 );
19
20 my %ex_point2 = ();
21 (
22 kokugo => 53,
23 suugaku => 55,
24 eigo => 55,
25 sekaishi => 52,
26 nihonshi => 0,
27 chiri => 0,
28 butsuri => 54,
29 kagaku => 51,
30 seibutsu => 0,
31 _OBJECT => 58,
32 );
33
34 my %ex_haiten1 = ();
35 (
36 kokugo => 80,
37 suugaku => 80,
38 eigo => 80,
39 sekaishi => 40,
40 nihonshi => 0,
41 chiri => 0,
42 butsuri => 40,
43 kagaku => 0,
44 seibutsu => 0,
45 );
46
47 my %ex_haiten2 = ();
48 (
49 kokugo => 0,
50 suugaku => 300,
51 eigo => 150,
52 sekaishi => 0,
53 nihonshi => 0,
54 chiri => 0,
55 butsuri => 150,
56 kagaku => 150,
57 seibutsu => 0,
58 );
59
60
61 sub kanzan (%%%%) {
62 my ($point1, $full1, $point2, $full2) = @_;
63 my (%kanzaned1, %kanzaned2);
64 $$full1{_ALL} = 0;
65 for my $subject (keys %$full1) {
66 next if $subject =~ /^_/;
67 $kanzaned1{$subject} = $$point1{$subject}*$$full1{$subject}/100;
68 $kanzaned1{_ALL} += $kanzaned1{$subject};
69 $$full1{_ALL} += $$full1{$subject};
70 }
71 $kanzaned1{_PERCENT} = $$full1{_ALL}==0?0:100*$kanzaned1{_ALL}/$$full1{_ALL};
72 $$full2{_ALL} = 0;
73 for my $subject (keys %$full2) {
74 next if $subject =~ /^_/;
75 $kanzaned2{$subject} = $$point2{$subject}*$$full2{$subject}/100;
76 $kanzaned2{_ALL} += $kanzaned2{$subject};
77 $$full2{_ALL} += $$full2{$subject};
78 }
79 $kanzaned2{_PERCENT} = $$full2{_ALL}==0?0:100*$kanzaned2{_ALL}/$$full2{_ALL};
80
81 my ($percent, $object_percent);
82 $percent = ($$full1{_ALL}+$$full2{_ALL})==0?0:
83 100*($kanzaned1{_ALL}+$kanzaned2{_ALL})
84 /($$full1{_ALL}+$$full2{_ALL});
85 $object_percent = ($$full1{_ALL}+$$full2{_ALL})==0?0:
86 ($$point1{_OBJECT}*$$full1{_ALL}
87 +$$point2{_OBJECT}*$$full2{_ALL})
88 /($$full1{_ALL}+$$full2{_ALL});
89 ($percent, $object_percent, \%kanzaned1, \%kanzaned2);
90 }
91
92 my (%mypoint1, %mypoint2, %haiten1, %haiten2);
93 if ($Suika::CGI::param{newform} ne 'no') {
94 %mypoint1 = %ex_point1;
95 %mypoint2 = %ex_point2;
96 %haiten1 = %ex_haiten1;
97 %haiten2 = %ex_haiten2;
98 } else {
99 for my $s (keys %Suika::CGI::param) {
100 $mypoint1{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+[^H_])1$/;
101 $mypoint2{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+[^H_])2$/;
102 $mypoint1{'_'.$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)_1$/;
103 $mypoint2{'_'.$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)_2$/;
104 $haiten1{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)H1$/;
105 $haiten2{$1} = $Suika::CGI::param{$s} if $s =~ /^(.+)H2$/;
106 }
107 }
108 my ($percent, $object, $kanzan1, $kanzan2)
109 = kanzan ({%mypoint1} => {%haiten1}, {%mypoint2} => {%haiten2});
110
111 print STDOUT "Content-Type: text/html; charset=euc-jp
112 Content-Style-Type: text/css
113 Content-Language: ja
114
115 ";
116 output_html (\%mypoint1 => \%haiten1 => $kanzan1,
117 \%mypoint2 => \%haiten2 => $kanzan2,
118 percent => $percent, object => $object);
119
120 sub diffmark ($) {
121 my $diff = shift;
122 return '□' if $diff < -4;
123 return '△' if $diff < -2;
124 return '○' if $diff < 0;
125 return '◎';
126 }
127
128 sub output_html (%%%%%) {
129 my ($p1 => $h1 => $k1, $p2 => $h2 => $k2, %misc) = @_;
130 for my $n ($$k1{_PERCENT}, $$k2{_PERCENT}, $misc{percent}, $misc{object}) {
131 $n = int ($n);
132 }
133 $$k1{_DIFF} = $$k1{_PERCENT}-$$p1{_OBJECT};
134 $$k2{_DIFF} = $$k2{_PERCENT}-$$p2{_OBJECT};
135 $misc{_DIFF} = $misc{percent}-$misc{object};
136 $$k1{_DIFFMARK} = diffmark ($$k1{_DIFF});
137 $$k2{_DIFFMARK} = diffmark ($$k2{_DIFF});
138 $misc{_DIFFMARK} = diffmark ($misc{_DIFF});
139 print <<EOH;
140 <!DOCTYPE html PUBLIC "-//W3D//DTD HTML 4.01//EN">
141 <html lang="ja">
142 <head>
143 <title>配点換算</title>
144 <link rev="made" href="mailto:w\@suika.fam.cx">
145 <link rel="contents" href="http://tomikou.net/">
146 <link rel="contents" href="/chuubu/">
147 <style type="text/css">
148 input {width: 3em}
149 </style>
150 </head>
151 <body>
152 <h1>配点換算</h1>
153 <form action="kanzan" method="post" accept-charset="iso-2022-jp, iso-2022-jp-3">
154 <table>
155 <thead>
156 <tr>
157 <th colspan="2">教科</th>
158 <th>国語</th><th>数学</th><th>英語</th>
159 <th>世界史</th><th>日本史</th><th>地理</th>
160 <th>物理</th><th>化学</th><th>生物</th>
161 </tr>
162 </thead>
163 <tbody>
164 <tr>
165 <th rowspan="3">一次</th><th>持ち点</th>
166 <td><input type="text" name="kokugo1" value="$$p1{kokugo}"></td>
167 <td><input type="text" name="suugaku1" value="$$p1{suugaku}"></td>
168 <td><input type="text" name="eigo1" value="$$p1{eigo}"></td>
169 <td><input type="text" name="sekaishi1" value="$$p1{sekaishi}"></td>
170 <td><input type="text" name="nihonshi1" value="$$p1{nihonshi}"></td>
171 <td><input type="text" name="chiri1" value="$$p1{chiri}"></td>
172 <td><input type="text" name="butsuri1" value="$$p1{butsuri}"></td>
173 <td><input type="text" name="kagaku1" value="$$p1{kagaku}"></td>
174 <td><input type="text" name="seibutsu1" value="$$p1{seibutsu}"></td>
175 </tr>
176 <tr>
177 <th>配点</th>
178 <td><input type="text" name="kokugoH1" value="$$h1{kokugo}"></td>
179 <td><input type="text" name="suugakuH1" value="$$h1{suugaku}"></td>
180 <td><input type="text" name="eigoH1" value="$$h1{eigo}"></td>
181 <td><input type="text" name="sekaishiH1" value="$$h1{sekaishi}"></td>
182 <td><input type="text" name="nihonshiH1" value="$$h1{nihonshi}"></td>
183 <td><input type="text" name="chiriH1" value="$$h1{chiri}"></td>
184 <td><input type="text" name="butsuriH1" value="$$h1{butsuri}"></td>
185 <td><input type="text" name="kagakuH1" value="$$h1{kagaku}"></td>
186 <td><input type="text" name="seibutsuH1" value="$$h1{seibutsu}"></td>
187 </tr>
188 <tr>
189 <th>換算点</th>
190 <td>$$k1{kokugo}</td><td>$$k1{suugaku}</td><td>$$k1{eigo}</td>
191 <td>$$k1{sekaishi}</td><td>$$k1{nihonshi}</td><td>$$k1{chiri}</td>
192 <td>$$k1{butsuri}</td><td>$$k1{kagaku}</td><td>$$k1{seibutsu}</td>
193 </tr>
194
195 <tr>
196 <th rowspan="3">二次</th><th>持ち点</th>
197 <td><input type="text" name="kokugo2" value="$$p2{kokugo}"></td>
198 <td><input type="text" name="suugaku2" value="$$p2{suugaku}"></td>
199 <td><input type="text" name="eigo2" value="$$p2{eigo}"></td>
200 <td><input type="text" name="sekaishi2" value="$$p2{sekaishi}"></td>
201 <td><input type="text" name="nihonshi2" value="$$p2{nihonshi}"></td>
202 <td><input type="text" name="chiri2" value="$$p2{chiri}"></td>
203 <td><input type="text" name="butsuri2" value="$$p2{butsuri}"></td>
204 <td><input type="text" name="kagaku2" value="$$p2{kagaku}"></td>
205 <td><input type="text" name="seibutsu2" value="$$p2{seibutsu}"></td>
206 </tr>
207 <tr>
208 <th>配点</th>
209 <td><input type="text" name="kokugoH2" value="$$h2{kokugo}"></td>
210 <td><input type="text" name="suugakuH2" value="$$h2{suugaku}"></td>
211 <td><input type="text" name="eigoH2" value="$$h2{eigo}"></td>
212 <td><input type="text" name="sekaishiH2" value="$$h2{sekaishi}"></td>
213 <td><input type="text" name="nihonshiH2" value="$$h2{nihonshi}"></td>
214 <td><input type="text" name="chiriH2" value="$$h2{chiri}"></td>
215 <td><input type="text" name="butsuriH2" value="$$h2{butsuri}"></td>
216 <td><input type="text" name="kagakuH2" value="$$h2{kagaku}"></td>
217 <td><input type="text" name="seibutsuH2" value="$$h2{seibutsu}"></td>
218 </tr>
219 <tr>
220 <th>換算点</th>
221 <td>$$k2{kokugo}</td><td>$$k2{suugaku}</td><td>$$k2{eigo}</td>
222 <td>$$k2{sekaishi}</td><td>$$k2{nihonshi}</td><td>$$k2{chiri}</td>
223 <td>$$k2{butsuri}</td><td>$$k2{kagaku}</td><td>$$k2{seibutsu}</td>
224 </tr>
225 </tbody>
226 </table>
227
228 <table>
229 <thead>
230 <tr>
231 <th></th><th>得点率</th><th>目標点</th><th colspan="2">差</th>
232 </tr>
233 </thead>
234 <tbody>
235 <tr>
236 <th>一次</th>
237 <td>$$k1{_PERCENT}</td>
238 <td><input type="text" name="OBJECT_1" value="$$p1{_OBJECT}"></td>
239 <td>$$k1{_DIFF}</td>
240 <td>$$k1{_DIFFMARK}</td>
241 </tr>
242 <tr>
243 <th>二次</th>
244 <td>$$k2{_PERCENT}</td>
245 <td><input type="text" name="OBJECT_2" value="$$p2{_OBJECT}"></td>
246 <td>$$k2{_DIFF}</td>
247 <td>$$k2{_DIFFMARK}</td>
248 </tr>
249 <tr>
250 <th>合計</th>
251 <td>$misc{percent}</td>
252 <td>$misc{object}</td>
253 <td>$misc{_DIFF}</td>
254 <td>$misc{_DIFFMARK}</td>
255 </tr>
256 </tbody>
257 </table>
258
259 <p>
260 <input type="hidden" name="newform" value="no">
261 <input type="submit" value="OK">
262 </p>
263 </form>
264
265 <div class="navigation">
266 [<a href="/gate/cvs/perl/kanzan/" xml:lang="en">source</a>]
267 </div>
268 </body>
269 </html>
270 EOH
271 }
272
273 =head1 LICENSE
274
275 Copyright 2001-2002 wakaba E<lt>w@suika.fam.cxE<gt>.
276
277 This program is free software; you can redistribute it and/or modify
278 it under the terms of the GNU General Public License as published by
279 the Free Software Foundation; either version 2 of the License, or
280 (at your option) any later version.
281
282 This program is distributed in the hope that it will be useful,
283 but WITHOUT ANY WARRANTY; without even the implied warranty of
284 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
285 GNU General Public License for more details.
286
287 You should have received a copy of the GNU General Public License
288 along with this program; see the file COPYING. If not, write to
289 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
290 Boston, MA 02111-1307, USA.
291
292 =cut
293
294 1; # $Date: 2002/09/04 08:57:28 $
295 ### kanzan.cgi ends here

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24