|
Server : Apache/2.4.62 System : FreeBSD fbsdweb2.web.rcn.net 14.1-RELEASE FreeBSD 14.1-RELEASE releng/14.1-n267679-10e31f0946d8 GENERIC amd64 User : www ( 80) PHP Version : 8.3.8 Disable Function : NONE Directory : /domains/mandarintools/cgi-bin/ |
Upload File : |
#!/usr/bin/perl -- # -*- perl -*-
require "./cgi-lib.pl";
&ReadParse(*values);
$unival = uc($values{'unival'});
print "Content-type: text/html; charset=utf-8\n\n";
print "<HTML>
<HEAD>
<TITLE>Stroke Animations</TITLE>
</HEAD>
<BODY>
";
#print "$unival";
if ($unival =~ m/^[0-9a-fA-F]{4}(\s[0-9a-eAe]{4})$/) {
@univals = split(/\s/, $unival);
} elsif (vec($unival, 0, 8) > 127 and length($unival) % 3 == 0) {
for ($i = 0; $i < length($unival); $i+=3) {
push @univals, &bytes2hex(&utf82ucs(substr($unival, $i, 3)));
#print "HEX " . &bytes2hex(&utf82ucs(substr($unival, $i, 3)));
}
} elsif ($unival =~ m/\&\#x/) {
(@univals) = ($unival =~ m/\&\#\x([0-9a-fA-F]+);/g);
} elsif ($unival =~ m/\&\#/) {
(@univals) = ($unival =~ m/\&\#(\d+);/g);
foreach $uchar (@univals) {
$uchar = sprintf("\U%x\E", $uchar);
}
}
#print join(" ", @univals);
open(STROKE, "strokedata.txt") or print "Error";
$found = 0;
while ($line = <STROKE>) {
foreach $char (@univals) {
if ($line =~ m/^$char\t(.*)$/i) {
$found++;
$strokes = $1;
$strokes =~ s/[\r\n]*$//;
$strokedata{$char} = $strokes;
}
}
if ($found == scalar(@univals)) { last; }
}
for ($i = 0; $i < scalar(@univals) and $i < 4; $i++) {
$char = $univals[$i];
if ($strokedata{$char} =~ m/^\s*$/) {
$utf8char = &hex2utf8($char);
print "<P>Stroke animation currently not available for the character $utf8char.<P>\n";
} else {
print <<APP;
<applet
ARCHIVE = "StrokePlayer.jar"
CODE = "StrokePlayerApplet.class"
CODEBASE = "http://www.mandarintools.com"
NAME = "Chinese Font Player"
WIDTH = 320
HEIGHT = 360
HSPACE = 0
VSPACE = 0
ALIGN = middle>
<param NAME = " StrokeData" VALUE ="
$strokedata{$char}"
<param NAME = " ScanInterval" VALUE =" 5"><param NAME =" StrokeInterval" VALUE =" 200"><param NAME =" ShowShadow" VALUE =" true"><param NAME =" ShowGrid" VALUE =" mi"><param NAME =" FontWidth" VALUE =" 287"></applet>
APP
}
}
if (defined($values{'link'})) {
print <<ADSENSE;
<br><br>
<script type="text/javascript"><!--
google_ad_client = "pub-1796608980793545";
/* Word Dictionary Front */
google_ad_slot = "0649656970";
google_ad_width = 468;
google_ad_height = 60;
//-->
</script>
<script type="text/javascript"
src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script>
ADSENSE
}
print "</BODY></HTML>";
sub utf82ucs {
my($utfstring) = @_;
my($unichar, $unival, $unistring, $i, $int1, $int2, $int3, $byte1, $byte2, $byte3);
$i = 0;
while ($i < length($utfstring)) {
$byte1 = substr($utfstring, $i, 1);
if (unpack("C", $byte1) <= 0x7F) { # 1 byte long (ASCII)
$unichar = pack("C", 0x00) . $byte1;
$i++;
} elsif ((unpack("C", $byte1) & 0xE0) == 0xC0) { # 2 bytes long
$byte2 = substr($utfstring, $i+1, 1);
$int1 = unpack("C", $byte1) & 0x1F;
$int1 <<= 0x06;
$int2 = unpack("C", $byte2) & 0x3F;
$unival = $int1 | $int2;
$unichar = pack("CC", (0xFF00 & $unival) >> 8, (0x00FF & $unival));
$i += 2;
} else { # 3 bytes long
$byte2 = substr($utfstring, $i+1, 1);
$byte3 = substr($utfstring, $i+2, 1);
$int1 = 0x0F & unpack("C", $byte1);
$int1 <<= 12;
$int2 = 0x3F & unpack("C", $byte2);
$int2 <<= 6;
$int3 = 0x3F & unpack("C", $byte3);
$unival = $int1 | $int2 | $int3;
$unichar = pack("CC", (0xFF00 & $unival) >> 8, (0x00FF & $unival));
$i += 3;
}
$unistring .= $unichar;
}
$unistring;
}
sub bytes2hex {
my($twobytes) = @_;
my $hex1, $hex2, $allhex;
$hex1 = unpack "H2", substr($twobytes, 0, 1);
$hex2 = unpack "H2", substr($twobytes, 1, 1);
$allhex = "\U$hex1$hex2\E";
}
sub hex2utf8 {
my($hexchar) = @_;
#print "$hexchar \n";
if ($hexchar !~ m/^0x/) {
$hexchar = "0x" . $hexchar;
}
$binchar = oct($hexchar);
if ($binchar <= 127) {
$retval = pack("C", $binchar);
} elsif ($binchar <= 2047) {
$bin1 = ($binchar >> 6) | 0xC0;
$bin2 = ($binchar & 0x3F) | 0x80;
$retval = pack("C2", $bin1, $bin2);
} else {
$bin1 = ($binchar >> 12) | 0xE0;
$bin2 = (($binchar & 0x0FFF) >> 6) | 0x80;
$bin3 = ($binchar & 0x003F) | 0x80;
$retval = pack("C*", $bin1, $bin2, $bin3);
# #print "in 3 char version with $hexchar and $retval bin1 $bin1 bin2 $bin2 bin3 $bin3\n";
}
$retval;
}