# Kosmina O. Yaroslav
# http://darviarush.narod.ru

%A = ('tab'=>"\t",'emdash'=>'—','endash'=>'–','emspace'=>' ','enspace'=>' ','qmspace'=>' ','bullet'=>'•','lquote'=>'‘','rquote'=>'’','ldblquote'=>"“",'rdblquote'=>'”','~'=>' ','_'=>'-','par'=>"\n");
%U = (1026=>'€', 1027=>'', 8218=>'‚', 1107=>'ƒ', 8222=>'„', 8230=>'…', 8224=>'†', 8225=>'‡', 8364=>'ˆ', 8240=>'‰', 1033=>'Š', 8249=>'‹', 1034=>'Œ', 1036=>'', 1035=>'Ž', 1039=>'', 1106=>'', 8216=>'‘', 8217=>'’', 8220=>'“', 8221=>'”', 8226=>'•', 8226=>'•', 8482=>'™', 1113=>'š', 8250=>'›', 1114=>'œ', 1116=>'', 1115=>'ž', 1119=>'Ÿ', 160=>' ', 1038=>'¡', 1118=>'¢', 1032=>'£', 164=>'¤', 1168=>'¥', 166=>'¦', 167=>'§', 1025=>'¨', 169=>'©', 1028=>'ª', 172=>'¬', 173=>'­', 174=>'®', 1031=>'¯', 176=>'°', 177=>'±', 1030=>'²', 1110=>'³', 1169=>'´', 181=>'µ', 182=>'¶', 183=>'·', 1105=>'¸', 8470=>'¹', 1108=>'º', 1112=>'¼', 1029=>'½', 1109=>'¾', 1111=>'¿', 1040=>'À', 1041=>'Á', 1042=>'Â', 1043=>'Ã', 1044=>'Ä', 1045=>'Å', 1046=>'Æ', 1047=>'Ç', 1048=>'È', 1049=>'É', 1050=>'Ê', 1051=>'Ë', 1052=>'Ì', 1053=>'Í', 1054=>'Î', 1055=>'Ï', 1056=>'Ð', 1057=>'Ñ', 1058=>'Ò', 1059=>'Ó', 1060=>'Ô', 1061=>'Õ', 1062=>'Ö', 1063=>'×', 1064=>'Ø', 1065=>'Ù', 1066=>'Ú', 1067=>'Û', 1068=>'Ü', 1069=>'Ý', 1070=>'Þ', 1071=>'ß', 1072=>'à', 1073=>'á', 1074=>'â', 1075=>'ã', 1076=>'ä', 1077=>'å', 1078=>'æ', 1079=>'ç', 1080=>'è', 1081=>'é', 1082=>'ê', 1083=>'ë', 1084=>'ì', 1085=>'í', 1086=>'î', 1087=>'ï', 1088=>'ð', 1089=>'ñ', 1090=>'ò', 1091=>'ó', 1092=>'ô', 1093=>'õ', 1094=>'ö', 1095=>'÷', 1096=>'ø', 1097=>'ù', 1098=>'ú', 1099=>'û', 1100=>'ü', 1101=>'ý', 1102=>'þ', 1103=>'ÿ');

sub rtf2txt($$){
local $_, $&, $`, $';

open in, "<", $_[0] or do { print "not open $_[0]\n"; return}; binmode in;
open f, ">", $_[1] or do { print "not create $_[1]\n"; return}; binmode f;

my $pict = $_[1]; $pict =~ s/\.[^\.]+$//;
my $n = 1;
my $size = -s in;
my $proc = 0, $proc1;
my $next = undef;
my $a;

my @X;

$UNDEF = sub {};
$PRINT = sub {print f $_[0]};
$PICT = sub { #print "$proc% ris $n\r";
print f "$n";
open g, ">", "$pict.".($n++).".jpeg"; binmode g;
$X[$#X] = sub{ my $a = $_[0]; $a =~ s/\s+//; $a =~ s/[a-f0-9]{2}/chr hex $&/ge; print g $a; };
&{$X[$#X]}($_[0]);
};

%SUB = ('stylesheet'=>$UNDEF, 'header'=>$UNDEF, 'headerf'=>$UNDEF, 'fonttbl'=>$UNDEF, 'colortbl'=>$UNDEF, 'title'=>$UNDEF, 'author'=>$UNDEF, 'subject'=>$UNDEF, 'info'=>$UNDEF, 
'pict'=>$PICT, 
'revtbl'=>$UNDEF, 'datafield'=>$UNDEF, 'fldinst'=>$UNDEF, 'pntxta'=>$UNDEF, 'pntxtb'=>$UNDEF
);

@X = ($PRINT);
$/ = "\\";

$a = <in>.<in>; if($a =~ /^\{\\rtf(\d+)\\$/){ #print "rtf version $1\n";
} else {print "no rtf. no translate\n"; return;}

#my $N1=1, $N2=0, $F1=1, $F2=0;

while(<in>){
#$proc1 = int(tell(in)*100/$size);
$proc1 = sprintf("%.1f", tell(in)*100/$size);
do { $| = 1; print "$proc1%\r"; $| = undef; $proc = $proc1; } if $proc != $proc1;

if($_ eq "\\"){ last if !@X; &{$X[$#X]}("\\"); $next = undef; next;}

s/\\$//;

if(s/^[\n\-\{\}]//){ $a = $&; }
elsif(s/^\r//){ $a = "\n" }
elsif(s/^'([a-f0-9]{2})//){ $a = chr hex $1 }
elsif(s/^u(\d+)\?//){ $a = exists $U{$1}? $U{$1}:"$1" }
elsif(s/^~//){ $a = " " }
elsif(s/^_//){ $a = "-" }
elsif(s/^\*$/}{/){ $a = undef }
elsif(s/^\*//){ $a = undef }
elsif(s/^([\w\-]+)\s?//){ $a = $A{$1}; if($next){ $X[$#X] = $SUB{$1} if exists $SUB{$1};} }
else { $a = undef }

if( defined $a ){ &{$X[$#X]}($a); }

s/[\n\r]+//;

$next = /\{$/;
#while(/[\{\}]/g){ if($& eq "{"){ $N1++;} else { $N2++;} }

my $x = undef, $ch = undef;
while(/([^\{\}]*)([\{\}])/g){
$ch = $2;
$x = length($');
if($2 eq "{"){ &{$X[$#X]}($1); push @X, ($X[$#X] eq $PICT? $UNDEF : $X[$#X]); }
else { last if !@X; &{pop @X}($1); }
}

last if !@X;
$_ = substr($_,length($_)-$x,$x) if defined $x;
&{$X[$#X]}( $_ );
}

#print "$. {$N1 }$N2 {$F1 }$F2\n";
close in, f;
print "ostalosq figurnyh skobok: ".@X."\n" if @X;
}

$f = $ARGV[0];
$o = $ARGV[1];

if(-d $f){
opendir A, $f or die "xm, not open dir $f\n";
readdir A; readdir A;
@Ax = readdir A;
closedir A;
$dir = $f;
$o = undef;
} else { @Ax = ($f); $dir = undef;}

for $f (@Ax){
print "$f\n";
$f = "$dir/$f" if $dir;
if($o eq ""){ $f =~ /\.[^\.]*$/; $o = "$`.txt"; }

if( -e $o){ print "propuskaem $o\n"; $o = undef; next;}
#print "$f to $o\n";
rtf2txt($f, $o);
$o = undef;
}
