#!/usr/bin/perl
#6022htm Transformuje text v T602 do HTML - verse 0.15
# \xFE nahrazuje
$WIDTH = 70; # sirka textoveho sloupce
$DEPTH = 30; # hloubka zprava kam se hleda zalomeni radky
$EMPTYL=0; # Empty line (uz byl prazdny radek)
$NOBR=0; # Nebude <BR>
$/ = "\r\n"; # paragraph mode
foreach $filename (@ARGV)
{
open(INFILE, $filename)
|| do
{
print STDERR "Nemuzu otevrit soubor $file: $!\n";
next;
};
}
binmode (INFILE);
print "\n<HTML>\n";
print "<!-- generovano skriptem 62h.pl v. 0.15 -->\n";
print "<HEAD>\n";
print "<TITLE>DŁlos / </TITLE>\n";
print "</HEAD>\n";
print "<BODY>\n";
while (<INFILE>) # pro kazdy paragraph:
{
if (/^@/) { next; } # vyhod ridici radky
s/\x0d//g; # vyhod CR
if (/^$/) # prazdny radek
{
if (!$EMPTYL) # predtim jeste nebyl
{ print "<P>\n"; $NOBR=1; } # udelej paragraf
$EMPTYL = 1;
next;
}
$EMPTYL=0;
s/\xad\x8d\x0a//g; # vyhod hyphen + softCR + LF
s/\x8d\x0a/ /g; # soft CR + LF -> mezera
s/\x8d/ /g; # soft CR -> mezera
s/\0x1a//; # vyhod EOF
s/\xfe/ /g; # tvrde mezery
# s/\x01/ <!-font_Elite-> /g; # Fonty
s/\x01//g; #ignoruj
# s/\x03/ <!-font_Condens-> /g;
s/\x03//g; #ignoruj
s/\x11/ <!-font_UZV1-> /g;
s/\x12/ <!-font_UZV2-> /g;
s/\x15/ <!-font_UZV3-> /g;
s/\x17/ <!-font_UZV4-> /g;
s/\x18/ <!-font_UZV5-> /g;
s/\x19/ <!-font_UZV6-> /g;
s/\x13//g; # podtrzene ignoruj
s/\x14//g; # horni index ignoruj
s/\x16//g; # dolni index ignoruj
s/\#//g;
s/[\xB0-\xDF]+//g; #semigrafika pryc
&pairs('\x02', '<B>', '</B>', 2); # tucne
&pairs('\x04', '<I>', '</I>', 3); # kursiva
# &pairs('\x14', '<!-horni_i->', '<!-/horni_i->', 4);
# &pairs('\x16', '<!-dolni_i->', '<!-/dolni_i->', 5);
&pairs('\x0F', '<H3>', '</H3>', 6); # siroke
&pairs('\x10', '<H2>', '</H2>', 7); # vysoke
&pairs('\x1D', '<H1>', '</H1>', 8); # velke
# &pairs('\x13', '<U>', '</U>', 1); # podtrzene
s/[ \t]+/ /g; # vse na jednu mezeru
s/^ //; # ukousni prvni mezeru
s/ $//; # ukousni posledni mezeru
if (! $NOBR)
{print "\n<BR>";}
$NOBR=0;
while (length > $WIDTH) # formatuj odstavec
{
$tst = ' '.reverse(substr($_, 0, $WIDTH));
($pos = index($tst, ' !')) >= 0 && $pos < $DEPTH ||
($pos = index($tst, ' ?')) >= 0 && $pos < $DEPTH ||
($pos = index($tst, ' .')) >= 0 && $pos < $DEPTH ||
($pos = index($tst, ' ;')) >= 0 && $pos < $DEPTH ||
($pos = index($tst, ' ,')) >= 0 && $pos < $DEPTH ||
($pos = index($tst, ' )')) >= 0 && $pos < $DEPTH ||
($pos = index($tst, ' a ')+2) >= 2 && $pos < 15 ||
($pos = index($tst, ' i ')+2) >= 2 && $pos < 15 ||
($pos = index($tst, ' k ')+2) >= 2 && $pos < 15 ||
($pos = index($tst, ' o ')+2) >= 2 && $pos < 15 ||
($pos = index($tst, ' s ')+2) >= 2 && $pos < 15 ||
($pos = index($tst, ' u ')+2) >= 2 && $pos < 15 ||
($pos = index($tst, ' v ')+2) >= 2 && $pos < 15 ||
($pos = index($tst, ' ', 1)) > 0 ||
($pos = 0) ;
$pos = $WIDTH-$pos;
if ($pos>5) # Naslo se misto na deleni
{
$tmp = substr($_, 0, $pos);
$tmp =~ s/^ +//; # ukousni prvni mezery
$tmp =~ s/ +$//; # ukousni posledni mezery
print "\t", $tmp, "\n";
$_ = substr($_, $pos);
}
else {last;} # jinak uz nedel
}
s/^ +//; # ukousni prvni mezery
s/ +$//; # ukousni posledni mezery
if (length > 1) # vic nez "\n"
{
print "\t", $_;
}
}
print "\n</BODY>\n\n";
print "<ADDRESS>\n";
print "\tAutor textu:\n";
print "\tprava do HTML: Petr HeŠman\n";
print "\tDatum poslednĄ zmny: 1996\n";
print "</ADDRESS>\n";
print "\n</HTML>\n";
if ($flag[2]) { print STDERR "ERROR: lichy pocet 'tucny text' <B> !\n"; }
if ($flag[3]) { print STDERR "ERROR: lichy pocet 'kursiva' <I> !\n"; }
if ($flag[4]) { print STDERR "ERROR: lichy pocet 'horni index' !\n"; }
if ($flag[5]) { print STDERR "ERROR: lichy pocet 'dolni index' !\n"; }
if ($flag[6]) { print STDERR "ERROR: lichy pocet 'siroke pismo' <H3> !\n"; }
if ($flag[7]) { print STDERR "ERROR: lichy pocet 'vysoke pismo' <H2> !\n"; }
if ($flag[8]) { print STDERR "ERROR: lichy pocet 'velke pismo' <H1> !\n"; }
if ($flag[1]) { print STDERR "ERROR: lichy pocet 'podtrzeny text' <U> !\n"; }
# Subroutiny:
sub pairs # Nahrazuje a upravuje pary
{
($x, $html, $htmlend, $i) = @_; # hexa kod, cim nahradit, index
s/$x\s*$x//g; # vyhodi prazdne pary
s/\r\n($x)/$1\r\n/g; # </...> ze zacatku na konec predch. radky
while (/($x)/)
{
if(!$flag[$i]) { $_ = $`."$html".$'; }
else { $_ = $`."$htmlend".$'; }
$flag[$i] = !$flag[$i];
}
}