#!/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 diagnostics; $VERSION = 0.3.1; $gpgm2srt_ver = '0.3.1'; #use POSIX; use locale; use Env; use Tk; #use Tk::ErrorDialog; require Tk::LabFrame; require Tk::NoteBook; require Tk::Dialog; require Tk::ProgressBar; require Tk::Entry; use lib "$HOME/bin"; #where to look for Exactocr.pm module use Exactocr 0.1; #my module with exact match OCR algorithm #def $dvd_dev - DVD device (/dev/dvd, /dev/dvd2/, /dev/hdc, /dev/hdd etc.) $dvd_dev = "/dev/dvd"; #def $save_conf - whether to save configuration on Exit or not $save_conf = 0; $load_conf = 0; $clear_dir = 0; #needed by spinner sub $def_bitmaps = 0; $min_space_width = 6; #def $min_space_width - default setting of the minimum pixel width of the space between words $max_diacr_dist = 3; #def $max_diacr_dist - default setting of the maximum pixel distance of the diacritics from the belonging char $max_char_over = 4; #def $max_char_over - default setting of the maximum vertical pixel overlap of neighbouring italics characters $min_height = 10; #def $min_height - default setting of the minimum pixel height of one subtitle row - must be greater # than the diacritics height plus maximum diacritics distance from the character $check_for_I = 0; #whether the I letter was already entered - if no warning l/I is diplayed $pix_size = 1; #def pix_size - multiple of pixel size for displaying PGM subtitle preview $pgm_min = 5; #def pgm_min - time in minutes to generate from the subtitle for preview $txt_sub_overwrite = false; #def txt_sub_overwrite - for testing whether the second book_page should be activated or disabled $char_in_database = 0; $preview_shaded = 0; $rectangle_drawn = 0; $lines_drawn = 0; $pgm_drawn = 0; $ocr_set_size = 0; #******************************************************************* # GUI W I D G E T S D E F I N I T I O N S #******************************************************************* #============================== PGM subtitles generation Window ============================================== $mw = MainWindow -> new(); $main_win_title = "gpgm2srt $gpgm2srt_ver - DVD subtitles conversion into SRT (txt) format"; $mw -> title($main_win_title); #$mw -> useinputmethods(1); $menu_bar = $mw -> Frame() -> pack( -side => 'top', -anchor => 'w', -pady => '3' ); $options_menu = $menu_bar -> Menubutton( -text => 'Options', -borderwidth => '2', -relief => 'raised' ) -> pack ( -anchor => 'w' ); $options_menu -> command( -label => 'Set DVD device...', -command => \&set_dvd_dev ); $options_menu -> command( -label => 'Save settings', -command => sub { &save_config(1); } ); $options_menu -> checkbutton( -label => 'Clear directory on exit', -variable => \$clear_dir ); $options_menu -> checkbutton( -label => 'Load settings on start', -variable => \$load_conf ); $options_menu -> checkbutton( -label => 'Save settings on exit', -variable => \$save_conf ); #------------------ NOTEBOOK DEFINITION ----------------------------------------------------------------- $note_book = $mw -> NoteBook() -> pack( -expand => 1, -fill => 'both' ); $pre_page1 = $note_book -> add( 'page1', -label => "Extract\nsubtitles stream", ); $page1 = $note_book -> add( 'page2', -label => "Files\nand Paths", ); $page2 = $note_book -> add( 'page3', -label => "PGM subtitles\ngeneration", -state => 'disabled', -raisecmd => \&show_pgm_sub ); $page3 = $note_book -> add( 'page4', -label => "PGM to SRT\n( OCR )", -state => 'disabled' ); $page4 = $note_book -> add( 'page5', -label => "OCR database\nview", -state => 'disabled', -raisecmd => sub { &pattern_switch("init"); } ); #$page5 = $note_book -> add( 'page6', # -label => 'SRT subtitles check', # -state => 'disabled' # ); #******* PRE_PAGE 1 *************************************************************************************** $pre_page1_main_frame1 = $pre_page1 -> Frame () -> pack( -side => 'left', -anchor => 'nw' ); #$pre_page1_main_frame1 = $pre_page1 -> Frame ( -side => 'left'); $pre_page1_frame1 = $pre_page1_main_frame1 -> LabFrame ( -label => 'Subtitle streams check', -labelside => 'acrosstop', ) -> pack( -fill => 'x' ); $pre_page1_subframe = $pre_page1_frame1 -> Frame () -> pack( -anchor => 'w' ); $dvd_title_label = $pre_page1_subframe -> Label( -text => 'DVD Title:' ) -> pack( -side => 'left' ); $dvd_title_num = 1; &NumEntry($pre_page1_subframe,-textvariable=>\$dvd_title_num,-width=>2,-minvalue=>1,-maxvalue=>99) -> pack( -side => 'left' ); $list_sid_btn = $pre_page1_frame1 -> Button( -text => 'Check DVD for subtitles (MPlayer required)', -padx => 3, -pady => 3, -command => \&list_dvd_sid ) -> pack( -fill => 'x' ); #------------------------------ $pre_page1_frame2 = $pre_page1_main_frame1 -> LabFrame ( -label => 'Subtitle stream extraction', -labelside => 'acrosstop', ) -> pack( -fill => 'x' ); $sub_stream_src = 0; $stream_src_radiobtn1 = $pre_page1_frame2 -> Radiobutton( -variable => \$sub_stream_src, -text => 'Source DVD', -value => 1 ) -> pack( -anchor => 'w' ); $pre_page1_subframe1 = $pre_page1_frame2 -> Frame () -> pack( -anchor => 'w' ); $stream_src_radiobtn2 = $pre_page1_subframe1 -> Radiobutton( -variable => \$sub_stream_src, -text => 'Source file', -value => 2 ) -> pack( -side => 'left' ); $dumpstream_browse_btn = $pre_page1_subframe1 -> Button( -text => 'Browse source file...', -padx => 3, -pady => 3, -command => \&open_dumpstream ) -> pack(); $pre_page1_subframe3 = $pre_page1_frame2 -> Frame () -> pack( -anchor => 'w' ); $dvd_sid_label = $pre_page1_subframe3 -> Label( -text => 'Subtitle ID:' ) -> pack( -side => 'left', -anchor => 'e' ); $dvd_sid_num = 0; &NumEntry($pre_page1_subframe3,-textvariable=>\$dvd_sid_num,-width=>2,-minvalue=>0,-maxvalue=>99) -> pack( -anchor => 'e' ); $sid_num_btn = $pre_page1_frame2 -> Button( -text => 'Extract subtitle stream (transcode required)', -padx => 3, -pady => 3, -command => \&extract_sub_stream ) -> pack(); $wait_label = $pre_page1_frame2 -> Label( -text => ' ' ) -> pack(); #------------------------------ $pre_page1_frame3 = $pre_page1 -> LabFrame ( -label => 'Subtitles list', -labelside => 'acrosstop', ) -> pack( -expand => 'y', -fill => 'both', -anchor => 'w' ); $sid_list_text = $pre_page1_frame3 -> Scrolled('Text', -scrollbars => 'e', -width => 45 ) -> pack( -expand => 'y', -fill => 'y' ); #******* PAGE 1 *********************************** #------- Subtitles load dialog box ---------------- $page1_frame1 = $page1 -> LabFrame( -label => 'File containing subtitle stream (generated e.g. by tcextract)', -labelside => 'acrosstop' ) -> pack( -anchor => 'nw'); $enter_subtitles_file = $page1_frame1 -> Entry( -width => 80 ) -> pack( -side => 'left' ); #$ok_button1 = $page1_frame1 -> Button( -text => 'OK', # -padx => 3, # -pady => 3, # -command => \&check_input_file # ) -> pack( -side => 'left' ); $open_browse_button1 = $page1_frame1 -> Button( -text => 'Browse...', -padx => 3, -pady => 3, -command => \&open_file_dialog ) -> pack( -side => 'left' ); #------- TXT Subtitles save dialog box $page1_frame2 = $page1 -> LabFrame( -label => 'Save final TXT subtitles as', -labelside => 'acrosstop' ) -> pack( -anchor => 'w'); $enter_save_file = $page1_frame2 -> Entry( -width => 80 ) -> pack( -side => 'left' ); #$ok_button2 = $page1_frame2 -> Button( -text => 'OK', # -padx => 3, # -pady => 3, # -command => \&check_save_file # ) -> pack( -side => 'left' ); $save_browse_button1 = $page1_frame2 -> Button( -text => 'Browse...', -padx => 3, -pady => 3, -command => \&save_file_dialog ) -> pack( -side => 'left' ); #------- OCR database load dialog box $page1_frame3 = $page1 -> LabFrame( -label => 'Load OCR database from file', -labelside => 'acrosstop' ) -> pack( -anchor => 'w'); $enter_ocr_load_file = $page1_frame3 -> Entry( -width => 80 ) -> pack( -side => 'left' ); #$ok_button3 = $page1_frame3 -> Button( -text => 'OK', # -padx => 3, # -pady => 3, # -command => \&check_ocr_file # ) -> pack( -side => 'left' ); $open_browse_button2 = $page1_frame3 -> Button( -text => 'Browse...', -padx => 3, -pady => 3, -command => \&open_ocr_dialog ) -> pack( -side => 'left' ); #------- OCR database save dialog box $page1_frame4 = $page1 -> LabFrame( -label => 'Save OCR database as', -labelside => 'acrosstop' ) -> pack( -anchor => 'w'); $enter_ocr_save_file = $page1_frame4 -> Entry( -width => 80 ) -> pack( -side => 'left' ); #$ok_button4 = $page1_frame4 -> Button( -text => 'OK', # -padx => 3, # -pady => 3, # -command => \&check_save_ocr # ) -> pack( -side => 'left' ); $save_browse_button2 = $page1_frame4 -> Button( -text => 'Browse...', -padx => 3, -pady => 3, -command => \&save_ocr_dialog ) -> pack( -side => 'left' ); $check_files_btn = $page1 -> Button( -text => 'Check files and continue', -padx => 3, -pady => 3, -command => \&check_files ) -> pack( -side => 'top' ); #******* PAGE 2 *********************************** #-------- subtitle2pgm -c parameter choice -------- $page2_frame1 = $page2 -> Frame() -> pack( -side => 'left', -anchor => 'nw', -ipady => 5, -ipadx => 5 ); $page2_frame1_1 = $page2_frame1 -> LabFrame( -label => 'Choose -c parametr for subtitle2pgm', -labelside => 'acrosstop' ) -> pack( -anchor => 'nw', -fill => 'x' ); $sub2pgm_parm = 0; $sub2pgm_c[1]="255,0,255,255"; $sub2pgm_c[2]="255,255,0,255"; $sub2pgm_c[3]="255,255,255,0"; $sub2pgm_c[4]="0,255,255,255"; $sub2pgm_c[5]="0,0,255,255"; $sub2pgm_c[6]="255,0,0,255"; $sub2pgm_c[7]="255,255,0,0"; $sub2pgm_c[8]="0,255,0,255"; $sub2pgm_c[9]="0,255,255,0"; $sub2pgm_c[10]="255,0,255,0"; $sub2pgm_parm1 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[1], -value => 1, -command => \&show_pgm_sub ); $sub2pgm_parm2 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[2], -value => 2, -command => \&show_pgm_sub ); $sub2pgm_parm3 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[3], -value => 3, -command => \&show_pgm_sub ); $sub2pgm_parm4 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[4], -value => 4, -command => \&show_pgm_sub ); $sub2pgm_parm5 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[5], -value => 5, -command => \&show_pgm_sub ); $sub2pgm_parm6 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[6], -value => 6, -command => \&show_pgm_sub ); $sub2pgm_parm7 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[7], -value => 7, -command => \&show_pgm_sub ); $sub2pgm_parm8 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[8], -value => 8, -command => \&show_pgm_sub ); $sub2pgm_parm9 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[9], -value => 9, -command => \&show_pgm_sub ); $sub2pgm_parm10 = $page2_frame1_1 -> Radiobutton( -variable => \$sub2pgm_parm, -text => $sub2pgm_c[10], -value => 10, -command => \&show_pgm_sub ); $sub2pgm_parm1 -> pack( -anchor => 'w'); $sub2pgm_parm2 -> pack( -anchor => 'w'); $sub2pgm_parm3 -> pack( -anchor => 'w'); $sub2pgm_parm4 -> pack( -anchor => 'w'); $sub2pgm_parm5 -> pack( -anchor => 'w'); $sub2pgm_parm6 -> pack( -anchor => 'w'); $sub2pgm_parm7 -> pack( -anchor => 'w'); $sub2pgm_parm8 -> pack( -anchor => 'w'); $sub2pgm_parm9 -> pack( -anchor => 'w'); $sub2pgm_parm10 -> pack( -anchor => 'w'); #--------------------------- Previous/Next PGM-subtitle buttons ---------------------------------------------------- $page2_frame1_2 = $page2_frame1 -> Frame() -> pack( -fill => 'x' ); $prev_pgm_button = $page2_frame1_2 -> Button( -text => 'Previous PGM subtitle', -command => sub { if ( $pgm_min >= 2 and $sub2pgm_parm ) { $pgm_min -= 2; &show_pgm_sub; } } ); $next_pgm_button = $page2_frame1_2 -> Button( -text => 'Next PGM subtitle', -command => sub { if ( $pgm_min <= 57 and $sub2pgm_parm ) { $pgm_min += 2; &show_pgm_sub; } } ); $prev_pgm_button -> pack( -side => 'left'); $next_pgm_button -> pack( -side => 'left', -fill => 'x', -expand => 'y' ); #---------------------------------------------------------------------------------------------------------- #--------------------------- Continue button ---------------------------------------------------- $continue_button = $page2_frame1 -> Button( -text => ' >>> Continue (generate PGM subtitles) >>> ', -command => sub { &make_subtitles; } ); $continue_button -> pack( -side => 'left', -fill => 'x', -expand => 'y' ); #---------------------------------------------------------------------------------------------------------- #--------------------------- PGM subtitle display area ---------------------------------------------------- $sub_disp = $page2 -> Canvas() -> pack ( -side => 'left', -anchor => 'n', -ipady => 5, -ipadx => 5, -fill => 'both', -expand => 'y' ); #---------------------------------------------------------------------------------------------------------- #*************************************************** #******* PAGE 3 ****************************************************************** #------------------- PGM subtitle view area --------------- $page3_main_frame1 = $page3 -> LabFrame( -label => 'PGM subtitle view', -labelside => 'acrosstop' ) -> pack( -expand => 'y', -fill => 'both' ); $sub_view = $page3_main_frame1 -> Canvas( -height => 100 ) -> pack ( -side => 'top', -anchor => 'n', -ipady => 5, -ipadx => 5, -fill => 'both', -expand => 'y' ); $page3_main_frame3 = $page3 -> Frame() -> pack( -fill => 'both' ); #$main_frame3_label1 = $page3_main_frame3 -> Label( -text => '+/- height of the text row') -> pack( -side => 'left' ); #&NumEntry($page3_main_frame3,-textvariable=>\$row_height,-width=>0,-minvalue=>10,-maxvalue=>99) -> pack( -side => 'left'); #$main_frame3_label2 = $page3_main_frame3 -> Label( -text => 'Move up/down the text row') -> pack( -side => 'left'); #&NumEntry($page3_main_frame3,-textvariable=>\$row_position,-width=>0,-minvalue=>0,-maxvalue=>999) -> pack( -side => 'left'); $page3_main_frame2 = $page3 -> Frame() -> pack( -fill => 'both' ); $page3_frame1 = $page3_main_frame2 -> Frame() -> pack ( -side => 'left' ); $page3_frame2 = $page3_main_frame2 -> Frame() -> pack ( -side => 'right', -fill => 'both', -expand => 'y' ); $txt_sub_view = $page3_frame2 -> Scrolled('Text', -width => 50, -height => 10, -scrollbars => 'e' ) -> pack( -fill => 'both', -expand => 'y' ); $err_log_frame = $page3_frame2 -> LabFrame ( -label => 'Error log view', -labelside => 'acrosstop' ) -> pack( -fill => 'both' ); $err_log_view = $err_log_frame -> Scrolled('Text', -width => 50, -height => 4, -scrollbars => 'e' ) -> pack( -fill => 'both' ); $resume_btn = $page3_frame2 -> Button( -text => 'Resume', -padx => 3, -pady => 3, -command => \&look_for_pix_char ) -> pack( -side => 'left' ); $skip_btn = $page3_frame2 -> Button( -text => 'Restart subtitle', -padx => 3, -pady => 3, -command => \&restart_sub ) -> pack( -side => 'left' ); $skip_btn = $page3_frame2 -> Button( -text => 'Skip subtitle', -padx => 3, -pady => 3, -command => \&skip_sub ) -> pack( -side => 'left' ); $txt_btn2 = $page3_frame2 -> Button( -text => 'Save and exit', -padx => 3, -pady => 3, -command => \&save_exit ) -> pack( -side => 'left' ); #--------------------------------- pix row moving buttons ------------------------------------ $page3_frame1_subframe = $page3_frame1 -> LabFrame( -label => 'Subtitle row correction', -labelside => 'acrosstop' ) -> pack( -fill => 'both' ); $page3_frame1_subframe1 = $page3_frame1_subframe -> Frame() -> pack( -side => 'left' ); $moveup_button = $page3_frame1_subframe1 -> Button ( -text => 'Move up', -command => sub { &move_pix_row("up"); } ) -> pack( -side => 'top', -fill => 'both' ); $movedown_button = $page3_frame1_subframe1 -> Button ( -text => 'Move down', -command => sub { &move_pix_row("down"); } ) -> pack( -fill => 'both' ); $page3_frame1_subframe2 = $page3_frame1_subframe -> Frame() -> pack( -side => 'left', -fill => 'both', -expand => 'y' ); $taller_button = $page3_frame1_subframe2 -> Button ( -text => 'Taller', -command => sub { &move_pix_row("taller"); } ) -> pack( -side => 'top', -fill => 'both' ); $shorter_button = $page3_frame1_subframe2 -> Button ( -text => 'Shorter', -command => sub { &move_pix_row("shorter"); } ) -> pack( -fill => 'both' ); #---------------------------------------------------------------------------------------------- $page3_labframe1 = $page3_frame1 -> LabFrame( -label => 'Enter recognised char(s)', -labelside => 'acrosstop' ) -> pack( -fill => 'both' ); $char_view = $page3_labframe1 -> Canvas( -width => 200, -height => 80 ) -> pack (); $enter_char = $page3_labframe1 -> Entry( -width => 10, -font => 'Utopia 25' ) -> pack( -side => 'top' ); $enter_char -> bind( '', \&process_subtitle ); $ignore_button = $page3_labframe1 -> Button ( -text => 'Ignore all such patterns', -command => sub { $recognized_char = "+ignore+"; unshift(@char_pix_columns,$recognized_char); push(@{$ocr_database{$ocr_key}},[@char_pix_columns]); $last_ocr_key = $ocr_key; $enter_char -> delete( '0', 'end' ); &process_subtitle; } ) -> pack ( -fill => 'both' ); $page3_labframe2 = $page3_frame1 -> LabFrame( -label => 'OCR parameters', -labelside => 'acrosstop', ) -> pack( -fill => 'both' ); $parms_subframe1 = $page3_labframe2 -> Frame() -> pack( -anchor => 'w' ); $ocr_parm_label1 = $parms_subframe1 -> Frame() -> pack( -side => 'left' ); $ocr_parm1_label = $ocr_parm_label1 -> Label( -text => 'Min space width:' ) -> pack( -anchor => 'w' ); $ocr_parm2_label = $ocr_parm_label1 -> Label( -text => 'Max diacritics distance:' ) -> pack( -anchor => 'w' ); $ocr_parm3_label = $ocr_parm_label1 -> Label( -text => 'Max characters overlapping:' ) -> pack( -anchor => 'w' ); $ocr_parm_entry1 = $parms_subframe1 -> Frame() -> pack(); #$ocr_parm1_entry = $ocr_parm_entry1 -> Entry() -> pack(); &NumEntry($ocr_parm_entry1,-textvariable=>\$min_space_width,-width=>2,-minvalue=>1,-maxvalue=>99) -> pack( -anchor => 'w' ); &NumEntry($ocr_parm_entry1,-textvariable=>\$max_diacr_dist ,-width=>2,-minvalue=>1,-maxvalue=>99) -> pack( -anchor => 'w' ); &NumEntry($ocr_parm_entry1,-textvariable=>\$max_char_over ,-width=>2,-minvalue=>0,-maxvalue=>9 ) -> pack( -anchor => 'w' ); $split_chars = 0; #$split_chars_checkbtn = $page3_labframe2 -> Checkbutton( -text => 'Split merged chars', # -variable => \$split_chars # ) -> pack( -anchor => 'w' ); $page3_labframe3 = $page3 -> LabFrame( -label => 'Subtitles progression', -labelside => 'acrosstop' ) -> pack( -fill => 'both' ); $progress_bar = $page3_labframe3 -> ProgressBar( -from => 0, -to => 500, -blocks => 500, -gap => 0, -colors => [0,'blue'] ) -> pack( -side => 'bottom', -fill => 'both' ); #---------------------------------------------------------- #******* PAGE 4 ****************************************************************** $page4_labframe1 = $page4 -> LabFrame( -label => 'Assignment of recognized pattern', -labelside => 'acrosstop' ) -> pack( -side => 'left', -anchor => 'nw' ); $pattern_view = $page4_labframe1 -> Canvas( -width => 200, -height => 80 ) -> pack(); $pattern_assign = $page4_labframe1 -> Entry( -width => 10, -font => 'Utopia 25' ) -> pack(); #$pattern_assign > bind( '', \&reassign ); $reassign_button = $page4_labframe1 -> Button( -text => 'Re-assign', -command => \&reassign ) -> pack( -fill => 'x' ); $del_pattern_button = $page4_labframe1 -> Button( -text => 'Delete pattern', -command => \&del_pattern ) -> pack( -fill => 'x' ); $del_pattern_button = $page4_labframe1 -> Button( -text => 'Ignore all such patterns', -command => \&reassign_ignore ) -> pack( -fill => 'x' ); $page4_labframe1_subframe1 = $page4_labframe1 -> Frame() -> pack(); $pattern_begin_btn = $page4_labframe1_subframe1 -> Button( -text => '|<', -command => sub { &pattern_switch("begin"); } ) -> pack( -side => 'left' ); $pattern_prev_btn = $page4_labframe1_subframe1 -> Button( -text => '<', -command => sub { &pattern_switch("prev"); } ) -> pack( -side => 'left' ); $pattern_next_btn = $page4_labframe1_subframe1 -> Button( -text => '>', -command => sub { &pattern_switch("next"); } ) -> pack( -side => 'left' ); $pattern_end_btn = $page4_labframe1_subframe1 -> Button( -text => '>|', -command => sub { &pattern_switch("end"); } ) -> pack( -side => 'right' ); $page4_labframe2 = $page4 -> LabFrame( -label => 'List of characters assigned to patterns', -labelside => 'acrosstop' ) -> pack(); $assigns_list_scrolled = $page4_labframe2 -> Scrolled( 'Listbox', -scrollbars => 'e', -width => 10, -height => 25 ) -> pack( -anchor => 'w' ); #---------------------------------------------------------- #******************************************************************* # E N D OF GUI F O R M S D E F I N I T I O N S #******************************************************************* #/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ #\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ #/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\ #\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/ #******************************************************************* # HERE STARTS THE MAIN CODE #******************************************************************* $counter = 0; #progression bar counter &load_config; MainLoop(); print "here the code continues in non-Tk end-part\n"; &save_config(0); if ( $ocr_save_file ne "" ) { &save_ocr_database; } if ( $clear_dir ) { unlink(<$HOME/.gpgm2srt/*.pgm>); #delete generated PGM files unlink(<$HOME/.gpgm2srt/*.srtx>); unlink(<$HOME/.gpgm2srt/*.source>); } #--- CLOSE AND DELETE TEMPORARY FILES --- print "Enjoy the subtitles ;-)\n"; #******************************************************************* # HERE ENDS THE MAIN CODE #******************************************************************* #******************************************************************* # P R O C E D U R E S S E C T I O N #******************************************************************* #=============================================================================== # sub is called by pressing the "Save and exit" button on PAGE3 sub save_exit { open(OUTPUT, ">$txt_sub_file"); $output_text = $txt_sub_view -> get('0.0','end'); print OUTPUT "$output_text"; close(OUTPUT); $mw -> destroy(); } #------------------------------------------------------------------------------- #=============================================================================== sub save_subtitles { open(OUTPUT, ">$txt_sub_file"); $output_text = $txt_sub_view -> get('0.0','end'); print OUTPUT "$output_text"; close(OUTPUT); } #------------------------------------------------------------------------------- #=============================================================================== sub check_files { my( $continue ) = 1; $subtitles_file = $enter_subtitles_file -> get(); #file containing picture subtitles $txt_sub_file = $enter_save_file -> get(); #file to save txt subtitles into $ocr_load_file = $enter_ocr_load_file -> get(); #file containing ocr database to be used $ocr_save_file = $enter_ocr_save_file -> get(); #file to save ocr database into if ( ! -d $HOME."/.gpgm2srt" ) { $call_status = system( "mkdir ~/.gpgm2srt" ); if ( $call_status != 0 ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Can't create directory\n~/.gpgm2srt\nand exiting.", -type => 'OK', -icon => 'warning' ); exit(); } } if ( ! -r $subtitles_file ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Can't read subtitles source file\n$subtitles_file", -type => 'OK', -icon => 'warning' ); $continue = 0; print '! -r $subtitles_file'; } if ( $txt_sub_file eq "" ) { $txt_sub_file = $subtitles_file.".srt"; } if ( -e $txt_sub_file ) { $answer = $mw -> messageBox( -title => 'pgm2srt warning', -message => "The target SRT file\n$txt_sub_file\nalready exists. Overwrite it?", -type => 'YesNo', -icon => 'warning', -default => 'No' ); if ( $answer eq "No" ) { $txt_sub_file = ""; $continue = 0; print '-e $txt_sub_file'; } else { unlink($txt_sub_file); } } if ( $ocr_load_file ne "" and ! -r $ocr_load_file ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Can't read OCR database source file\n$ocr_load_file", -type => 'OK', -icon => 'warning' ); $continue = 0; print '$ocr_load_file ne "" and ! -r $ocr_load_file'; } if ( -e $ocr_save_file ) { $answer = $mw -> messageBox( -title => 'pgm2srt warning', -message => "The target OCR database file\n$ocr_save_file\nalready exists. Overwrite it?", -type => 'YesNo', -icon => 'warning', -default => 'No' ); if ( $answer eq "No" ) { $ocr_save_file = ""; $continue = 0; print '-e $ocr_save_file'; } else { unlink($ocr_save_file); } } if ( $txt_sub_file ne "" and $continue == 1 ) { $continue = &test_file_creation_possibility($txt_sub_file); } if ( $ocr_save_file ne "" and $continue == 1 ) { $continue = &test_file_creation_possibility($ocr_save_file); } if ( $continue == 1 ) { $note_book -> pageconfigure('page1', -state => 'disabled' ); $note_book -> pageconfigure('page2', -state => 'disabled' ); $note_book -> pageconfigure('page3', -state => 'normal' ); $sub2pgm_parm = 1; $note_book -> raise('page3'); # print "subtitles_file:$subtitles_file\n"; # print "srt_sub_file:$srt_sub_file\n"; } } #------------------------------------------------------------------------------- #=============================================================================== sub test_file_creation_possibility { my( $check_file ) = @_; my( $check_file_test ); $check_file_test = $check_file.".pgm2srt.write.ability.test"; if ( open(TEST,">$check_file_test") ) { close(TEST); unlink($check_file_test); return 1; } else { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Can't create file\n$check_file", -type => 'OK', -icon => 'warning' ); return 0; } } #------------------------------------------------------------------------------- #=============================================================================== sub open_file_dialog { my ( $old_file ); $subtitles_file = $enter_subtitles_file -> get(); #file containing picture subtitles if ( -e $subtitles_file ) { $old_file = $subtitles_file; } $subtitles_file = $mw -> getOpenFile( -title => 'Open DVD subtitles source file', -filetypes => [ [ 'All Files','*' ] ] ); print "subtitles_file:$subtitles_file\n"; if ( -e $subtitles_file ) { $enter_subtitles_file -> delete( '0', 'end' ); $enter_subtitles_file -> insert( '0', $subtitles_file ); } else { if ( -e $old_file ) { $subtitles_file = $old_file; } else { $enter_subtitles_file -> delete( '0', 'end' ); $subtitles_file = ""; } } } #------------------------------------------------------------------------------- #=============================================================================== sub save_file_dialog { $subtitles_file = $enter_subtitles_file -> get(); #file containing picture subtitles if ( -e $subtitles_file ) { ($srt_sub_file) = $subtitles_file =~ /.*\/([^\/].*)\..*/; if ( $srt_sub_file eq "" ) { ($srt_sub_file) = $subtitles_file =~ /.*\/([^\/].*)/; } $srt_sub_file .= ".srt"; ($srt_sub_folder) = $subtitles_file =~ /(.*)\/.*/; } else { $srt_sub_file = "subtitles.srt"; } $txt_sub_file = $mw -> getSaveFile( -title => 'Save SRT(TXT) subtitles as', -defaultextension => '.srt', -filetypes => [ ['SRT subtitles files',['.srt','.srtx']], ['All Files','*'] ], -initialfile => $srt_sub_file, -initialdir => $srt_sub_folder ); $srt_sub_file = $txt_sub_file; $enter_save_file -> delete( '0', 'end' ); $enter_save_file -> insert( '0', $txt_sub_file ); # print "subtitles_file:$subtitles_file\nsrt_sub_file:$srt_sub_file\ntxt_sub_file:$txt_sub_file\n"; # print "srt_sub_folder:$srt_sub_folder\n"; } #---------------------------------------------------------------------------------------------------------- #=============================================================================== sub save_ocr_dialog { $subtitles_file = $enter_subtitles_file -> get(); #file containing picture subtitles if ( -e $subtitles_file ) { ($ocr_save_file) = $subtitles_file =~ /.*\/([^\/].*)\..*/; if ( $ocr_save_file eq "" ) { ($ocr_save_file) = $subtitles_file =~ /.*\/([^\/].*)/; } $ocr_save_file .= ".pgm2srt"; ($ocr_save_folder) = $subtitles_file =~ /(.*)\/.*/; } else { $ocr_save_file = "subtitles.pgm2srt"; } $ocr_s_file = $mw -> getSaveFile( -title => 'Save OCR database as', -defaultextension => '.pgm2srt', -filetypes => [ ['gpgm2srt OCR database files','.pgm2srt'], ['All Files','*'] ], -initialfile => $ocr_save_file, -initialdir => $ocr_save_folder ); $ocr_save_file = $ocr_s_file; $enter_ocr_save_file -> delete( '0', 'end' ); $enter_ocr_save_file -> insert( '0', $ocr_save_file ); # print "subtitles_file:$subtitles_file\nsrt_sub_file:$srt_sub_file\ntxt_sub_file:$txt_sub_file\n"; # print "srt_sub_folder:$srt_sub_folder\n"; } #---------------------------------------------------------------------------------------------------------- #=============================================================================== sub open_ocr_dialog { my ( $old_file ); $ocr_load_file = $enter_ocr_load_file -> get(); #file containing picture subtitles if ( -e $ocr_load_file ) { $old_file = $ocr_load_file; } $ocr_load_file = $mw -> getOpenFile( -title => 'Load pgm2srt OCR database', -defaultextension => '.pgm2srt', -filetypes => [ ['gpgm2srt OCR database files','.pgm2srt'], ['All Files','*'] ] ); print "ocr_load_file:$ocr_load_file\n"; if ( -e $ocr_load_file ) { $enter_ocr_load_file -> delete( '0', 'end' ); $enter_ocr_load_file -> insert( '0', $ocr_load_file ); } else { if ( -e $old_file ) { $ocr_load_file = $old_file; } else { $enter_ocr_load_file -> delete( '0', 'end' ); $ocr_load_file = ""; } } if ( $ocr_load_file ne "" ) { if ( -r $ocr_load_file ) { &load_ocr_database; } else { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Can't open file\n$ocr_file", -type => 'OK', -icon => 'warning' ); } } } #---------------------------------------------------------------------------------------------------------- #=============================================================================== # called by buttons on NOTEPAD Page 2 when selecting -c parameter # shows preview of subtitles under selected -c parameter sub show_pgm_sub { $pgm_file = $HOME."/.gpgm2srt/test_pgm_subtitle0001.pgm"; &extract_pgm_sub; if ( $call_status == 0 ) { &pgm_to_text; &draw_pgm_sub; } else { $sub_disp -> delete('all'); $sub_disp -> create( 'text', 150, 100, -text => 'Nothing to display. Choose other option.', -fill => 'red' ); } } #---------------------------------------------------------------------------------------------------------- #=============================================================================== #input: array @pixel_column_as_txt must contain PGM-subtitle transformed into text columns # draws pgm subtitle preview in NOTEBOOK Page 2 sub draw_pgm_sub { $sub_disp -> delete('all'); for ( $i=0; $i < $pgm_height; $i++ ) { for ( $j=0; $j < $pgm_width; $j++ ) { # if ( $i*$pix_size+$pix_size < PREV_HEIGHT and $j*$pix_size+$pix_size < PREV_WIDTH and substr($pixel_column_as_txt[$j],$i,1) eq "#" ) { if ( substr($pixel_column_as_txt[$j],$i,1) eq "#" ) { $sub_disp -> create( 'line', $j*$pix_size, #x1_coord $i*$pix_size, #y1_coord $j*$pix_size+$pix_size, #x2_coord $i*$pix_size+$pix_size, #y2_coord -fill => 'black' ); } } } # $sub_disp -> after(500, sub { $sub_disp -> itemconfigure('all', -fill => 'grey'); } ) } #---------------------------------------------------------------------------------------------------------- #=============================================================================== #input: variable $subtitles_file must contain name (full path) of file with subtitle stream for subtitle2pgm # extracts only one PGM subtitle file in order to show its preview sub extract_pgm_sub { $subtitles_file_bash = $subtitles_file; $subtitles_file_bash =~ s/ /\\ /g; # print "subtitle2pgm -o ~/.gpgm2srt/test_pgm_subtitle -c $sub2pgm_c[$sub2pgm_parm] -C 5 -e 0:$pgm_min:0,1 < $subtitles_file_bash\n"; $call_status = system("subtitle2pgm -o ~/.gpgm2srt/test_pgm_subtitle -c $sub2pgm_c[$sub2pgm_parm] -C 5 -e 0:$pgm_min:0,1 < $subtitles_file_bash"); } #---------------------------------------------------------------------------------------------------------- #=============================================================================== # called by the CONTINUE button on NOTEPAD Page 2 sub make_subtitles { # TEMPORARY COMMENT &generate_subtitles; $note_book -> pageconfigure('page4', -state => 'normal' ); $note_book -> pageconfigure('page5', -state => 'normal' ); $note_book -> raise('page4'); $note_book -> pageconfigure('page3', -state => 'disabled' ); &exact_match_ocr; } #---------------------------------------------------------------------------------------------------------- #=============================================================================== #input: variable $subtitles_file_bash must contain bash-like full path to file with subtitles stream for subtitle2pgm # using subtitle2pgm generates all PGM subtile files contained in file genetaded by tcexctact sub generate_subtitles { $sub_disp -> delete('all'); $sub_disp -> create( 'text', 150, 100, -text => 'Please wait while generating PGM subtitles...', -fill => 'red' ); $sub_disp -> update(); unlink(<$HOME/.gpgm2srt/*.pgm>); #delete previous subtitles PGM files unlink(<$HOME/.gpgm2srt/*.srtx>); # print "subtitle2pgm -o ~/.gpgm2srt/subtitles -c $sub2pgm_c[$sub2pgm_parm] -C 5 < $subtitles_file_bash\n"; $call_status = system("subtitle2pgm -o ~/.gpgm2srt/subtitles -c $sub2pgm_c[$sub2pgm_parm] -C 5 < $subtitles_file_bash"); if ( $call_status != 0 ) { print "Error by subtitle2pgm, trying with -C 0 parameter...\n"; unlink(<$HOME/.gpgm2srt/*.pgm>); #delete previous subtitles PGM files unlink(<$HOME/.gpgm2srt/*.srtx>); # print "subtitle2pgm -o ~/.gpgm2srt/subtitles -c $sub2pgm_c[$sub2pgm_parm] -C 0 < $subtitles_file_bash\n"; $call_status = system("subtitle2pgm -o ~/.gpgm2srt/subtitles -c $sub2pgm_c[$sub2pgm_parm] -C 0 < $subtitles_file_bash"); if ( $call_status != 0 ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Error occured while generating PGM subtitles. Try to handle but it will take some more time.", -type => 'OK', -icon => 'warning' ); unlink(<$HOME/.gpgm2srt/*.pgm>); #delete previous subtitles PGM files unlink(<$HOME/.gpgm2srt/*.srtx>); # print "subtitle2pgm -o ~/.gpgm2srt/subtitles -c $sub2pgm_c[$sub2pgm_parm] < $subtitles_file_bash\n"; $call_status = system("subtitle2pgm -o ~/.gpgm2srt/subtitles -c $sub2pgm_c[$sub2pgm_parm] < $subtitles_file_bash"); if ( $call_status != 0 ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Uncatchable error occured while generating PGM subtitles. See console for subtitle2pgm's error messages. Exiting...", -type => 'OK', -icon => 'warning' ); exit(); } $start_time = "0:0:0"; $postfix = ""; $num_of_last_pgm_processed = 0; system("mv -f ~/.gpgm2srt/subtitles.srtx ~/.gpgm2srt/subtitles_all.srtx"); open(SRTX_TIMING,"$HOME/.gpgm2srt/subtitles_all.srtx") or die("Can't open $HOME/.gpgm2srt/subtitles_all.srtx\n"); do { # print "subtitle2pgm -o ~/.gpgm2srt/subtitles$postfix -e $start_time,9999 -c $sub2pgm_c[$sub2pgm_parm] -C 5 < $subtitles_file_bash\n"; print "Restarting subtitle2pgm from $start_time\n"; $call_status = system("subtitle2pgm -o ~/.gpgm2srt/subtitles$postfix -e $start_time,9999 -c $sub2pgm_c[$sub2pgm_parm] -C 5 < $subtitles_file_bash"); if ( $postfix ne "" ) { &rename_pgm_files; } &get_start_point; $postfix = "2_"; } while ( $call_status != 0 ); close(SRTX_TIMING); system("mv -f ~/.gpgm2srt/subtitles_all.srtx ~/.gpgm2srt/subtitles.srtx"); } } } #---------------------------------------------------------------------------------------------------------- #=============================================================================== # in case of subtitle2pgm error looks for last done subtitle, skips one and looks for next subtitle timing sub get_start_point { my( $row, $current_sub_num ); open(SRTX_DONE,"$HOME/.gpgm2srt/subtitles$postfix.srtx") or die("Can't open $HOME/.gpgm2srt/subtitles$postfix.srtx\n"); while ( chomp($row=) ) { if ( $row =~ /^\d+$/ ) { $num_of_last_pgm_processed++; } } $num_of_last_pgm_processed++; #include errorous PGM subtitle # print "num_of_last_pgm_processed:$num_of_last_pgm_processed\n"; while ( chomp($row=) ) { ($current_sub_num) = $row =~ /^(\d+)$/; if ( $num_of_last_pgm_processed+1 == $current_sub_num ) { chomp($row=); ( $start_time ) = $row =~ /^(.*),\d* -->/; # print "start_time:$start_time\n"; last; } } close(SRTX_DONE); } #---------------------------------------------------------------------------------------------------------- #=============================================================================== sub rename_pgm_files { my( $kept_pgm, $replaced_pgm, $count ); $count = $num_of_last_pgm_processed + 1; open(SRTX_DONE,"$HOME/.gpgm2srt/subtitles$postfix.srtx") or die("Can't open $HOME/.gpgm2srt/subtitles$postfix.srtx\n"); while ( chomp($row=) ) { if ( $row =~ /pgm\.txt/ ) { ( $kept_pgm ) = $row =~ /(subtitles2_.*pgm)/; if ( $count > 999 ) { $replaced_pgm = "subtitles".$count.".pgm"; } elsif ( $count < 10 ) { $replaced_pgm = "subtitles000".$count.".pgm"; } elsif ( $count < 100 ) { $replaced_pgm = "subtitles00".$count.".pgm"; } elsif ( $count < 1000 ) { $replaced_pgm = "subtitles0".$count.".pgm"; } # print "mv -f ~/.gpgm2srt/$kept_pgm ~/.gpgm2srt/$replaced_pgm\n"; system("mv -f ~/.gpgm2srt/$kept_pgm ~/.gpgm2srt/$replaced_pgm"); $count++; } } close(SRTX_DONE); } #---------------------------------------------------------------------------------------------------------- #=============================================================================== #input: variable $pgm_file must content full path to PGM subtitle file #output: array @pixel_column_as_txt containing PGM subtitle in text form sub pgm_to_text { my ( $record, @header ); open( PGM_SOURCE, $pgm_file) or die ("Can't open file \'$pgm_soubor\'!\n"); for ( $i=1 ; $i <= 3 ; $i++) { $header[$i] = ; } $header_length = length($header[1].$header[2].$header[3])+4; ( $pgm_width, $pgm_height ) = $header[3] =~ /(\d+)\s(\d+)/; close(PGM_SOURCE); open( PGM_SOURCE, $pgm_file) or die ("Can't open file \'$pgm_soubor\'!\n"); read( PGM_SOURCE, $record, $header_length ); #skip in PGM-file behind header @pixel_column_as_txt = (); #def pixel_column_as_txt - array contains txt representation of the whole PGM subtitle picture # - first upper row has index 0 @pixel_row_filled = (); #def pixel_row_filled - marks pixel rows containing at least one filled pixel in order to extract subtitle text rows # - first upper row has index 0 for ( $j=0 ; $j < $pgm_height ; $j++) { #pixel rows iteration read( PGM_SOURCE, $record, $pgm_width ); #reads the whole pixel row for ( $i = 0; $i < $pgm_width ; $i++ ) { #pixel columns iteration for one row if ( ord(substr($record,$i,1)) > 0 ) { $pixel_column_as_txt[$i] .= " "; } else { $pixel_column_as_txt[$i] .= "#"; $pixel_row_filled[$j] = 1; } } } close(PGM_SOURCE); } #------------------------------------------------------------------------------- #=============================================================================== sub exact_match_ocr { $subtitles_count = &sub_count; # print "number of subtitles:$subtitles_count\n"; if ( $subtitles_count == 0 ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "No PGM subtitles found. Exiting...", -type => 'OK', -icon => 'warning' ); exit(0); } unless ( open ( SRTX_SOURCE, $HOME."/.gpgm2srt/subtitles.srtx" ) ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Can't open file\n$HOME./.gpgm2srt/subtitles.srtx\n. Exiting...", -type => 'OK', -icon => 'warning' ); exit(); } $sub_number = 0; #text subtile counter $sub_timing_avail = 0; #whether to look up for subtitle timing or not # $sub_processed = 0; #whether to print subtitle $all_processed = 0; #whether to end OCR process $ocr_column = 0; $origin_ocr_column = 0; $restart = 0; #restart given subtitle OCR when manualy shifted the row if ( $sub_timing_avail == 0 ) { &get_sub_timing; } if ( $sub_timing_avail == 1 ) { &look_for_pix_char; } } #----------------------------------------------------------------------------------------------- #=============================================================================================== # called every time new PGM subtitle is needed i.e. the current PGM subtitle is processed sub get_sub_timing { # print "getting sub timing...\n"; if ( $subtitle_text ne "" ) { &print_subtitle; $subtitle_text = ""; } while ( chomp($sub_timing = ) ) { if ( $sub_timing =~ /^\s*$/ ) { next; } #looks up for subtitle timing while ( $sub_timing !~ /-->/ ) { chomp($sub_timing = ); } #next row after subtlitle timing should be PGM file full path chomp($pgm_file = ); #looks up for png subtitle file name while ( $pgm_file !~ /pgm/ ) { chomp($pgm_file = ); } if ( $pgm_file ne "" ) { ( $pgm_file ) = $pgm_file =~ /(.*).txt/; if ( -e $pgm_file ) { $sub_number ++; $sub_timing_avail = 1; $sub_row_avail = 0; #whether to look for/extract pixels forming one subtitle row $counter = $sub_number/$subtitles_count*500; $progress_bar -> value($counter); $progress_bar -> update(); $top_row = 0; $bottom_row = 0; $pgm_drawn = 0; &pgm_to_text; &pgm_preview; last; } else { $answer = $mw -> messageBox( -title => 'gpgm2srt Message', -message => "No proper PGM file\n$pgm_file\nfound. Exiting...", -type => 'OK', -icon => 'warning' ); $mw -> destroy(); } } else { print "Probably end of SRTX file.\n"; close (SRTX_SOURCE); } } if ( $sub_timing eq "" ) { print "Probably end of SRTX file - setting all_processed\n"; close (SRTX_SOURCE); $all_processed = 1; } # print "$sub_number\n"; # print "$sub_timing\n"; # print "$pgm_file\n"; } #---------------------------------------------------------------------------------------------------------- #=============================================================================================== #This procedure is called by Entry box biding (after Enter pressed) sub process_subtitle { $recognized_char = $enter_char -> get(); # $sub_view -> focus; #take focus off the entry if ( $recognized_char eq "I" ) { $check_for_I++; $answer = $mw -> messageBox( -title => 'gpgm2srt Message', -message => "It is recomended to enter lowercase L instead of uppercase i.\nDVD subtitles usually doesn't distinguish these patterns\nand for subsequent text postprocessing it's more easy to replace l with I.", -type => 'OK', -icon => 'warning' ); $enter_char -> delete( '0', 'end' ); $enter_char -> insert( 'end', 'l' ); } else { if ( $recognized_char ne "" ) { $subtitle_text .= $recognized_char; #SAVE RECOGNIZED PATTERN INTO MEMORY - GLOBAL HASH: unshift(@char_pix_columns,$recognized_char); push(@{$ocr_database{$ocr_key}},[@char_pix_columns]); $last_ocr_key = $ocr_key; # print"Saving pattern with key $ocr_key\n"; } if ( $sub_timing_avail == 0 ) { &get_sub_timing; } if ( $all_processed == 1 ) { #OCR process may end on two places - here is place 1 # &page5_raise; print "All the subtitles processed(place 1).\n"; &save_subtitles; $mw -> destroy(); } else { &look_for_pix_char; } } } #------------------------------------------------------------------------------------------------ #========================================================================================================== # This procedure is called for the first time by sub exact_match_ocr (after png subs generation) and # every next time is called by the sub process_subtitle sub look_for_pix_char { $enter_char -> delete( '0', 'end' ); $preview_shaded = 0; #whether the subtitle preview is active (unknown pattern) or inactive (known pattern) # sub row fully processed if ( $ocr_column >= @process_pixel_columns and $bottom_row > $min_height ) { #column index is array size - 1 $sub_row_avail = 0; $top_row = $bottom_row + 1; } if ( $restart == 1 ) { &extract_sub_row; $restart = 0; $ocr_column = 0; $origin_ocr_column = 0; $subtitle_text = ""; #doplnit dalsi upravy promennych pro restart OCR po posunu hranic radku print "OCR restarted...\n"; } do { &guess_sub_row if ( $sub_row_avail == 0 ); if ( $all_processed == 0 ) { $prev_ocr_column = $ocr_column; $char_in_database = 0; #procedure in Exactocr module ($ocr_column,$space_detected,$error_occured,@char_pix_columns) = &find_char($ocr_column,length($process_pixel_columns[0]),$min_space_width,$max_diacr_dist,$max_char_over,$split_chars,' ','#',@process_pixel_columns); if ( $error_occured == 1 ) { #some more handling of catched error ??? $err_log_view -> insert( 'end', "Problem occured in subtitle no. $sub_number\n" ); # print ERROR_LOG "Problem occured in subtitle no. $sub_number\n"; print "Problem occured in subtitle no. $sub_number\n"; } if ( $space_detected == 1 ) { $subtitle_text .= " "; } if ( @char_pix_columns > 0 ) { $recognized_char = &check_ocr_database(@char_pix_columns); if ( $recognized_char ne "" ) { $char_in_database = 1; if ( $preview_shaded == 0 ) { &shade_preview(1); } if ( $recognized_char ne "+ignore+" ) { $subtitle_text .= $recognized_char; } } else { $char_in_database = 0; if ( $preview_shaded == 1 and $pgm_drawn == 1 ) { &shade_preview(0); } if ( $pgm_drawn == 0 ) { &pgm_preview; } if ( $lines_drawn == 0 ) { &draw_row_lines; } } } else { #PGM subtitle processed - procees with next $char_in_database = 1; #to keep looping in while (... $recognized_char = "+ignore+"; #to skip subtitle_text adding $sub_row_avail = 0; $top_row = $bottom_row + 1; #TEST NA ALL_PROCESSED ??? } $ocr_column ++; } } while ( $char_in_database == 1 and $all_processed == 0 ); if ( $char_in_database == 0 and $all_processed == 0 ) { &pattern_preview; $enter_char -> focus; } if ( $all_processed == 1 ) { #OCR process may end on two places - here is place 2 # &page5_raise; print "All the subtitles processed(place 2).\n"; &save_subtitles; $mw -> destroy(); } } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== # When known pattern is found shade subtitle preview and delete pattern preview area # parm (1) tells to shade the pattern # parm (0) tells to unshade the pattern sub shade_preview { my ( $shade ) = @_; if ( $shade == 1 ) { $char_view -> delete('all'); # $char_view -> itemconfigure( 'points', -fill => 'grey' ); # $sub_view -> itemconfigure( 'points', -fill => 'grey' ); $char_view -> update(); # $sub_view -> update(); $preview_shaded = 1; # print"shading preview...\n"; } else { # $char_view -> itemconfigure( 'points', -fill => 'red' ); # $sub_view -> itemconfigure( 'points', -fill => 'black' ); # $char_view -> update(); # $sub_view -> update(); $preview_shaded = 0; } } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== #at the beginning counts the number of PGM files sub sub_count { my ( $subtitles_count ) = 1; $pgm_sub_file = $HOME."/.gpgm2srt/subtitles".sprintf("%04d",$subtitles_count).".pgm"; while ( -e $pgm_sub_file ) { $subtitles_count ++; $pgm_sub_file = $HOME."/.gpgm2srt/subtitles".sprintf("%04d",$subtitles_count).".pgm"; } $subtitles_count --; return $subtitles_count; } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== #input: array @pixel_column_as_txt must contain PGM-subtitle transformed into text columns # displays the whole PGM subtitle sub pgm_preview { my ( $i, $j ); if ( $char_in_database == 0 ) { $sub_view -> delete('all'); $rectangle_drawn = 0; for ( $i=0; $i < $pgm_height; $i++ ) { for ( $j=0; $j < $pgm_width; $j++ ) { # if ( $i*$pix_size+$pix_size < PREV_HEIGHT and $j*$pix_size+$pix_size < PREV_WIDTH and substr($pixel_column_as_txt[$j],$i,1) eq "#" ) if ( substr($pixel_column_as_txt[$j],$i,1) eq "#" ) { $sub_view -> create( 'line', $j, #x1_coord $i, #y1_coord $j+1, #x2_coord $i+1, #y2_coord -fill => 'black', -tags => 'points' ); } } } $sub_view -> update(); $pgm_drawn = 1; } else { $sub_view -> itemconfigure( 'points', -fill => 'grey' ); $sub_view -> delete('pattern'); $rectangle_drawn = 0; $sub_view -> update(); } # $sub_disp -> after(500, sub { $sub_disp -> itemconfigure('all', -fill => 'grey'); } ) } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub pattern_preview { my ( $i, $j ); if ( $rectangle_drawn == 1 ) { $sub_view -> delete( 'pattern' ); } $sub_view -> create( 'rectangle', $left_frontier+$ocr_column-@char_pix_columns-1, $top_row, $left_frontier+$ocr_column-2, $bottom_row, -outline => 'red', -tags => 'pattern' ); $rectangle_drawn = 1; $char_view -> delete('all'); for ( $j=0; $j<@char_pix_columns; $j++ ) { #loop through columns for ( $i=0; $i<=length($char_pix_columns[$j]); $i++ ) { #loop through rows if ( substr($char_pix_columns[$j],$i,1) eq "#" ) { $char_view -> create( 'line', $j+10, #x1_coord 70-$i, #y1_coord $j+11, #x2_coord 71-$i, #y2_coord -fill => 'red', -tags => 'points' ); } } } } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== # Tries to guess what pixel rows form one subtitle text row # Also draws primary frontier lines sub guess_sub_row { # print "guess sub row...\n"; if ( $subtitle_text ne "" ) { $subtitle_text .= '|'; } $sub_view -> delete('top_frontier'); $sub_view -> delete('bottom_frontier'); $lines_drawn = 0; $sub_row_avail = 0; while ( $pixel_row_filled[$top_row] == 0 and $top_row < $pgm_height ) { $top_row ++; } if ( ($top_row + $min_height) <= $pgm_height ) { # should be only less than ??? $bottom_row = $top_row + 1; # $top_row contains the first filled pixel row while ( $pixel_row_filled[$bottom_row] == 1 or ( $bottom_row - $top_row < $min_height ) ) { #should substract 1? $bottom_row ++; } $bottom_row --; if ( $bottom_row - $top_row > $min_height ) { #should substract 1? if ( $char_in_database == 0 ) { &draw_row_lines; } &extract_sub_row; $ocr_column = 0; $origin_ocr_column = 0; } } else { # $sub_processed = 1; # print "sub processed (guess_sub_row)\n"; &get_sub_timing; } } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub draw_row_lines { $sub_view -> create( 'line', 0, #x1_coord $top_row, #y1_coord $pgm_width, #x2_coord $top_row, #y2_coord -fill => 'blue', -tags => 'top_frontier' ); $sub_view -> create( 'line', 0, #x1_coord $bottom_row, #y1_coord $pgm_width, #x2_coord $bottom_row, #y2_coord -fill => 'blue', -tags => 'bottom_frontier' ); $lines_drawn = 1; } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== # Extracts (from @$pixel_column_as_txt) and re-orders (to @process_pixel_columns) pixel rows forming one text subtitle row sub extract_sub_row { #substract relating pixels #pixel rows must be in reverse order (because of Exactocr subs requirements) #leading and trailing empty columns should be cutted off @process_pixel_columns = (); #look for the first and last non-empty pixel column # NOT MUCH EXACT METHOD AND THIS WAY USELESS - MUST CHECK ONLY PART OF PIX COLUMN NOT ENTIRE COLUMN $right_frontier = $pgm_width - 1; while ( index( substr($pixel_column_as_txt[$right_frontier],$top_row,$bottom_row-$top_row+1) ,"#") < 0 ) { $right_frontier --; } $left_frontier = 0; while ( index( substr($pixel_column_as_txt[$left_frontier],$top_row,$bottom_row-$top_row+1) ,"#") < 0 ) { $left_frontier ++; } for ( $i = $left_frontier ; $i <= $right_frontier ; $i++ ) { #pixel columns iteration for ( $j = $bottom_row ; $j >= $top_row ; $j-- ) { #pixel rows iteration $process_pixel_columns[$i-$left_frontier] .= substr($pixel_column_as_txt[$i],$j,1); } } $sub_row_avail = 1; $max_shift_down = 0; } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub print_subtitle { @subtitle_rows = split(/\|/,$subtitle_text); #save every new subtitle to avoid data/text lost # if ( -e $HOME."/.gpgm2srt/subtitle.srt" ) { # # open (SRT_NEW, ">>$HOME/.gpgm2srt/subtitle.srt") #append if file already exists # # } else { # # open (SRT_NEW, ">$HOME/.gpgm2srt/subtitle.srt") #create file # # } # # print SRT_NEW "$sub_number\n$sub_timing\n"; # foreach $subtitle_row ( @subtitle_rows ) { # print SRT_NEW "$subtitle_row\n"; # } # print SRT_NEW "\n"; # # close (SRT_NEW); #print newly recognized subtitle into the text box $txt_sub_view -> insert( 'end', "$sub_number\n$sub_timing\n" ); foreach $subtitle_row ( @subtitle_rows ) { $txt_sub_view -> insert( 'end', "$subtitle_row\n" ); } $txt_sub_view -> insert( 'end', "\n" ); $txt_sub_view -> see('end'); } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub move_pix_row { my ( $action ) = @_; $restart = 1; $enter_char -> delete( '0', 'end' ); $sub_view -> delete( 'pattern' ); $rectangle_drawn = 0; $sub_row_available = 0; if ( $action eq "up" ) { if ( $top_row > 0 ) { $sub_view -> move( 'top_frontier', 0, -1 ); $sub_view -> move( 'bottom_frontier', 0, -1 ); $top_row --; $bottom_row --; } } elsif ( $action eq "down" ) { if ( $bottom_row < $pgm_height ) { $sub_view -> move( 'top_frontier', 0, 1 ); $sub_view -> move( 'bottom_frontier', 0, 1 ); $top_row ++; $bottom_row ++; } } elsif ( $action eq "taller" ) { if ( $bottom_row < $pgm_height ) { $sub_view -> move( 'bottom_frontier', 0, 1 ); $bottom_row ++; } } elsif ( $action eq "shorter" ) { if ( $bottom_row > $top_row + $min_height ) { $sub_view -> move( 'bottom_frontier', 0, -1 ); $bottom_row --; } } } #---------------------------------------------------------------------------------------------------------- #====================================================================================== sub skip_sub { &print_subtitle; $subtitle_text = ""; &get_sub_timing; &look_for_pix_char; } #---------------------------------------------------------------------------------------------------------- #====================================================================================== sub restart_sub { $subtitle_text = ""; $sub_timing_avail = 1; $sub_row_avail = 0; #whether to look for/extract pixels forming one subtitle row $top_row = 0; $bottom_row = 0; $pgm_drawn = 0; &pgm_preview; &look_for_pix_char; } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub pattern_switch { my ( $action ) = @_; my ( @ocr_set_pointers, @ocr_set, $character, $i, $j ); if ( %ocr_database > 0 ) { if ( $assigns_list_scrolled -> index('end') > 0 ) { $assigns_list_scrolled -> selectionClear($list_pos); } if ( $action eq "init" ) { $list_pos = -1; $actual_key_num = -1; @keys_list = keys(%ocr_database); #all ocr_keys in the OCR database $assigns_list_scrolled -> delete('0', 'end'); for ( $i=0; $i < @keys_list ; $i++ ) { @ocr_set_pointers = @{$ocr_database{$keys_list[$i]}}; $ocr_set_size = @ocr_set_pointers; for ( $j=0; $j < $ocr_set_size ; $j++ ) { @ocr_set = @{$ocr_set_pointers[$j]}; $character = ' '.shift(@ocr_set); $assigns_list_scrolled -> insert('end', $character); if ( $actual_key_num == -1 ) { $list_pos++; } } if ( $keys_list[$i] == $last_ocr_key ) { $actual_key_num = $i; $ocr_set_intra_pos = $ocr_set_size - 1; } } } if ( $action eq "prev" ) { if ( $ocr_set_intra_pos > 0 ) { $ocr_set_intra_pos--; $list_pos--; } elsif ( $actual_key_num > 0 ) { $actual_key_num--; @ocr_set_pointers = @{$ocr_database{$keys_list[$actual_key_num]}}; $ocr_set_size = @ocr_set_pointers; $ocr_set_intra_pos = $ocr_set_size - 1; $list_pos--; } } if ( $action eq "next" ) { if ( $ocr_set_intra_pos < $ocr_set_size - 1 ) { $ocr_set_intra_pos++; $list_pos++; } elsif ( $actual_key_num < @keys_list - 1 ) { $actual_key_num++; $ocr_set_intra_pos = 0; $list_pos++; } } if ( $action eq "begin" ) { $actual_key_num = 0; $ocr_set_intra_pos = 0; $list_pos = 0; } if ( $action eq "end" ) { $actual_key_num = @keys_list - 1; @ocr_set_pointers = @{$ocr_database{$keys_list[$actual_key_num]}}; $ocr_set_size = @ocr_set_pointers; $ocr_set_intra_pos = $ocr_set_size - 1; $list_pos = ($assigns_list_scrolled -> index('end')) - 1; } $assigns_list_scrolled -> selectionSet($list_pos); $assigns_list_scrolled -> see($list_pos); $pattern_assign -> delete('0', 'end'); # print "$actual_key_num\n"; # print "$keys_list[$actual_key_num]\n"; # print "$ocr_database{$keys_list[$actual_key_num]}\n"; @ocr_set_pointers = @{$ocr_database{$keys_list[$actual_key_num]}}; $ocr_set_size = @ocr_set_pointers; # print"ocr_set_size:$ocr_set_size\n"; @ocr_set = @{$ocr_set_pointers[$ocr_set_intra_pos]}; $character = shift(@ocr_set); # print"$character\n"; $pattern_assign -> insert('0', $character ); &ocr_pattern_view(@ocr_set); } } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub reassign { my( $new_char ); $new_char = $pattern_assign -> get(); if ( $new_char and %ocr_database ) { $assigns_list_scrolled -> delete($list_pos); $assigns_list_scrolled -> insert($list_pos, ' '.$new_char); $assigns_list_scrolled -> selectionSet($list_pos); # print"$ocr_database{$keys_list[$actual_key_num]}\n"; # print"${$ocr_database{$keys_list[$actual_key_num]}}[$ocr_set_intra_pos]\n"; # print"${${$ocr_database{$keys_list[$actual_key_num]}}[$ocr_set_intra_pos]}[0]\n"; ${${$ocr_database{$keys_list[$actual_key_num]}}[$ocr_set_intra_pos]}[0] = $new_char; } else { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "To re-assign the pattern insert some char. To delete the pattern press Delete button.", -type => 'OK', -icon => 'warning' ); } } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub reassign_ignore { $pattern_assign -> delete('0', 'end'); $pattern_assign -> insert('0', "+ignore+" ); &reassign; } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub del_pattern { my( $del_intra_pos, $del_key_num, $del_set_size ); if ( %ocr_database ) { $del_key_num = $actual_key_num; $del_intra_pos = $ocr_set_intra_pos; $del_set_size = $ocr_set_size; &pattern_switch("prev"); if ( $del_key_num > 0 ) { $assigns_list_scrolled -> delete($list_pos+1); } else { $assigns_list_scrolled -> delete($list_pos); } if ( $del_set_size > 1 ) { splice( @{$ocr_database{$keys_list[$del_key_num]}}, $del_intra_pos, 1); } else { delete( $ocr_database{$keys_list[$del_key_num]} ); splice( @keys_list, $del_key_num, 1); if ( @keys_list == 0 ) { $pattern_view -> delete('all'); $pattern_assign -> delete('0', 'end'); } } if ( $del_key_num == 0 ) { &pattern_switch("begin"); } } } #---------------------------------------------------------------------------------------------------------- #========================================================================================================== sub ocr_pattern_view { my ( @pixels ) = @_; $pattern_view -> delete('all'); for ( $j=0; $j<@pixels; $j++ ) { #loop through columns for ( $i=0; $i<=length($pixels[$j]); $i++ ) { #loop through rows if ( substr($pixels[$j],$i,1) eq "#" ) { $pattern_view -> create( 'line', $j+10, #x1_coord 70-$i, #y1_coord $j+11, #x2_coord 71-$i, #y2_coord -fill => 'red', -tags => 'points' ); } } } } #---------------------------------------------------------------------------------------------------------- #=============================================================================== sub save_ocr_database { my ( @ocr_set, $set_size, $ocr_pattern ); open (OCR, ">$ocr_save_file") or die ("Can't create file $ocr_save_file\n"); print OCR "gpgm2srt data file ver.",$VERSION,"\n"; print OCR "Contains recognized patterns of releted PGM subtitles.\n"; print OCR "File format:\n"; print OCR " % -refers to keys of hash %ocr_databaze - each key is derived from the shape of\n"; print OCR " recognized pattern in the way that the number of visible pixels in each column\n"; print OCR " is progressively multiplied by power of 2 and these values are cumulated.\n"; print OCR " > -refers to the pointer to array which contains TXT pixel-columns; because the\n"; print OCR " hash keys ARE NOT unique, several recognized patterns can be assigned to one hash\n"; print OCR " key - that's why patterns are stored into arrays under keys.\n"; print OCR " -it is array of arrays, items of this array are poiters to final arrays of patterns.\n"; print OCR " A -refers to final array, which contains TXT representation of A pattern. The first item\n"; print OCR " of the array contains char of A, next array items are pixel columns transferred to text\n"; print OCR " beginning from the bottom pixel towards top pixel.\n"; print OCR "\n"; print OCR "Parameters for displaying:\n"; print OCR "-p #\n"; #for compatibility with console version print OCR "-b \n"; #for compatibility with console version print OCR "-a .\n"; #for compatibility with console version print OCR "\n"; foreach $ocr_key ( keys(%ocr_database) ) { print OCR "%","$ocr_key\n"; foreach $ocr_pattern ( @{$ocr_database{$ocr_key}} ) { @ocr_set = @$ocr_pattern; $set_size = @ocr_set; print OCR ">","$ocr_set[0]\n"; for ( $i = 1; $i < $set_size; $i++ ) { print OCR "$ocr_set[$i]\n"; } } } close(OCR); } #------------------------------------------------------------------------------- #=============================================================================== sub load_ocr_database { my ( @ocr_set, $row, $char, $ocr_point, $ocr_space, $ocr_shade ); open (OCR, "$ocr_load_file") or die ("Can't open file $ocr_load_file\n"); while ( chomp($row = ) ) { if ( $row =~ /$\-p/ ) { ( $ocr_point ) = $row =~ /$\-p (.)/; print "TXT representation of pixel: \'$ocr_point\'\n"; } if ( $row =~ /$\-b/ ) { ( $ocr_space ) = $row =~ /$\-b (.)/; print "TXT representation of space: \'$ocr_space\'\n"; } if ( $row =~ /$\-a/ ) { ( $ocr_shade ) = $row =~ /$\-a (.)/; print "TXT representation of shadow: \'$ocr_shade\'\n"; } while ( index($row,"%") == 0 ) { ($ocr_key) = substr($row,1); chomp($row = ); while ( index($row,">") == 0 ) { ($char) = substr($row,1); if ( $char eq "" ) { close(OCR); $note_book -> pageconfigure('page5', -state => 'diabled' ); die "Wrong format of OCR database!!!\n"; } @ocr_set = (); $ocr_set[0] = $char; chomp($row = ); # print "%",$ocr_key,"\n>",$char,"\n"; while ( $row ne "" and index($row,"%")<0 and index($row,">")<0 ) { $radek =~ s/$ocr_point/\#/go; $radek =~ s/$ocr_space/\ /go; push(@ocr_set,$row); chomp($row = ); } push(@{$ocr_database{$ocr_key}},[@ocr_set]); } } } close (OCR); $note_book -> pageconfigure('page5', -state => 'normal' ); } #------------------------------------------------------------------------------- #====================================================================================== sub list_dvd_sid { my($dvd_command,$row,@sid_list); @sid_list = (); $call_status = system( "mplayer | grep MPlayer &>~/mplayer_info.gpgm2srt" ); open(MPLAYER,"$HOME/mplayer_info.gpgm2srt"); chomp( $row= ); close(MPLAYER); if ( -f "$HOME/mplayer_info.gpgm2srt" ) { unlink("$HOME/mplayer_info.gpgm2srt"); } if ( $row =~ /MPlayer\ 0/ ) { $dvd_command = "-dvd "; } if ( $row =~ /MPlayer\ 1/ ) { $dvd_command = "dvd://"; } if ( $dvd_command ne "" ) { $call_status = system( "mplayer $dvd_command$dvd_title_num -v -vo null -nosound -frames 0 -dvd-device $dvd_dev &>~/sid_info.gpgm2srt" ); if ( $call_status != 0 ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Error reading DVD\nor error while writing to home dir", -type => 'OK', -icon => 'warning' ); } else { open(SID,"$HOME/sid_info.gpgm2srt"); while ( chomp($row=) ) { if ( $row =~ /.*sid.*/ ) { push(@sid_list,$row); } } close(SID); $sid_list_text -> delete( '0.0', 'end' ); if ( @sid_list > 0 ) { foreach $row ( @sid_list ) { $sid_list_text -> insert( 'end', "$row\n" ); } } else { $sid_list_text -> insert( 'end', "No subtitles found\n" ); } } if ( -f "$HOME/sid_info.gpgm2srt" ) { unlink("$HOME/sid_info.gpgm2srt"); } } else { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "MPlayer probably not installed", -type => 'OK', -icon => 'warning' ); } } #---------------------------------------------------------------------------------------------------------- #====================================================================================== sub extract_sub_stream { if ( ! -d $HOME."/.gpgm2srt" ) { $call_status = system( "mkdir ~/.gpgm2srt" ); if ( $call_status != 0 ) { $answer = $mw -> messageBox( -title => 'pgm2srt Warning', -message => "Can't create directory\n~/.gpgm2srt\nand exiting.", -type => 'OK', -icon => 'warning' ); exit(); } } if ( $dvd_sid_num < 0 ) { $dvd_sid_num = 0; } if ( $dvd_sid_num > 15 ) { $sid_code = "3".chr(48+$dvd_sid_num-16); } elsif ( $dvd_sid_num > 9 ) { $sid_code = "2".chr(87+$dvd_sid_num); } else { $sid_code = "2".chr(48+$dvd_sid_num); } if ( $sub_stream_src == 1 ) { #handle DVD extraction print "Extracting sub stream from DVD...\n"; $wait_label -> configure( -text => 'Extracting subtitles, please wait...' ); $wait_label -> update(); print "tccat -i $dvd_dev -T $dvd_title_num -L | tcextract -a 0x$sid_code -x ps1 -t vob > $HOME/.gpgm2srt/subtitles.source\n"; $call_status = system( "tccat -i $dvd_dev -T $dvd_title_num -L | tcextract -a 0x$sid_code -x ps1 -t vob > $HOME/.gpgm2srt/subtitles.source" ); $wait_label -> configure( -text => ' ' ); $wait_label -> update(); $subtitles_file = "$HOME/.gpgm2srt/subtitles.source"; $enter_subtitles_file -> delete( '0', 'end' ); $enter_subtitles_file -> insert( '0', $subtitles_file ); $note_book -> raise('page2'); } elsif ( $sub_stream_src == 2 ) { #handle dumpstream extraction if ( -r $dumpstream_file ) { $wait_label -> configure( -text => 'Extracting subtitles, please wait...' ); $wait_label -> update(); print "tcextract -i \"$dumpstream_file\" -a 0x$sid_code -x ps1 > $HOME/.gpgm2srt/subtitles.source\n"; $call_status = system( "tcextract -i \"$dumpstream_file\" -a 0x$sid_code -x ps1 > $HOME/.gpgm2srt/subtitles.source" ); $wait_label -> configure( -text => ' ' ); $wait_label -> update(); $subtitles_file = "$HOME/.gpgm2srt/subtitles.source"; $enter_subtitles_file -> delete( '0', 'end' ); $enter_subtitles_file -> insert( '0', $subtitles_file ); $note_book -> raise('page2'); } } } #---------------------------------------------------------------------------------------------------------- #====================================================================================== sub open_dumpstream { # $dumpstream_file = ""; $dumpstream_file = $mw -> getOpenFile( -title => 'Open subtitles source file' ); if ( -e $dumpstream_file ) { $sub_stream_src = 2; } } #---------------------------------------------------------------------------------------------------------- #====================================================================================== sub set_dvd_dev { my( $old_dvd_dev ); $old_dvd_dev = $dvd_dev; $dvd_dev = $mw -> getOpenFile( -title => 'Set DVD device', -initialdir => '/dev' ); if ( $dvd_dev eq "" ) { $dvd_dev = $old_dvd_dev; } $sub_stream_src = 1; } #---------------------------------------------------------------------------------------------------------- #====================================================================================== sub load_config { my( $row,$variable,$value ); #main configuration file if ( -e "$HOME/.gpgm2srt.conf" ) { open (CONFIG,"$HOME/.gpgm2srt.conf") or die ("Can't open config file in home directory\n"); while ( chomp($row=) ) { if ( $row ne "" and $row !~ /\#.*/ ) { ($variable) = $row =~ /(.*):/; ($value) = $row =~ /:(.*)/; ${$variable} = $value; if ( $load_conf == 0 ) { last; } } } close(CONFIG); } } #---------------------------------------------------------------------------------------------------------- #====================================================================================== sub save_config { my( $force_save ) = @_; if ( $save_conf == 1 or $force_save == 1 ) { open(CONFIG,">$HOME/.gpgm2srt.conf") or die ("Can't create config file in home directory\n"); print CONFIG "#Whether to load configuration on start or not - in order to load config must be firt variable in list! and set to 1\n"; print CONFIG "load_conf:$load_conf\n\n"; print CONFIG "#Whether to save configuration on exit or not\n"; print CONFIG "save_conf:$save_conf\n\n"; print CONFIG "#DVD device to be used\n"; print CONFIG "dvd_dev:$dvd_dev\n\n"; print CONFIG "#Clear directory when finished\n"; print CONFIG "clear_dir:$clear_dir\n\n"; close(CONFIG); } } #---------------------------------------------------------------------------------------------------------- #====================================================================================== # This code is not mine - copied from vptk_w.pl by XXX and slightly modified: # Additionaly that code is partially copied from original NumEntry # Reason: the original widget does not support -textvariable (sic!) # Problems: No strict syntax control, No FireButton functionality sub NumEntry { my ($parent,%par)=@_; my $numentry; my $minvalue=delete $par{'-minvalue'}; my $maxvalue=delete $par{'-maxvalue'}; unless($def_bitmaps) { my $bits = pack("b8"x5, "........", "...11...", "..1111..", ".111111.", "........" ); $mw->DefineBitmap('INCBITMAP' => 8,5, $bits); # And of course, decrement is the reverse of increment :-) $mw->DefineBitmap('DECBITMAP' => 8,5, scalar reverse $bits); $def_bitmaps=1; } my $result=$parent->Frame(); if ( $par{'-width'} > 0 ) { $numentry=$result->Entry(%par)->pack(-anchor=>'w', -side=>'left'); $numentry->bind('', [\&inc_num_controlled,$par{'-textvariable'},1,$minvalue,$maxvalue]); $numentry->bind('', [\&inc_num_controlled,$par{'-textvariable'},-1,$minvalue,$maxvalue]); } $result->Button(-bitmap=>'INCBITMAP',-cursor=>'left_ptr',-command=> [\&inc_num_controlled,$par{'-textvariable'},1,$minvalue,$maxvalue]) ->pack(-anchor=>'nw', -side=>'top'); $result->Button(-bitmap=>'DECBITMAP',-cursor=>'left_ptr',-command=> [\&inc_num_controlled,$par{'-textvariable'},-1,$minvalue,$maxvalue]) ->pack(-anchor=>'nw', -side=>'top'); return $result; } sub inc_num_controlled { shift if ref($_[0]) ne 'SCALAR'; my ($ptr,$inc,$minvalue,$maxvalue)=@_; my $value=$$ptr+$inc; $$ptr=$value; $$ptr=$minvalue if length $minvalue && $value<$minvalue; $$ptr=$maxvalue if length $maxvalue && $value>$maxvalue; } #-----------------------------------------------------------------------------------------------