1
0
mirror of https://github.com/KanjiVG/kanjivg.git synced 2026-04-22 13:30:42 +02:00

Remove old Perl scripts

This commit is contained in:
Ben Bullock
2021-04-18 12:00:19 +09:00
parent 1eaef89b17
commit f373bd688f
5 changed files with 0 additions and 373 deletions

View File

@@ -1,54 +0,0 @@
package KanjiVG;
use parent Exporter;
our @EXPORT_OK = qw/handle_element/;
use warnings;
use strict;
use Carp;
my $dir = "$FindBin::Bin/kanjivg";
sub find_element
{
my ($element) = @_;
if (! defined $element) {
croak "No element";
}
my $string = qr/kanjivg:element="$element"/;
my @files = <$dir/*.svg>;
my @matches;
for my $file (@files) {
open my $in, "<:encoding(utf8)", $file
or die $!;
while (<$in>) {
if (/$string/) {
push @matches, $file;
# print "$file matches.\n";
}
}
close $in or die $!;
}
return @matches;
}
sub handle_element
{
my ($element, $handle_start, $data) = @_;
my @matches = find_element ($element);
if (ref $data ne 'HASH') {
croak "Give me a hash ref";
}
my $parser = XML::Parser->new (
Handlers => {
Start => sub { &{$handle_start} ($element, $data, @_)},
},
);
for my $file (@matches) {
# print "Parsing '$file'.\n";
$data->{file} = $file;
$parser->parsefile ($file);
}
}
1;

View File

@@ -1,155 +0,0 @@
#!/home/ben/software/install/bin/perl
use warnings;
use strict;
use XML::Parser;
use FindBin;
use Image::SVG::Path 'extract_path_info';
use utf8;
my $dir = "$FindBin::Bin/kanjivg";
# The grep only allows the "normal" files from the complete list of
# files.
my @files = grep /\/[0-9a-f]+\.svg$/, <$dir/*.svg>;
my %stroke_types;
my %global;
my %angles;
# List of errors which are known to come from bad information about
# stroke types.
my @known_bad_elements = qw/冬 羽 尽 辛 手 羊 冫 半/;
my %known_bad_elements = map {$_ => 1} @known_bad_elements;
#print keys %known_bad_elements;
$global{known_bad_elements} = \%known_bad_elements;
my $parser = XML::Parser->new (
Handlers => {
Start => sub { &{handle_start} (\%global, @_) },
},
);
# This doesn't let us use current_line.
#$global{parser} = $parser;
for my $file (@files) {
#for my $file (qw!kanjivg/087bd.svg!) {
$global{file} = $file;
$global{bad_element} = undef;
$parser->parsefile ($file);
}
#for my $t (sort keys %stroke_types) {
# print "$t\n";
#}
my %average;
for my $t (sort keys %angles) {
if ($t eq 'None') {
next;
}
my $total_angle = 0;
my $n = 0;
for my $se (@{$angles{$t}}) {
my ($start, $end) = @$se;
my $angle = atan2 ($end->[1] - $start->[1], $end->[0] - $start->[0]);
$total_angle += $angle;
$n++;
}
$average{$t} = $total_angle / $n;
# The following line prints out the "type" field and the average angle
# in radians.
# print "$t $average{$t}\n";
}
my $limit = 1.0;
for my $t (sort keys %angles) {
if ($t eq 'None') {
next;
}
for my $se (@{$angles{$t}}) {
my ($start, $end, $location) = @$se;
my $angle = atan2 ($end->[1] - $start->[1], $end->[0] - $start->[0]);
if ($angle - $average{$t} > $limit) {
print $location, "more than $limit radian from average.\n"
}
}
}
exit;
sub handle_start
{
my ($global_ref, $parser, $element, %attr) = @_;
if ($global_ref->{bad_element}) {
return;
}
# Use the expat parser so we can use current_line.
$global_ref->{parser} = $parser;
if ($element eq 'path') {
gather_path_info ($global_ref, \%attr);
}
elsif ($element eq 'g') {
if ($attr{id} =~ /^([0-9a-f]+)$/) {
$global_ref->{kanji_id} = $attr{id};
}
my $el = $attr{"kanjivg:element"};
# print "element $el\n";
if (defined $el) {
if ($global_ref->{known_bad_elements}->{$el}) {
# print "Known bad element $el in $global_ref->{file}.\n";
$global_ref->{bad_element} = 1;
}
}
}
}
# Get the location for warning messages.
sub location
{
my ($global) = @_;
my $l = '';
$l .= $global->{file};
$l .= ":";
$l .= $global->{parser}->current_line ();
$l .= ": ";
return $l;
}
sub gather_path_info
{
my ($global_ref, $attr_ref) = @_;
my $type = $attr_ref->{'kanjivg:type'};
if (! $type) {
warn location ($global_ref), "no type.\n";
return;
}
$type =~ s/([^[:ascii:]])/"{" . sprintf ("%X", ord $1) . "}"/ge;
$stroke_types{$type}++;
my $d = $attr_ref->{d};
if (! $d) {
warn location ($global_ref), "no path.\n";
return;
}
my @info = extract_path_info ($d, {absolute => 1, no_shortcuts => 1});
my $start = $info[0]->{point};
my $end = $info[-1]->{end};
if (! $start || ! $end) {
warn location ($global_ref), "parse failed for '$d': no start/end";
return;
}
push @{$angles{$type}}, [$start, $end, location ($global_ref)];
}

View File

@@ -1,75 +0,0 @@
#!/home/ben/software/install/bin/perl
use warnings;
use strict;
use FindBin;
use XML::Parser;
use Image::SVG::Path 'extract_path_info';
use utf8;
use KanjiVG qw/handle_element/;
binmode STDOUT, "utf8";
my %data;
my $element = '豕';
my $start;
my $count;
handle_element ($element, \& handle_start, \%data);
sub handle_ie
{
my ($data, $count, $attr) = @_;
my $d = $attr->{d};
if ($count == 1 || $count == 2) {
my @values = extract_path_info ($d, {
no_shortcuts => 1,
absolute => 1,
});
my @start = @{$values[0]->{point}};
my @end = @{$values[-1]->{end}};
my $x_diff = $end[0] - $start[0];
my $y_diff = $end[1] - $start[1];
$data->{"line$count"} = [$x_diff, $y_diff];
my $f = $data->{file};
$f =~ s!.*/!!;
if ($count == 1 && ($x_diff < 10 || $y_diff > 0)) {
# print "$f: $count: $x_diff $y_diff\n";
}
elsif ($count == 2) {
print "$f: $count: $x_diff $y_diff\n";
}
}
if ($count == 2) {
# print $data->{line1}->[0]->[0];
}
}
sub handle_start
{
my ($kanjivg_element, $data, $parser, $xml_element, %attr) = @_;
if ($xml_element eq 'g') {
my $kvg = $attr{'kanjivg:element'};
if ($kvg) {
if ($kvg eq $kanjivg_element) {
my $kp = $attr{"kanjivg:part"};
if (defined $kp) {
# print "$kp\n";
if ($kp == 2) {
return;
}
}
# print "Found '$kvg' in '$data->{file}'\n";
$start = 1;
$count = 0;
}
}
else {
$start = undef;
$count = 0;
}
}
elsif ($start && $xml_element eq 'path') {
$count++;
handle_ie ($data, $count, \%attr);
}
}

