#!/usr/bin/perl

########################################################################
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or    #
# (at your option) any later version.                                  #
#                                                                      #
# This program is distributed in the hope that it will be useful,      #
# but WITHOUT ANY WARRANTY; without even the implied warranty of       #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         #
# GNU General Public License for more details at http://www.gnu.org    #
########################################################################


use constant VERZE => '2.0';   #verze programu
use constant MIN_VYSKA => 10;  #minimalni vyska titulku v pixelech,
			       #pouziva se pro svazani diakritiky s pismeny pri
			       #nacitani pixelovych radku pro 1 txt radek titulku
use constant BOD => '#';       #textova reprezentace viditelneho pixelu v titulku
use constant MEZERA => ' ';    #textova reprezentace prazdneho pixelu v titulku
use constant STIN => '.';      #textova reprezentace "neaktivniho" pixelu v titulku
use constant MAX_DIAKR => 3;   #maximalni vertikalni vzdalenost hacku,carek,tecek 
			       #od pismene v prazdnych pixelech
			       #plati i pro dvojtecku,strednik,vykricnik,otaznik !!!
			       #pokud chybi diaktirika, tak zvetsit, kdyz je moc
			       #spojenych znaku, tak zkusit snizit
use constant MIN_MEZERA => 6;  #minimalni sirka mezery mezi slovy v pixelech - POZOR
			       #na kurzivu!!!
use constant MAX_PRES => 4;    #maximalni prekryv sousednich znaku pri kurzive v pixelech
			       #vyuziva se pro zachovani diakritiky nad u,y,U,Y,N
use constant RADEK_TERM => 80; #sirka radku terminalu ve znacich pro vypis titulku

#use diagnostics;

use locale; #je to nutne?
use Getopt::Std;

&getopts( "hvo:c:d:g:e:l:s:w:rp:b:a:mq" );

#volby programu:
#-h        help
#-v        version
#-o nazev  output - moznost zadat nazev vystupniho souboru SRT titulku
#-c cislo  character - minimalni vyska textu v pixelech - prebije MIN_VYSKA
#-d cislo  distance - maximalni vertikalni vzdalenost diakritiky a tecek od znaku
#-g cislo  gap - minimalni sirka mezery mezi slovy v pixelech
#-e cislo  over - maximalni prekryv sousednich znaku pri kurzive v pixelech
#-l nazev  load - nacteni OCR databaze pred zapocetim rozpoznavani
#-s nazev  save - ulozeni OCR databaze po ukonceni rozpoznavani
#-w cislo  width - sirka okna terminalu ve znacich - aby byl vypis na 1 radek
#-r        recognized - vytiskne navic presnou podobu rozpoznaneho znaku
#-p znak   point - jak bude v textu reprezentovan viditelny pixel
#-b znak   blank - jak bude v textu reprezentovan volny pixel
#-a znak   shadow - jak bude v textu reprezentovan "neaktivni" pixel
#-m        multiplicity - neprovadet test na spojene znaky = urychleni rozpoznavani
#-q        quiet - tichy rezim, kdy se nic nevypisuje - pro GUI  ! TO DO !

#===============================================================================
#                 HLAVNI PROGRAM
#===============================================================================

%ocr_databaze = ();

#def %ocr_databaze - uchovava vzory rozpoznanych znaku; hash pouziva jako klice
#		     cislo tvorene sumou cisel ziskanych prevodem jednotlivych
#		     bit-vektoru rozpoznaneho znaku po 8mi bitech na decimalni cislo 0-255

if ( $opt_c ) { $min_pixel_vyska = $opt_c; }
  else { $min_pixel_vyska = MIN_VYSKA; }

if ( $opt_d ) { $max_pixel_vzdalenost_diakr = $opt_d; }
  else { $max_pixel_vzdalenost_diakr = MAX_DIAKR; }

if ( $opt_g ) { $min_sirka_mezery = $opt_g; }
  else { $min_sirka_mezery = MIN_MEZERA; }

if ( $opt_e ) { $max_prekryv = $opt_r; }
  else { $max_prekryv = MAX_PRES; }

if ( $opt_w ) { $sirka_radku_terminalu = $opt_w; }
  else { $sirka_radku_terminalu = RADEK_TERM; }

$bod = BOD;
if ( $opt_p and substr($opt_p,0,1) !~ /[%>]/ ) { $bod = substr($opt_p,0,1); }

$mezera = MEZERA;
if ( $opt_b and substr($opt_p,0,1) !~ /[%>]/ ) { $mezera = substr($opt_b,0,1); }

$stin = STIN;
if ( $opt_a and substr($opt_p,0,1) !~ /[%>]/ ) { $stin = substr($opt_a,0,1); }

if ( $opt_l ) { &nacti_ocr_databazi; }

if ( $opt_h ) { &napoveda; }
elsif ( $opt_v ) { &verze; }
elsif ( not $ARGV[0] ) { 
    die "Nebyl zadan zadny .srtx soubor ke zpracovani, viz pgm2srt -h\n"; }
else {

    &prochazej_srtx_soubor_titulku;    

if ( $opt_s ) { &uloz_ocr_databazi; }

}
#-------------------------------------------------------------------------------



#===============================================================================
#                 PODPROGRAMY
#===============================================================================


