mirror of
git://xwords.git.sourceforge.net/gitroot/xwords/xwords
synced 2024-11-18 10:08:29 +01:00
first checked in. Seems to work on .xwd format but not yet for .pdb.
This commit is contained in:
ehouse
parent
cb8d98a370
commit
ff811344ad
1 changed files with 254 additions and 0 deletions
254
xwords4/dawg/dawg2dict.pl
Executable file
254
xwords4/dawg/dawg2dict.pl
Executable file
|
|
@ -0,0 +1,254 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
# Given a .pdb or .xwd file, print all the words in the DAWG.
|
||||
# Optionally write the values and faces to files whose names are
|
||||
# provided.
|
||||
|
||||
use strict;
|
||||
use Fcntl;
|
||||
|
||||
my $gValueFileName;
|
||||
my $gASCIIFacesFileName;
|
||||
my $gUTFFacesFileName;
|
||||
my $gInFile;
|
||||
my $gFileType;
|
||||
my $gNodeSize;
|
||||
|
||||
sub usage() {
|
||||
print STDERR "USAGE: $0 "
|
||||
. "[-vf valuesFileName] "
|
||||
. "[-fa asciiFacesFileName] "
|
||||
. "[-fu unicodeFacesFileName] "
|
||||
. "xwdORpdb"
|
||||
. "\n";
|
||||
|
||||
}
|
||||
|
||||
sub parseARGV {
|
||||
|
||||
my $arg;
|
||||
while ( my $arg = shift(@ARGV) ) {
|
||||
|
||||
SWITCH: {
|
||||
if ($arg =~ /-vf/) {$gValueFileName = shift(@ARGV), last SWITCH;}
|
||||
if ($arg =~ /-fa/) {$gASCIIFacesFileName = shift(@ARGV);
|
||||
last SWITCH;}
|
||||
if ($arg =~ /-fu/) {$gUTFFacesFileName = shift(@ARGV);
|
||||
last SWITCH;}
|
||||
|
||||
# Get here it must be the final arg, the input file name.
|
||||
$gInFile = $arg;
|
||||
if ( 0 != @ARGV ) {
|
||||
usage();
|
||||
exit 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $gInFile =~ m|.xwd$| ) {
|
||||
$gFileType = "xwd";
|
||||
} elsif ( $gInFile =~ m|.pdb$| ) {
|
||||
$gFileType = "pdb";
|
||||
} else {
|
||||
usage();
|
||||
exit 1;
|
||||
}
|
||||
|
||||
return 1;
|
||||
} # parseARGV
|
||||
|
||||
sub countSpecials($) {
|
||||
my ( $lref ) = @_;
|
||||
my $count = 0;
|
||||
foreach my $val (@$lref) {
|
||||
if ( ord($val) < 32 ) {
|
||||
++$count;
|
||||
}
|
||||
}
|
||||
return $count;
|
||||
} # countSpecials
|
||||
|
||||
sub readFaces($$$) {
|
||||
my ( $fh, $facRef, $nSpecials ) = @_;
|
||||
|
||||
my $buf;
|
||||
my $nRead = sysread( $fh, $buf, 1 );
|
||||
my $nChars = unpack( 'c', $buf );
|
||||
|
||||
my @faces;
|
||||
for ( my $i = 0; $i < $nChars; ++$i ) {
|
||||
my $nRead = sysread( $fh, $buf, 2 );
|
||||
push( @faces, chr(unpack( "n", $buf ) ) );
|
||||
}
|
||||
|
||||
${$nSpecials} = countSpecials( \@faces );
|
||||
@{$facRef} = @faces;
|
||||
return $nChars;
|
||||
} # readFaces
|
||||
|
||||
sub skipBitmaps($) {
|
||||
my ( $fh ) = @_;
|
||||
my $buf;
|
||||
sysread( $fh, $buf, 1 );
|
||||
my $nCols = unpack( 'C', $buf );
|
||||
die "not doing real bitmaps yet" if $nCols;
|
||||
}
|
||||
|
||||
sub getSpecials($$$) {
|
||||
my ( $fh, $nSpecials, $specRef ) = @_;
|
||||
|
||||
my @specials;
|
||||
for ( my $i = 0; $i < $nSpecials; ++$i ) {
|
||||
my $buf;
|
||||
sysread( $fh, $buf, 1 );
|
||||
my $len = unpack( 'C', $buf );
|
||||
sysread( $fh, $buf, $len );
|
||||
push( @specials, $buf );
|
||||
skipBitmaps( $fh );
|
||||
skipBitmaps( $fh );
|
||||
}
|
||||
|
||||
@{$specRef} = @specials;
|
||||
} # getSpecials
|
||||
|
||||
sub prepXWD($$$$) {
|
||||
my ( $fh, $facRef, $nodesRef, $startRef ) = @_;
|
||||
|
||||
my $buf;
|
||||
my $nRead = sysread( $fh, $buf, 2 );
|
||||
my $flags = unpack( "n", $buf );
|
||||
|
||||
if ( $flags == 2 ) {
|
||||
$gNodeSize = 3;
|
||||
} elsif ( $flags == 3 ) {
|
||||
$gNodeSize = 4;
|
||||
} else {
|
||||
die "invalid dict flags";
|
||||
}
|
||||
|
||||
my $nSpecials;
|
||||
my $faceCount = readFaces( $fh, $facRef, \$nSpecials );
|
||||
|
||||
# skip xloc header
|
||||
$nRead = sysread( $fh, $buf, 2 );
|
||||
|
||||
# skip values info.
|
||||
sysread( $fh, $buf, $faceCount * 2 );
|
||||
|
||||
my @specials;
|
||||
getSpecials( $fh, $nSpecials, \@specials );
|
||||
|
||||
sysread( $fh, $buf, 4 );
|
||||
$$startRef = unpack( 'N', $buf );
|
||||
|
||||
my @nodes;
|
||||
my $count = 0;
|
||||
my $offset = 4 - $gNodeSize;
|
||||
do {
|
||||
$nRead = sysread( $fh, $buf, $gNodeSize, $offset );
|
||||
$count += $nRead;
|
||||
my $node = unpack( 'N', $buf );
|
||||
push( @nodes, $node );
|
||||
} while ( $nRead == $gNodeSize );
|
||||
die "out of sync? nRead=$nRead, count=$count" if $nRead != 0;
|
||||
|
||||
@$nodesRef = @nodes;
|
||||
} # prepXWD
|
||||
|
||||
sub parseNode($$$$$) {
|
||||
my ( $node, $chrIndex, $nextEdge, $accepting, $last ) = @_;
|
||||
|
||||
if ( $gNodeSize == 4 ) {
|
||||
$$accepting = ($node & 0x00008000) != 0;
|
||||
$$last = ($node & 0x00004000) != 0;
|
||||
$$chrIndex = ($node & 0x00003f00) >> 8;
|
||||
$$nextEdge = ($node >> 16) + (($node & 0x000000FF) << 16);
|
||||
} elsif( $gNodeSize == 3 ) {
|
||||
$$accepting = ($node & 0x00000080) != 0;
|
||||
$$last = ($node & 0x00000040) != 0;
|
||||
$$chrIndex = $node & 0x0000001f;
|
||||
$$nextEdge = ($node >> 8) + (($node & 0x00000020) << 11);
|
||||
}
|
||||
|
||||
# printf "%x: acpt=$$accepting; last=$$last; "
|
||||
# . "next=$$nextEdge; ci=$$chrIndex\n", $node;
|
||||
} # parseNode
|
||||
|
||||
sub printStr($$) {
|
||||
my ( $strRef, $accepted ) = @_;
|
||||
|
||||
if ( $accepted ) {
|
||||
print join( "", @$strRef ), "\n";
|
||||
# } else {
|
||||
# print "partial: ", join( "", @$strRef ), "\n";
|
||||
}
|
||||
} # printStr
|
||||
|
||||
|
||||
# Given an array of 4-byte nodes, a start index. and another array of
|
||||
# two-byte faces, print out all of the words in the nodes array.
|
||||
|
||||
sub printDAWGInternal($$$$) {
|
||||
my ( $str, $arrRef, $start, $facesRef ) = @_;
|
||||
|
||||
for ( ; ; ) {
|
||||
my $node = $$arrRef[$start++];
|
||||
my $nextEdge;
|
||||
my $chrIndex;
|
||||
my $accepting;
|
||||
my $lastEdge;
|
||||
|
||||
parseNode( $node, \$chrIndex, \$nextEdge, \$accepting, \$lastEdge );
|
||||
|
||||
die "index $chrIndex out of range" if $chrIndex > 26 || $chrIndex < 0;
|
||||
push( @$str, $$facesRef[$chrIndex] );
|
||||
printStr( $str, $accepting );
|
||||
|
||||
if ( $nextEdge != 0 ) {
|
||||
printDAWGInternal( $str, $arrRef, $nextEdge, $facesRef );
|
||||
}
|
||||
|
||||
pop( @$str );
|
||||
|
||||
# print "2. lastEdge=$lastEdge\n";
|
||||
if ( $lastEdge ) {
|
||||
last;
|
||||
}
|
||||
}
|
||||
} # printDAWGInternal
|
||||
|
||||
sub printDAWG($$$) {
|
||||
my ( $arrRef, $start, $facesRef ) = @_;
|
||||
|
||||
my @str;
|
||||
printDAWGInternal( \@str, $arrRef, $start, $facesRef );
|
||||
}
|
||||
|
||||
|
||||
#################################################################
|
||||
# main
|
||||
#################################################################
|
||||
|
||||
|
||||
if ( !parseARGV() ) {
|
||||
usage();
|
||||
exit 1;
|
||||
}
|
||||
|
||||
sysopen(INFILE, "$gInFile", O_RDONLY) or die "couldn't open: $!\n";;
|
||||
binmode INFILE;
|
||||
|
||||
my @faces;
|
||||
my @nodes;
|
||||
my $startIndex;
|
||||
|
||||
if ( $gFileType eq "xwd" ){
|
||||
prepXWD( *INFILE, \@faces, \@nodes, \$startIndex );
|
||||
} elsif ( $gFileType eq "pdb" ) {
|
||||
die "not doing .pdbs yet";
|
||||
}
|
||||
|
||||
close INFILE;
|
||||
|
||||
printDAWG( \@nodes, $startIndex, \@faces );
|
||||
Loading…
Reference in a new issue