View File

@@ -1,30 +0,0 @@
#!/home/ben/software/install/bin/perl
use warnings;
use strict;
use FindBin;
use XML::Parser;
use Image::SVG::Path 'extract_path_info';
use utf8;
use KanjiVG qw/find_element/;
binmode STDOUT, "utf8";
my %data;
my $element = '氵';
sub handle_start
{
my ($data, $count, $d) = @_;
if ($count == 3) {
my @values = extract_path_info ($d, {
no_shortcuts => 1,
absolute => 1,
});
my @start = @{$values[0]->{point}};
my @end = @{$values[-1]->{end}};
my $x_diff = $end[0] - $start[0];
my $y_diff = $end[1] - $start[1];
# if ($x_diff < 0 || $y_diff > 0) {
printf ("file $global{file}: %d %d\n", $x_diff, $y_diff);
# }
}
}

View File

@@ -1,59 +0,0 @@
#!/home/ben/software/install/bin/perl
use warnings;
use strict;
use FindBin;
use XML::Parser;
use Image::SVG::Path 'extract_path_info';
use utf8;
use KanjiVG qw/handle_element/;
binmode STDOUT, "utf8";
my %data;
my $element = '氵';
my $start;
my $count;
handle_element ($element, \& handle_start, \%data);
sub handle_sanzui
{
my ($data, $count, $attr) = @_;
if ($count == 3) {
my $d = $attr->{d};
my @values = extract_path_info ($d, {
no_shortcuts => 1,
absolute => 1,
});
my @start = @{$values[0]->{point}};
my @end = @{$values[-1]->{end}};
my $x_diff = $end[0] - $start[0];
my $y_diff = $end[1] - $start[1];
# if ($x_diff < 0 || $y_diff > 0) {
printf ("file $data->{file}: %d %d\n", $x_diff, $y_diff);
# }
}
}
sub handle_start
{
my ($kanjivg_element, $data, $parser, $xml_element, %attr) = @_;
if ($xml_element eq 'g') {
my $kvg = $attr{'kanjivg:element'};
if ($kvg) {
if ($kvg eq $kanjivg_element) {
# print "Found '$kvg' in '$data->{file}'\n";
$start = 1;
$count = 0;
}
}
else {
$start = undef;
$count = 0;
}
}
elsif ($start && $xml_element eq 'path') {
$count++;
handle_sanzui ($data, $count, \%attr);
}
}