#===============================================================================
sub prochazej_srtx_soubor_titulku {


    open( ZDROJ_SRTX, "$ARGV[0]" ) or die ("Nemohu otevrit soubor \'$ARGV[0]\'!\n");

    if ( $opt_o ) {
	open( NOVY_SRT, ">$opt_o") or die ("Nemohu zalozit soubor \'$opt_o\'!\n");
    } else {
	open( NOVY_SRT, ">$ARGV[0].new") or die ("Nemohu zalozit soubor \'$ARGV[0].new\'!\n");
    }

    while ( $srtx_radek = <ZDROJ_SRTX> ) {

	chomp($srtx_radek);
	if ($srtx_radek) {

	    unless ( $srtx_radek =~ /^\s*\d+\s*$/ ) {
		close (ZDROJ_SRTX);
		close (NOVY_SRT);
		die ("Vstupni soubor nema format SRT titulku!!!\n");
	    }
	    
	    $srtx_titulek_cislo = $srtx_radek;

	    chomp($srtx_radek = <ZDROJ_SRTX>);
	    if ( index($srtx_radek,'-->')<0 ) {
		close (ZDROJ_SRTX);
		close (NOVY_SRT);
		die ("Vstupni soubor nema format SRT titulku!!!\n");
	    }

	    $srtx_titulek_casovani = $srtx_radek;

	    chomp($srtx_radek = <ZDROJ_SRTX>);
	    if ( index($srtx_radek,'pgm')<0 ) {
		close (ZDROJ_SRTX);
		close (NOVY_SRT);
		die ("Vstupni soubor nema definovan zdroj PGM titulku!!!\n");
	    }
	
#def $pgm_soubor - obsahuje jmeno PGM souboru s titulky - postupne nacitano z .srtx

	    ( $pgm_soubor ) = $srtx_radek =~ /^(.*\.pgm)/;

	    &vlastnosti_obrazku;
#	    &vypis_vlastnosti_obrazku;
	    &zpracuj_titulek;

	    print NOVY_SRT "$srtx_titulek_cislo\n";
	    print NOVY_SRT "$srtx_titulek_casovani\n";
	    
	    @text_titulku = split(/\|/,$txt_radek);

	    foreach $txt_radek ( @text_titulku ) {
	    
		print NOVY_SRT "$txt_radek\n";
	    
	    }

	    print NOVY_SRT "\n";

	}

    }

    close(ZDROJ_SRTX);
    close(NOVY_SRT);

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  jmeno PGM souboru s titulky v $pgm_soubor
#vystup: napleni globalnich promennych $sirka,$vyska,$delka_hlavicky
sub vlastnosti_obrazku {
    my ( @hlavicka );

    open( PGM_ZDROJ, $pgm_soubor ) or die ("Nemohu otevrit soubor \'$pgm_soubor\'!\n");

    for ( $i=1 ; $i <= 3 ; $i++) {
	
	$hlavicka[$i] = <PGM_ZDROJ>;
    
    }

    close(PGM_ZDROJ);

#def: @hlavicka - pole s hlavickou PGM obrazku - na 3.radku je sirka a vyska
#def: $sirka - sirka obrazku s titulky v pixelech
#def: $vyska - vyska obrazku s titulky v pixelech

    $delka_hlavicky = length($hlavicka[1].$hlavicka[2].$hlavicka[3])+4;
    ( $sirka, $vyska ) = $hlavicka[3] =~ /(\d+)\s(\d+)/;

}
#-------------------------------------------------------------------------------


#===============================================================================
sub vypis_vlastnosti_obrazku {

    print "PGM soubor:$pgm_soubor, $sirka x $vyska hlavicka: $delka_hlavicky bajtu\n";

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  
#vystup: 
sub zpracuj_titulek {
    my ( $record );

#def $pixel_vyska - vyska jednoho txt radku titulku v pixelech
#def $pixel_radek_index - pozice zpracovavaneho pixel-radku v PGM titulku
#def @pixel_radek_ok - pole obsahujici retezce prevedenych pixel-radku na text


    open( PGM_ZDROJ, $pgm_soubor) or die ("Nemohu otevrit soubor \'$pgm_soubor\'!\n");

    print "Zpracovavam titulky \'$pgm_soubor\'\n";

# pro ladici ucely - do souboru NOVY se vypisuji pixel PGM prevedene na txt
# znaky a na konec se pripoji OCR databaze [rozpoznany znak;bit-vektory znaku]
#
#    open( NOVY, ">$pgm_soubor.new") or die ("Nemohu zalozit soubor \'$pgm_soubor.new\'!\n");

    read( PGM_ZDROJ, $record, $delka_hlavicky ); #posun v PGM souboru za hlavicku
    undef $record;

    $pixel_radek_index = 0;

    $txt_radek = "";

    do {

	@pixel_radek_ok = ();
	&nacti_cely_radek_titulku;

	$max_posun_dolu = 0;

	&analyzuj_znaky_na_radku if $pixel_vyska>=$min_pixel_vyska;
#	print "$txt_radek\n";

	$txt_radek .= "|"; #oddelovac jednotlivych txt radku titulku v jednom PGM souboru

# tisk txt reprezentace PGM titulku pro jeden rozpozneny radek textu
#
#	if ( $pixel_vyska >= $min_pixel_vyska ) {
#	
#	    foreach $zaznam (@pixel_radek_ok) {
#    		print NOVY "$zaznam\n"; 
#	    }
#	    
#	    print NOVY "$txt_radek\n";
#	    print NOVY "\n";
#	    undef $zaznam;
#
#	}
	
    } while ( $pixel_radek_index < $vyska );
    
    close(PGM_ZDROJ);

#    close(NOVY);

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  musi byt otevren obrazek s titulkem jako PGM_ZDROJ a nactena hlavicka PGM
#vystup: vytvori pole retezcu, kde kazdy retezec je jeden prevedeny pixel-radek
#        z jednoho textoveho radku titulku v PGM obrazku
sub nacti_cely_radek_titulku {
    my ( $pixel_radek );
    
#def $pixel_radek - jeden pixel radek prevedeny na retezec/text

    $pixel_vyska = 0;

    do {
	
	$pixel_radek = &cti_pixel_radek_titulku;
	if ( (index($pixel_radek,$bod) >= 0) or ($pixel_vyska>0 and $pixel_vyska<$min_pixel_vyska) ) {
	    $pixel_radek_ok[$pixel_vyska]=$pixel_radek;
	    $pixel_vyska++;
	}
	$pixel_radek_index++;
#	print "pixel_radek_index:$pixel_radek_index\n";
    
    } until ( ((index($pixel_radek,$bod) < 0) and ($pixel_vyska>$min_pixel_vyska)) or $pixel_radek_index>=$vyska );

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  musi byt otevren obrazek s titulkem jako PGM_ZDROJ a nastavena spravna
#        pozice pro cteni ze souboru (za hlavickou PGM souboru)
#vystup: retezec obsahujici prevedeny pixel-radek jednoho textoveho radku titulku
sub cti_pixel_radek_titulku {
    my ( $record, $prevedeno );    
    
#def $record - obsahuje nacteny pixel-radek z obrazku titulku
#def $prevedeno - je do nej prevaden pixel-radek na text

	read( PGM_ZDROJ, $record, $sirka );
        $prevedeno = "";
	
        for ( $i = 0; $i < $sirka ; $i++ ) {
	
	if ( ord(substr($record,$i,1)) > 0  ) { $prevedeno.=$mezera; }
    	  else
	    { $prevedeno.=$bod; }

	}

    return $prevedeno;
}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  potrebuje pole @pixel_radek_ok naplnene pixel radky titulku
#vystup: 
sub analyzuj_znaky_na_radku {


    &pixel_sloupce_radku_textu_na_retezce;

    $ocr_sloupec = $left_pixel;

    while ( $ocr_sloupec < $right_pixel ) {

	$txt_radek .= &exact_match_ocr;
	
    }

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  potrebuje pole @pixel_radek_ok naplnene pixel-radky titulku
#vystup: naplni pole @pixel_sloupec_ok obsahujici bitove vektory pixel-sloupcu radku textu
sub pixel_sloupce_radku_textu_na_retezce {
    my ( $p_s_sub, $p_r_sub );
    my ( $pixel_sloupec ) = "";

#def $p_s_sub - pixel-sloupec v radku txt titulku (pro pohyb v poli @pixel_radek_ok
#def $p_r_sub - pixel-radek v radku txt titulku (pro pohyb v poli @pixel_radek_ok
#def $left_pixel - prvni pixel textu v obrazku titulku (vlevo)
#def $right_pixel - posledni pixel textu v obrazku titulku (vpravo)
#def $pixel_sloupec - obsahuje bitovou reprezentaci pixel-slupce jednoho
#		      txt radku titulku; jde o bitovy vektor!!!
#def $pixel_sloupec_ok - pole tvorene bitovymi vektory $pixel_sloupec

    $left_pixel = $sirka;
    $right_pixel = 0;

    for ( $i=0; $i<=$pixel_vyska; $i++ ) {
    
	if ( (index($pixel_radek_ok[$i], $bod) < $left_pixel) and (index($pixel_radek_ok[$i], $bod) >= 0) ) {
	    $left_pixel = index($pixel_radek_ok[$i], $bod);
	}

	if ( rindex($pixel_radek_ok[$i], $bod) > $right_pixel ) {
	    $right_pixel = rindex($pixel_radek_ok[$i], $bod);
	}

    }

    for ( $p_s_sub = $left_pixel; $p_s_sub <= $right_pixel; $p_s_sub++ ) {

	for ( $p_r_sub = $pixel_vyska-1; $p_r_sub >= 0 ; $p_r_sub-- ) {
    
	    $pixel_sloupec .= substr($pixel_radek_ok[$p_r_sub], $p_s_sub, 1);

	}
    
	$pixel_sloupec_ok[$p_s_sub] = $pixel_sloupec;

	$pixel_sloupec="";
    
    }

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  potrebuje pole @pixel_sloupec_ok obsahujici bitove vektory pixel-sloupcu
#vystup: vraci rozpoznany znak a vytvari hash jiz rozpoznanych znaku
sub exact_match_ocr {
    my ( $pocet_prazdnych_sloupcu ) = 0;
    my ( $i );
    
    @txt_sada_pixel_sloupcu = ();    
    $rozpoznano = "";

    if ( index($pixel_sloupec_ok[$ocr_sloupec],$bod) < 0 ) {
    
# ++++++++++++ rozliseni mezery mezi pismeny od mezery mezi slovy ++++++++++++
	
	do {
	
	    $pocet_prazdnych_sloupcu++;
	    $ocr_sloupec++;
	    
	} while ( index($pixel_sloupec_ok[$ocr_sloupec],$bod) < 0 );
	
	if ( $pocet_prazdnych_sloupcu >= $min_sirka_mezery ) {
	
	    $rozpoznano = " ";
	}
	    
    } else {
    
# ++++++++++++ rozpoznani znaku ++++++++++++++

	if ( $ocr_sloupec > $left_pixel ) {
    
	    $pravy_sl = $pixel_sloupec_ok[$ocr_sloupec];
	    $levy_sl = &uprav_pixel_sloupec($pixel_sloupec_ok[$ocr_sloupec-1], $pravy_sl);

# 	++++++++++ zde se vraci a hleda zacatek znaku ++++++++++

	    $posun_zpet = 1;

	    while ( (index($levy_sl,$bod) >= 0) and ($ocr_sloupec-1 > $left_pixel) ) {
	
		last if $posun_zpet > $max_prekryv;

		$ocr_sloupec--;
		$posun_zpet++;
		$pravy_sl = $levy_sl;
		$levy_sl = &uprav_pixel_sloupec($pixel_sloupec_ok[$ocr_sloupec-1], $pravy_sl, 1);

	    }

	} else {
    
	    $pravy_sl = $pixel_sloupec_ok[$ocr_sloupec];
    
	}


	$levy_sl = $pravy_sl;
	$pravy_sl = &uprav_pixel_sloupec($pixel_sloupec_ok[$ocr_sloupec+1], $levy_sl);

# 	++++++++++ postupuje vpred a hleda konec znaku ++++++++++++++

	while ( index($pravy_sl,$bod) >= 0 and $ocr_sloupec+1 < $right_pixel ) {

	    push(@txt_sada_pixel_sloupcu, $levy_sl);
	    $ocr_sloupec++;
	    $levy_sl = $pravy_sl;
	    $pravy_sl = &uprav_pixel_sloupec($pixel_sloupec_ok[$ocr_sloupec+1], $levy_sl);
	
	}
    
	push(@txt_sada_pixel_sloupcu, $levy_sl);

# 	+++++++++++ kontrola zda uz neni na poslednim znaku na radku +++++++++++

	if ( $ocr_sloupec+1 == $right_pixel ) {
    
	    if ( index($pravy_sl,$bod) >= 0 ) {
	    
		push(@txt_sada_pixel_sloupcu, $pravy_sl);
	    
	    }
	    $ocr_sloupec++;

	}

	$pixel_sirka_znaku = @txt_sada_pixel_sloupcu;

	if ( $pixel_sirka_znaku > 2*$max_prekryv )  { 
	
	
#	    ++++++++ kvuli diakritice nad y,u,Y,U,N - doplneni stredni +++++++++
#	    ++++++++ casti rozpoznaneho znaku oproti uprave pixel sloupcu ++++++
	    for ( $i = $max_prekryv; $i < $pixel_sirka_znaku - $max_prekryv; $i++ ) {
		$txt_sada_pixel_sloupcu[$i] = $pixel_sloupec_ok[$ocr_sloupec-$pixel_sirka_znaku+$i+1];
	    }

#	    ++++++++ znovu projde okraje znaku napr. kvuli kurzive S,Z,? aj. +++
#	    ++++++++ tady prochazi levy okraj znaku doleva +++++++++++++++++++++
	    for ( $i = $max_prekryv-1; $i >= 0; $i-- ) {
		$txt_sada_pixel_sloupcu[$i] = &uprav_pixel_sloupec($pixel_sloupec_ok[$ocr_sloupec-$pixel_sirka_znaku+$i+1],$txt_sada_pixel_sloupcu[$i+1]);
	    }

#	    ++++++++ tady prochazi pravy okraj doprava a jeste dale ++++++++++++
	    for ( $i = 0; $i < $max_prekryv; $i++ ) {
		pop(@txt_sada_pixel_sloupcu); #odstrani pravy okraj znaku
	    }

	    $pixel_sirka_znaku = @txt_sada_pixel_sloupcu;

	    $ocr_sloupec -= $max_prekryv-1;
	    $levy_sl = &uprav_pixel_sloupec($pixel_sloupec_ok[$ocr_sloupec],$txt_sada_pixel_sloupcu[$pixel_sirka_znaku-1]);
	    $pravy_sl = &uprav_pixel_sloupec($pixel_sloupec_ok[$ocr_sloupec+1], $levy_sl);

#	    	++++++++++ postupuje vpred a hleda konec znaku +++++++++++++++++

	    while ( index($pravy_sl,$bod) >= 0 and $ocr_sloupec+1 < $right_pixel ) {

		push(@txt_sada_pixel_sloupcu, $levy_sl);
		$ocr_sloupec++;
		$levy_sl = $pravy_sl;
		$pravy_sl = &uprav_pixel_sloupec($pixel_sloupec_ok[$ocr_sloupec+1], $levy_sl);
	
	    }

	    push(@txt_sada_pixel_sloupcu, $levy_sl);

# 		+++++++++++ kontrola zda uz neni na poslednim znaku na radku +++

	    if ( $ocr_sloupec+1 == $right_pixel ) {
    
		if ( index($pravy_sl,$bod) >= 0 ) {
	    
		    push(@txt_sada_pixel_sloupcu, $pravy_sl);
	    
		}
		$ocr_sloupec++;

	    }

	    $pixel_sirka_znaku = @txt_sada_pixel_sloupcu;

	}

    }

    $pixel_sirka_znaku = @txt_sada_pixel_sloupcu;

    if ( $pocet_prazdnych_sloupcu == 0 and $pixel_sirka_znaku > 1 ) {
    
#def $pixel_sirka_znaku - sirka rozpoznaneho znaku v pixelech; odpovida poctu
#                         bit-vektoru v poli @txt_sada_pixel_sloupcu

	#porovnani znaku s databazi a pripadny dodaz na novy znak

	$posledni_pixel_znaku = 0;
	@txt_sada_pixel_sloupcu = &posun_txt_sady_pixel_sloupcu_doleva(1,@txt_sada_pixel_sloupcu);
	    # vsechny znaky zarovna doleva/dolu, aby byly stejne
	    # parametr 1 rika, ze se ma zjistovat $posledni_pixel_znaku

	$rozpoznano = &projdi_ocr_databazi(@txt_sada_pixel_sloupcu);

	if ( $rozpoznano eq "" and not $opt_m and $pixel_sirka_znaku>6 ) {
	    # OVERENI ZDA NEJDE O SPOJENE ZNAKY ma smysl, jen pokud je rozpoznany znak
	    # minimalne 2x sirsi nez nejuzsi znak - predpokladam, ze i ma min. 3 pixel-sloupce

	    $jeden_pixel_ve_sloupci = 0;

	    for ( $i = 3; $i < $pixel_sirka_znaku-3; $i++ ) {
		#znaky nebudou spojeny na okrajich

		if ( index($txt_sada_pixel_sloupcu[$i],$bod) == rindex($txt_sada_pixel_sloupcu[$i],$bod) ) {

		    $jeden_pixel_ve_sloupci = 1;
		    last;

		}

	    }

	    &zkus_rozdelit_znak(0) if $jeden_pixel_ve_sloupci;

	}

	if ( $rozpoznano eq "" ) { #DOTAZ PRO UZIVATELE NA ROZPOZNANY ZNAK

	    &tisk_casti_titulku;
	    print "Analyzuji soubor:\'$pgm_soubor\'\n";
	    print "Vloz odpovidajici znak a stiskni [ENTER]:";
	    chomp($rozpoznano = <STDIN>);
	    if ( $rozpoznano eq "I" ) {
		print "POZOR! Obvykle male L a velke I vypadaji stejne. V takovem pripade doporucuji zadat male L\n";
		print "Vloz odpovidajici znak a stiskni [ENTER]:";
		chomp($rozpoznano = <STDIN>);
	    }

	    if ( $rozpoznano ne "" ) {

		if ( length($rozpoznano)>1 and not $opt_m and $jeden_pixel_ve_sloupci) {

		    &zkus_rozdelit_znak(1);

		} else {

		    unshift(@txt_sada_pixel_sloupcu,$rozpoznano);
		    push(@{$ocr_databaze{$ocr_key}},[@txt_sada_pixel_sloupcu]);

#		    print "OCR klic:$ocr_key\n";

		}

	    }

	    print "Zpracovavam titulky \'$pgm_soubor\'\n";

	}

    }

    $ocr_sloupec++; #inkrementuje se az tady kvuli tisku sady vektoru znaku
		     #a radeji vice, abychom se vyhnuli zacykleni

    return $rozpoznano;

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  
#vystup: 
sub zkus_rozdelit_znak {
    my ( $prideleni_znaku ) = @_;
    my ( @cast_sady_pixel_sloupcu, @casti_znaku ) = ();
    my ( $i ) = 0;

# +++++++++++++++ zde se rozdeli rozpoznany znak na dilci znaky ++++++++++++++++
    while ( $i < $pixel_sirka_znaku ) {

	if ( $i > 2 and $i < $pixel_sirka_znaku-3 and index($txt_sada_pixel_sloupcu[$i],$bod) == rindex($txt_sada_pixel_sloupcu[$i],$bod) ) {

	    if ( (index($txt_sada_pixel_sloupcu[$i+1],$bod) == rindex($txt_sada_pixel_sloupcu[$i+1],$bod)) or (rindex($txt_sada_pixel_sloupcu[$pixel_sirka_znaku-1],$bod) - index($txt_sada_pixel_sloupcu[$pixel_sirka_znaku-1],$bod) > 1) ) {
		#jednopixelovy sloupec patri znaku vlevo pokud je dalsi pixel-sloupec
		#taky jednopixelovy nebo pokud posledni pixel-sloupec (uplne vpravo)
		#nema prave jeden aktivni pixel


		# pokud jsou dva jednopixelove sloupce vedle sebe, tak kazdy patri jednomu znaku,
		# jinak patri jednopixelovy sloupec druhemu znaku tj. znaku vpravo, pokud pixel
		# sloupec uplne vpravo obsahuje prave jeden aktivni pixel

		push(@cast_sady_pixel_sloupcu, $txt_sada_pixel_sloupcu[$i]);
		$i++;

	    }

	    @cast_sady_pixel_sloupcu = &posun_txt_sady_pixel_sloupcu_doleva(0,@cast_sady_pixel_sloupcu);
		# parametr 0 rika, ze se NEMA zjistovat $posledni_pixel_znaku
	    push(@casti_znaku,[@cast_sady_pixel_sloupcu]);
	    @cast_sady_pixel_sloupcu = ();

	}

	push(@cast_sady_pixel_sloupcu, $txt_sada_pixel_sloupcu[$i]);
	$i++;

    }

    @cast_sady_pixel_sloupcu = &posun_txt_sady_pixel_sloupcu_doleva(0,@cast_sady_pixel_sloupcu);
    push(@casti_znaku,[@cast_sady_pixel_sloupcu]);

#    foreach $ii ( @casti_znaku ) {
#    
#	foreach $i ( @{$ii} ) {
#	
#	    print "\'$i\'\n";
#	
#	}
#
#    	print "\n";
#
#    }

# ++++++++++++++ testovani jednotlivych casti ++++++++++++++++++++++++++++++++++

    if ( $prideleni_znaku and (length($rozpoznano) == @casti_znaku) ) {
	
	for ( $i = 0; $i < @casti_znaku; $i++ ) {
	
	    $ocr_key = &ocr_key_vzorec(@{$casti_znaku[$i]});
	    unshift(@{$casti_znaku[$i]},substr($rozpoznano,$i,1));
	    push(@{$ocr_databaze{$ocr_key}},[@{$casti_znaku[$i]}]);

#	    print "Po rozdeleni ukladam znak \'",substr($rozpoznano,$i,1),"\', OCR klic:$ocr_key\n";
#	
#	    foreach $ii ( @{$casti_znaku[$i]} ) {
#	    
#		print "\'$ii\'\n";
#	    
#	    }
#
#	    print "\n";

	}

    }

    unless ( $prideleni_znaku ) {

	foreach $i ( @casti_znaku ) {
	
#	    print "!!! Proveruju casti znaku\n";
#
#	    foreach $ii ( @{$i} ) {
#	    
#		print "\'$ii\'\n";
#	    
#	    }
#
#	    print "\n";


	    $rozpoznano_cast = &projdi_ocr_databazi(@{$i});

#	    print "rozpoznano_cast:\'$rozpoznano_cast\'\n";

	    if ( $rozpoznano_cast eq "" ) {
		$rozpoznano = "";
		last;
	    } else {
		$rozpoznano .= $rozpoznano_cast;
	    }

	}

    }

#    print "Vysledek proverky casti znaku: rozpoznano=\'$rozpoznano\'\n";

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  pole s txt pixel-sloupci znaku, ktery se ma s OCR databazi porovnat
#vystup: znak, ktery byl rozpoznan, nebo prazdny retezec
sub projdi_ocr_databazi {
    my ( @co_porovnat ) = @_;
    my ( $rozpoznano ) = "";
    my ( $i );

    $ocr_key = &ocr_key_vzorec(@co_porovnat);
#    $pixel_sirka_znaku = @co_porovnat;

    if ( exists($ocr_databaze{$ocr_key}) ) {

	foreach $vzorek ( @{$ocr_databaze{$ocr_key}} ) {
    
#	    print "Prochazim OCR databazi,  znak:${$vzorek}[0]\n";

	    @sada_txt_pixel_sloupcu_ocr_databaze = @$vzorek;

	    if ( @co_porovnat == @sada_txt_pixel_sloupcu_ocr_databaze-1 ) {

		$shoda = 1;

		for ( $i = 0; $i < $pixel_sirka_znaku; $i++ ) {

		    if ( $sada_txt_pixel_sloupcu_ocr_databaze[$i+1] ne $co_porovnat[$i] ) {
			$shoda = 0;
		    }

		    last unless $shoda;

		}

	    } else { $shoda = 0; }

	    if ( $shoda ) {

		$rozpoznano = ${$vzorek}[0];

	    }

	    last if $shoda;

	}

    }

    return $rozpoznano;

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  pole @txt_sada_pixel_sloupcu musi byt naplneno rozpoznanym znakem
#vystup: stejne pole, ale bit vektory jsou zarovnany vlevo podle nejnizsiho bitu
sub posun_txt_sady_pixel_sloupcu_doleva {
    my ( $pro_tisk_sady, @sada ) = @_;
    my ( $posun_znaku_dolu ) = 255; #nejaka pocatecni max.hodnota
    my ( $prvni_vlevo, $posledni_pixel_sloupce );
    my ( $i );

    foreach $vektor ( @sada ) {

	$prvni_vlevo =  index($vektor,$bod);
	if ( $prvni_vlevo >= 0 and $prvni_vlevo < $posun_znaku_dolu ) { $posun_znaku_dolu = $prvni_vlevo; }

	last if $posun_znaku_dolu == 0;

    }

    if ( ($posun_znaku_dolu <= $pixel_vyska*0.25) and ($posun_znaku_dolu > $max_posun_dolu) ) { $max_posun_dolu = $posun_znaku_dolu; }
# do max_posun_dolu nesmi byt zahrnut posun pomlcky a vyse polozenych znaku, 0.25 ze zkusenosti
    if ( $posun_znaku_dolu > $pixel_vyska*0.6 ) { $posun_znaku_dolu--; }
#   aby nedoslo k zamene carky za slovy a hacku u d/t,zustane po posunu dolu
#   jeden prazdny bit u znaku, ktere zacinaji v horni casti radku vyjma pomlcky

#    $posledni_pixel_znaku = 0;
#def $posledni_pixel_znaku - globalni promenna vyuzita pri tisku sady bit-vektoru znaku

    for ( $i=0; $i < @sada; $i++) {

	$posledni_pixel_sloupce = rindex($sada[$i],$bod);
	$sada[$i] = substr($sada[$i],$posun_znaku_dolu,$posledni_pixel_sloupce-$posun_znaku_dolu+1);
	if ( (($posledni_pixel_sloupce-$posun_znaku_dolu) > $posledni_pixel_znaku) and $pro_tisk_sady ) {
	    $posledni_pixel_znaku = $posledni_pixel_sloupce-$posun_znaku_dolu;
	}

    }

    return @sada;

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  bit-vektor libovolne delky
#vystup: cislo, ktere je souctem ciselnych reprezentaci jednotlivych bajtu v bit-vektoru
sub ocr_key_vzorec {
    my ( @sada ) = @_;
    my ( $nasobitel ) = 1;
    my ( $vzorek, $pocet );
    my ( $key ) = 0;

    foreach $vzorek ( @sada ) {

	#def $pocet -obsahuje pocet nahrazeni ve vyrazu a takto pocet pixelu v pixel-sloupci
	$pocet = $vzorek =~ s/$bod//go; #modifikator s///o -reg.vyraz
					    #se kompiluje jen jednou

	$key += $nasobitel * $pocet;
	$nasobitel *= 2;

    }

    return $key;

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  
#vystup: 
sub tisk_casti_titulku {
    my ( $segment, $start1, $start2, $kolik1, $kolik2 );
    my ( $i );

    print "\n"; #horizontalni oddeleni tisknute casti titulku od ostatniho textu

#    print "OCR_key:$ocr_key\n\n";

#    print "pixel_radek_index:$pixel_radek_index,pixel_vyska:$pixel_vyska,";
#    print "ocr_sloupec:$ocr_sloupec,pixel_sirka_znaku:$pixel_sirka_znaku\n";

# tisk sady sloupcu rozpoznaneho znaku
#
#    foreach $vektor ( @txt_sada_pixel_sloupcu ) {
#	print "\'$vektor\'\n";
#    }


# tisk casti titulku prevedeneho do txt odpovidajici sade bit vektoru
#

    $start1 = $ocr_sloupec - $pixel_sirka_znaku - int(($sirka_radku_terminalu-$pixel_sirka_znaku)/2) + 1;
    if ( $start1 < $left_pixel ) { $start1 = $left_pixel; }
    $kolik1 = $ocr_sloupec - $pixel_sirka_znaku - $start1 +1;
    
    $start2 = $ocr_sloupec + 1;
    $kolik2 = $right_pixel - $ocr_sloupec;
    if ( $kolik2 > int(($sirka_radku_terminalu-$pixel_sirka_znaku)/2) ) {
	$kolik2 = int(($sirka_radku_terminalu-$pixel_sirka_znaku)/2); 
    }

#    print "pixel sirka znaku:$pixel_sirka_znaku, start1:$start1, start2:$start2, kolik1:$kolik1, kolik2:$kolik2\n";

    for ( $i = 0; $i < $pixel_vyska; $i++ ) {

	#tisk okoli pred rozpoznanym znakem
	if ( $kolik1 > 0 ) {
	    $segment = substr($pixel_radek_ok[$i],$start1,$kolik1);
	    $segment =~ s/$bod/$stin/go;
	    print $segment;
	}

#	print "\'".substr($pixel_radek_ok[$i], $ocr_sloupec-$pixel_sirka_znaku+1, $pixel_sirka_znaku)."\'\n";
	print substr($pixel_radek_ok[$i], $ocr_sloupec-$pixel_sirka_znaku+1, $pixel_sirka_znaku);

	#tisk okoli za rozpoznanym znakem
	if ( $kolik2 > 0 ) {
	    $segment = substr($pixel_radek_ok[$i],$start2,$kolik2);
	    $segment =~ s/$bod/$stin/go;
	    print $segment;
	}

	print "\n"; #ukonceni jednoho radku tisknute casti titulku

    }

    print "\n"; #horizontalni oddeleni tisknute casti titulku od ostatniho textu

    if ( $opt_r ) {

	&tisk_sady_vektoru;
	print "\n";

    }

}
#-------------------------------------------------------------------------------


#===============================================================================
sub tisk_sady_vektoru {
    my ( $i, $j );

#    print "max.posun dolu:$max_posun_dolu, .pixel.vyska:$pixel_vyska pomer v %:",$max_posun_dolu/$pixel_vyska*100,"\n\n";

    for ( $i = $posledni_pixel_znaku; $i >= 0; $i-- ) {

	for ( $j = 0; $j < @txt_sada_pixel_sloupcu; $j++ ) {

	    if ( $i < length($txt_sada_pixel_sloupcu[$j]) ) {
	
		print substr($txt_sada_pixel_sloupcu[$j],$i,1);
		
	    } else {
	    
		print " ";
		
	    }

	}

	print "\n";

    }

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  
#vystup: 
sub uprav_pixel_sloupec {
    my ( $meneny_sl, $vzorovy_sl, $zpatecka ) = @_;
    my ( $prvi_nastaveny, $posledni_nastaveny ) = 255; #inicializace na nejakou max hodnotu
    my ( $zachovat, $index ) = 0;
    my ( $i );

#    print "v:",unpack("b*",$vzorovy_sl)," m:",unpack("b*",$meneny_sl)," zm:";

#    $index = length($meneny_sl);

    while ( $index < length($meneny_sl) ) {
    
	#prochazi pixel sloupce zdola nahoru - kvuli smeru sklonu diakritiky

	if ( substr($meneny_sl, $index, 1) eq $bod ) {

	    $prvni_nastaveny = $index;

	    while ( substr($meneny_sl, $index, 1) eq $bod ) {
		$index++;
	    }
	    $posledni_nastaveny = $index-1;

	    $zachovat = 0;
	    for ( $i = $prvni_nastaveny; $i<=$posledni_nastaveny; $i++ ) {

		if ( substr($vzorovy_sl, $i, 1) eq $bod ) { $zachovat = 1; }
		last if $zachovat;

	    }

	    if ( $zachovat == 0 and $prvni_nastaveny >= ($max_posun_dolu+$max_pixel_vzdalenost_diakr) ) {
		# pro zachovani diakritiky nad znaky
		# nepostihne diakritiku nad u,y,U,Y,N
		# a pro zachovani cary u vykricniku pri kurzive, kdy tecka zacina drive

		for ( $i = $prvni_nastaveny-1 - $max_pixel_vzdalenost_diakr; $i < $prvni_nastaveny; $i++ ) {

		    next if $i<0;
		    if ( substr($meneny_sl, $i, 1) eq $bod ) { $zachovat = 1; }
		    last if $zachovat;

		}

	    }
	    
	    if ( $zachovat == 0 and $zpatecka == 0 and (index($vzorovy_sl,$bod) == rindex($vzorovy_sl,$bod)) and $posledni_nastaveny>$pixel_vyska/2 ) {
		# vyjimecne u dlouheho i se stava, ze carka zacina pred i, a pak
		# by chybela cast pod carkou nad i
		# aby ale nedochazelo k zacykleni pri kurzive, je nutno pridat dalsi
		# test, kdy predchozi pixel-sloupec obsahuje jen jeden aktivni pixel

		for ( $i = $posledni_nastaveny+1 + $max_pixel_vzdalenost_diakr; $i > $posledni_nastaveny; $i-- ) {

		    last if $i > length($meneny_sl);
		    if ( substr($meneny_sl, $i, 1) eq $bod ) { $zachovat = 1; }
		    last if $zachovat;

		}

	    }

	    unless ( $zachovat ) {

		for ( $i = $prvni_nastaveny; $i <= $posledni_nastaveny; $i++ ) {

		    substr($meneny_sl, $i, 1, $mezera);

		}

	    }

	}

	$index++;

    }

#    print "modifikuju bit vektor sloupce\n";

#    print unpack("b*",$meneny_sl),"\n";

    return $meneny_sl;

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  nic
#vystup: nic resp. tisk napovedy na obrazovku
sub napoveda {

    print "\n";
    print "Program pgm2srt slouzi ke zpracovani DVD titulku prevedenych na jednotlive PGM\n";
    print "obrazky pomoci transcode, resp. jeho soucasti tcextract a subtitle2pgm.\n";
    print "PGM obrazy jednotl. titulku musi byt vyhradne cernobile bez odstinu sede a dale \n";
    print "je vyzadovan soubor .srtx, ktery je generovan programem subtitle2pgm.\n";
    print "Pouziti: pgm2srt [volby] SRTX_soubor\n";
    print "Pozor!!! nazev vstupniho SRTX souboru musi byt uplne posledni!\n";
    print "  -h          tento help\n";
    print "  -v          verze tohoto programu\n";
    print "  -o <nazev>  output - mozno zadat nazev vystupniho souboru SRT titulku\n";
    print "                     - bez pouziti volby je vytvoren soubor *.new\n";
    print "  -s <nazev>  save - ulozi vytvorenou databazi znaku jako <nazev>.pgm2srt\n";
    print "  -l <nazev>  load - pouzije drive vytvorenou databazi rozpoznanych znaku\n";
    print "  -c <cislo>  character - moznost zmenit implicitni nastaveni minimalni vysky\n";
    print "                          znaku v pixelech (pouzito z duvodu diakritiky)\n";
    print "  -d <cislo>  distance - zmeni implicitni maximalni vertikalni pixel-vzdalenost\n";
    print "                         diakritiky a tecek od znaku\n";
    print "  -g <cislo>  gap - zmeni implicitni minimalni horizontalni pixel-vzdalenost\n";
    print "                    stanovujici mezeru mezi slovy (pozor na kurzivu!)\n";
    print "  -e <cislo>  over - zmeni implicitni maximalni prekryv znaku v pixelech\n";
    print "                   - uplatni se pri kurzive, kdy vrchni cast predchazejiciho\n";
    print "                     znaku zasahuje nad dolni cast znaku nasledujiciho\n";
    print "  -w <cislo>  width - zmeni implicitni nastaveni sirky terminalu, tj. poctu\n";
    print "                      znaku na radek pri vypisu casti rozpoznavaneho titulku\n";
    print "                    - nesmi prekrocit sirku vaseho terminalu ve znacich!\n";
    print "  -r          recognize - vypisuje navic pod cast titulku presnou podobu\n";
    print "                          rozpoznaneho znaku\n";
    print "  -m          multiplicity - NEBUDE se provadet kontrola spojenych znaku\n";
    print "                           - rozpoznavani by melo byt o neco rychlejsi, ale\n";
    print "                             uzivatel bude casteji dotazovan u slitych znaku\n";
    print "  -p znak     point - textova reprezentace \"aktivniho\" pixelu\n";
    print "  -b znak     blank - textova reprezentace prazdneho mista\n";
    print "  -a znak     shadow - textova reprezentace \"neaktivniho\" pixelu\n";
    print "  -q          quiet - TO DO\n";
    print "                    - zabrani vypisu do terminalu - uplatni se v GUI\n";
    print "\n";
    print "---------------\n";
    print "Priklad:\n\n";
    print " pgm2srt -p \"@\" -b \".\" -a \">\" -rs titulky -w 140 -o titulky.srt titulky.srtx\n";
    print "\n";

}
#-------------------------------------------------------------------------------


#===============================================================================
#vstup:  nic
#vystup: nic resp. tisk verze na obrazovku
sub verze {

    print "pgm2srt ver. ",VERZE,"\n";
    print "Vytvoreno na platforme LinuxMandrake 9.0; perl v5.8.0\n";
    print 'Tomas Hanusek, xhant04@centrum.cz, http://hanus.host.sk',"\n";

}
#-------------------------------------------------------------------------------


#===============================================================================
sub uloz_ocr_databazi {
    my ( @sada_bit_vektoru, $prvku_pole, $vzorek );

    open (OCR, ">$opt_s.pgm2srt") or die ("Nemohu zalozit soubor \'$opt_s.pgm2srt\'\n");
    
    print "Ukladam OCR databazi...\n";

    print OCR "Datovy soubor programu pgm2srt ver.",VERZE,"\n";
    print OCR "Obsahuje rozpoznane znaky prislusnych PGM titulku.\n";
    print OCR "Format souboru:\n";
    print OCR " % -takto se znaci klice hashe %ocr_databaze - ty jsou vypocitany z podoby\n";
    print OCR "    rozpoznaneho znaku tak, ze pocet aktivnich pixelu v jednotlivych sloupcich\n";
    print OCR "    se postupne nasobi mocninou dvojky a tato cisla jsou scitana.\n";
    print OCR " > -oznaceni ukazatele na pole, obsahujici txt pixel-sloupce  znaku; jelikoz zpusob\n";
    print OCR "    stanoveni hashoveho klice nezarucuje jednoznacnost pro vsechny znaky, muze\n";
    print OCR "    mit stejny hashovy klic vice znaku - proto se ukladaji do poli.\n";
    print OCR "   -jde tedy o pole poli, pricemz prvky tohoto pole jsou odkazy na dalsi pole\n";
    print OCR " A -oznacuje jiz konkterni pole, ktere obsahuje textovou reprezentaci\n";
    print OCR "   znaku A. Prvni polozkou pole je znak A, ostatni polozky jsou pixel sloupce\n";
    print OCR "   prevedene na text od dolniho pixelu smerem nahoru.\n";
    print OCR "\n";
    print OCR "Parametry pro zobrazeni:\n";
    print OCR "-p $bod\n";
    print OCR "-b $mezera\n";
    print OCR "-a $stin\n";
    print OCR "\n";

    foreach $ocr_key ( keys(%ocr_databaze) ) {
    
	print OCR "%","$ocr_key\n";

	foreach $vzorek ( @{$ocr_databaze{$ocr_key}} ) {
	
	    @sada_bit_vektoru = @$vzorek;
	    $prvku_pole = @sada_bit_vektoru;
	    print OCR ">","$sada_bit_vektoru[0]\n";
	    for ( $i = 1; $i < $prvku_pole; $i++ ) {
		print OCR "$sada_bit_vektoru[$i]\n";
	    }
	
	}

    }

    close(OCR);

}
#-------------------------------------------------------------------------------


#===============================================================================
sub nacti_ocr_databazi {
    my ( @sada_bit_vektoru, $radek, $znak, $bod_ocr, $mezera_ocr, $stin_ocr );

    unless ( open (OCR, "$opt_l") ) {

	open (OCR, "$opt_l.pgm2srt") or die ("Nemohu otevrit soubor s OCR databazi\n");

    }

    print "Nacitam OCR databazi...\n";

    while ( chomp($radek = <OCR>) ) {

	if ( $radek =~ /$\-p/ ) {

	    ( $bod_ocr ) = $radek =~ /$\-p (.)/;
	    print "TXT reprezentace pixelu:  \'$bod_ocr\'\n";

	}

	if ( $radek =~ /$\-b/ ) {

	    ( $mezera_ocr ) = $radek =~ /$\-b (.)/;
	    print "TXT reprezentace mezery:  \'$mezera_ocr\'\n";

	}

	if ( $radek =~ /$\-a/ ) {

	    ( $stin_ocr ) = $radek =~ /$\-a (.)/;
	    print "TXT reprezentace \"stinu\": \'$stin_ocr\'\n";

	}

	while ( index($radek,"%") == 0 ) {

	    ($ocr_key) = substr($radek,1);
	    chomp($radek = <OCR>);

	    while ( index($radek,">") == 0 ) {

		($znak) = substr($radek,1);
		if ( $znak eq "" ) {
		    close(OCR);
		    die "Chybny format OCR databaze!!!\n";
		}

		@sada_bit_vektoru = ();
		$sada_bit_vektoru[0] = $znak;
		chomp($radek = <OCR>);

#		print "%",$ocr_key,"\n>",$znak,"\n";

		while ( $radek ne "" and index($radek,"%")<0 and index($radek,">")<0 ) {

		    if ( $opt_p ) { $radek =~ s/$bod_ocr/$bod/go; }
		    if ( $opt_b ) { $radek =~ s/$mezera_ocr/$mezera/go; }
		    push(@sada_bit_vektoru,$radek);
		    chomp($radek = <OCR>);

		}

		push(@{$ocr_databaze{$ocr_key}},[@sada_bit_vektoru]);

	    }

	}

    }

    close (OCR);

    unless ( $opt_p ) { $bod = $bod_ocr; }
    unless ( $opt_b ) { $mezera = $mezera_ocr; }
    unless ( $opt_a ) { $stin = $stin_ocr; }

    print "Prenastavuji TXT reprezentace pixelu podle prikazoveho radku...\n";
    print "TXT reprezentace pixelu:  \'$bod\'\n";
    print "TXT reprezentace mezery:  \'$mezera\'\n";
    print "TXT reprezentace \"stinu\": \'$stin\'\n\n";

    if ( ($bod ne $bod_ocr) or ($mezera ne $mezera_ocr ) ) {
	print "POZOR! OCR databaze je nepouzitelna kvuli volbe -p nebo -b !!!\n\n";
    }

}