Projekt: Hesla Jednoty bratrské/1999/62h.pl

                                                                             
#!/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/&nbsp;/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 "\t—prava do HTML: Petr HeŠman\n";
print "\tDatum poslednĄ zmˆny: 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];
     }
  }