#!/usr/bin/perl 
#############################

    use strict;
    use Tk 8.0;
    use Tk::ROText;
    use Cwd;
    use Tk::FileSelect;
    use Tk::NoteBook;
    use Tk::LabEntry;

    require Tk::FileSelect;
    require Tk::ROText;
    require Tk::NoteBook;
    require Tk::LabEntry;
    require TK::DialogBox;

# remove extra perl window
#if( 'MSWin32' eq $^O ) {
#     require Win32::GUI; 
#    # Win32::GUI->import(); # Pretend to be 'use' ??? 
#    my ($DOS) = Win32::GUI::GetPerlWindow(); 
#    Win32::GUI::Hide($DOS); 
#} 

# default start frame
my $start = 1;

# default end frame
my $end = 2000;

# default search pattern
my $search_pattern = "H\#.tga";

# default size sensitivity
my $size_sensitive = 50;

# default number of entries per line
my $entriesPerLine  = 50;

# default startup folder
my $folder = Cwd::cwd();

# default refresh speed in seconds
my $refresh_speed = 60;

# in seconds -  DANGER! should be >= 10
my $fastest_refresh = 10; 

# refresh on OK to start prog
my $refresh_on_OK = 0;

##########################################

my $version = "HuntTK v1.06";
my $name = "htk";
my $win_title = "";
my $refresh_id = ();

my $main = MainWindow->new;


###############
# hunt global vars
###############
my $pad        =();
my $ispad        = 0;
my @final_frames = ();
my @start_frames = ();
my $gBlankFileSize  = 11264;
my $gFlagCheckBlank = 0;
# refresh on?
my $isRefresh = 0;

# display characters

my $gCharNormal       = ".";
my $gCharZero         = "0";
my $gCharMissing      = "*";
my $gCharQuestionable = "?";
my $gCharBlank        = "B";
my $gPrefix           = ();
my $gSuffix          = ();

###############
# help text
###############

my ($helptxt) = <<"assignment";

$name Help:
Program written by Darren Patterson
    darren\@dougstruthers.com

ALT-P    => Preferences

SPACE    => Refresh
ALT-R     => Refresh
F5    => Refresh

ALT-Q    => Quit

-------------------------------

Command line arguments:
htk [-] [FOLDER]
  If supplied, $name points itself at FOLDER 
  The optional '-' makes $name refresh in FOLDER on opening

assignment

################
# menu frame 
################

my ($menubar) = $main->Menu;
$main->configure (-menu => $menubar);

my $filemenu = $menubar->cascade(-label => "~File",
        -tearoff => 0);

my $helpmenu = $menubar->cascade(-label => "~Help",
        -tearoff => 0);

##############
# file menu commands
###############

$filemenu->command(-command => \&getPrefs,
        -label => "Preferences... -- ALT-P",
        -underline => 0);
$filemenu->separator;

$filemenu->command(-label => "Refresh -- ALT-R",
        -command => \&refresh,
        -underline => 0);

$filemenu->separator;

$filemenu->command(-label => "Exit -- ALT-Q",
        -command => \&exit_choice,
        -underline => 1);

##############
# help menu commands
###############

$helpmenu->command(-command => \&print_help,
        -label => "Print Help",
        -underline => 6);

################
# main window
################

$main->title("$name");
$main->configure(-background=>'grey');

my $rframe = $main->Frame()->pack(-side => 'top', -expand => 'yes', -f
+ill => 'both',);

my $right = $rframe->Scrolled("ROText",
           -width  => 68,
                   -height => 16,
                   -background=>'white',
                   -wrap   => 'none',
                   -relief => 'sunken',
                   -scrollbars => 'osoe',
                   )->pack(-side   => 'right',
                       -fill   => 'both',
                       -expand => 1,
            );


#####################
# Status Bar
#####################

my $status_bar = $main->Label(-text => "Status Area",
        -relief => 'sunken',
        -borderwidth => 2,
        -anchor => 'w');

$status_bar->pack(-side => 'top', -fill => 'x');


#######################
# input the version
#######################

$right->insert('end',"$version\n");


#######################
# key bindings
#######################

$main->bind( '<Alt-r>' => \&refresh);  # bind 'Alt-r' to refresh 
$main->bind( '<F5>' => \&refresh); # bind 'F5' to refresh
$main->bind( '<space>' => \&refresh); # bind 'space' to refresh

$main->bind( '<Alt-F4>' => \&exit_choice); # bind 'Alt-F4' to quit
$main->bind( '<Alt-q>' => \&exit_choice); # bind 'Alt-q' to quit

$main->bind( '<Alt-p>' => \&getPrefs); # bind 'Alt-p' to get prefs


###################
# Check Arguments and possibly refresh
###################
 
&checkArgs;


###################
$refresh_id = Tk::After->new($main,$refresh_speed * 1000,'repeat',\&re
+fresh) if ($isRefresh);


##########################
# main loop (never returns)
##########################

MainLoop();


my $pref_window = ();

######################################################################
+##########
# End of Main
######################################################################
+##########

#########################
# sub routines
#########################


sub exit_choice {
    exit;
}

################

sub getPrefs {
if ($isRefresh) {
    $refresh_id->cancel;  # stop refreshing while opening prefs
}

if (not defined $pref_window) {


    $pref_window = $main->DialogBox(-title => "HuntTK Preferences",
        -buttons => ["OK", "Cancel"]);

    my $nb = $pref_window->add('NoteBook', -ipadx => 6, ipady => 6);


    my $pref_p = $nb->add("prefs", -label => "Preferences");
    my $refresh_p = $nb->add("refresh", -label => "Refresh");


    my $open = $pref_p->Button(-text=>"Open Folder...", -command => \&
+open_choice)->pack(-side => 'top',
        -anchor => "w",
        -expand    => "no",
        -padx => 4,
        -pady => 4);

    my $open_entry = $pref_p->Entry(-textvariable => \$folder,
        -width => 40)->pack(-expand => 1, 
            -side => "top",
            -anchor => "w");

    $pref_p->LabEntry(-label => "Start Frame:       ", 
        -labelPack => [-side => "left", -anchor => "w"],
        -width => 10,
        -textvariable => \$start,
        -background => 'white')->pack(-side => "top", -anchor => "nw")
+;
    $pref_p->LabEntry(-label => "End Frame:        ",
        -labelPack => [-side => "left", -anchor => "w"],
        -width => 10,
        -textvariable => \$end,
        -background => 'white')->pack(-side => "top", -anchor => "nw")
+;

    $pref_p->LabEntry(-label => "Search Pattern: ",
        -labelPack => [-side => "left", -anchor => "w"],
        -width => 20,
        -textvariable => \$search_pattern,
        -background => 'white')->pack(-side => "top", -anchor => "nw")
+;

    my $search_label = $pref_p->Label(-text => "(E.G. \"H\#.tga\")")->
+pack(-expand => 1, -side => "top", -anchor => 'nw');
    $pref_p->LabEntry(-label => "Empty Frame Size (bytes):",
        -labelPack => [-side => "left", -anchor => "w"],
        -width => 10,
        -textvariable => \$gBlankFileSize,
        -background => 'white')->pack(-side => "top", -anchor => "nw")
+;

    $pref_p->LabEntry(-label => "Size Sensitivity:",
        -labelPack => [-side => "left", -anchor => "w"],
        -width => 10,
        -textvariable => \$size_sensitive,
        -background => 'white')->pack(-side => "top", -anchor => "nw")
+;

    my $size_label = $pref_p->Label(-text => "(default is 50)")->pack(
+-expand => 1, -side => "top", -anchor => 'nw');

    $pref_p->LabEntry(-label => "Line Length:",
        -labelPack => [-side => "left", -anchor => "w"],
        -width => 10,
        -textvariable => \$entriesPerLine,
        -background => 'white')->pack(-side => "top", -anchor => "nw")
+;

    #####################
    # refresh_p entry
    #####################
    my $refresh_OK = $refresh_p->Checkbutton(-variable => \$refresh_on
+_OK,
        -text => "Refresh after clicking OK")->pack(-side => "top", -a
+nchor => "nw");

    my $refresh_check = $refresh_p->Checkbutton(-variable => \$isRefre
+sh,
        -text => "Refresh Interval On") -> pack(-side => "top", -ancho
+r => 'nw');

    $refresh_p->LabEntry(-label => "Refresh every (X) seconds:",
        -labelPack => [-side => "left", -anchor => "w"],
        -width => 10,
        -textvariable => \$refresh_speed,
        -background => 'white')->pack(-side => "top", -anchor => "nw")
+;


    ####################
    # bind
    ####################
    
    $nb->pack(-expand => "yes",
        -fill => "both",
        -padx => 5, -pady => 5,
        -side => "top");

    }  # end if (not defined...)

    my $ result = $pref_window->Show;
    if ($result =~ /OK/) {

        if ( $entriesPerLine < 10) {
            $entriesPerLine = 10;
        }

        if ($isRefresh) {
            if ( $refresh_speed < $fastest_refresh ) {
                $refresh_speed = $fastest_refresh;
            }
            $refresh_id = Tk::After->new($main,$refresh_speed * 1000,'
+repeat',\&refresh);
        }

        &get_env_vars;
        if ( $refresh_on_OK ) {
            &getTitle;
            &refresh;
        }
    }
    else {  
        # restore old refreshing status
        $refresh_id = Tk::After->new($main,$refresh_speed * 1000,'repe
+at',\&refresh) if ($isRefresh);
    }
    
}

################

sub get_env_vars {

    ##########################################
    # This handles ENV variables in the Prefs
    ##########################################

    my $env_variable = ();
    my $old_var = ();
    if ($folder =~ /\$/) {
        $env_variable = $folder;
        $env_variable =~ s/\/$// ;    # del trailing '/'

        # does the var have additional paths attached to it?

        if ( $env_variable =~ /\// ) {

            #loop and del folders    

            while ( $env_variable =~ /\//) { 
                $env_variable =~ s/(.*)\/.*/$1/ ;
            }
            $env_variable =~ s/\$// ;
            $old_var = $env_variable ;
            $env_variable = $ENV{"$env_variable"} ;

            $folder =~ s/^\$$old_var(.*)/$env_variable$1/ ;

        }
        else {
            $env_variable =~ s/\$// ;
            $env_variable = $ENV{"$env_variable"} ;

            $folder = $env_variable;

        }

    }

    ####################
    # end get_env_var
    ####################
}

#################

sub open_choice {

    &get_env_vars;

    my $fs = $pref_window->FileSelect
    (-directory        => "$folder", # Alias: -initialdir
     -initialfile      => "*",
     -filter           => "",   # only allow dir choices
     -filelabel        => "File",
     -filelistlabel    => "File List",
     -dirlabel         => "Look In...",
     -dirlistlabel     => "Directories",

     -verify           => ['-d'], # accept only dirs

     -acceptlabel      => "OK",
     -cancellabel      => "Cancel",
     -resetlabel       => "Reset",
     -homelabel        => "Home",
     -title            => "Choose a folder...",

    );
    my $newfolder = $fs->Show;


    if ($newfolder) {
    $folder = $newfolder;
    &getTitle;
    $main->title("$name - $win_title");
    }
    
}    

###################

sub doHunt {

    $right->delete(0.1,'end');

    $right->insert('end',"$version\n");
    $right->insert('end',&getDate."\n");


    &hunt;
}

###################

sub refresh {
    &getTitle;
    $main->title("$name - Refreshing $win_title...");

    my ($ymytopchar, $ymyposition) = $right->yview(); #save the curren
+t scroll pos
    my ($xmyleftchar, $xmyposition) = $right->xview();
#print "$xmyleftchar, $xmyposition, $ymytopchar, $ymyposition\n";
    
    &doHunt();
    if ($ymyposition == 1 && $ymytopchar != 0) {
        $right->yview(moveto=>$ymyposition); # stay at bottom of text 
+if already there
    }
    else {
        $right->yview(moveto=>$ymytopchar); # restore old y scroll pos
    }
    
    $right->xview(moveto=>$xmyleftchar); # restore old x scroll pos

    $main->title("$name - $win_title");
}

###################

sub getDate {

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) ; 
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(
+time);
    $mon++; 

    if ($min < 10)  { $min = "0$min";   }
    if ($hour < 10) { $hour = "0$hour"; }
    if ($mday < 10) { $mday = "0$mday"; }
    if ($mon < 10)  { $mon = "0$mon";  }
    if ($sec < 10)  { $sec = "0$sec"; }

    if ( $year < 1900 ) { $year = $year+1900; }       

    return "$mon/$mday/$year $hour:$min:$sec";

}

###################

sub getTitle {

    $win_title = $folder;
    
    $win_title =~ s/\/$// ;      # get rid of possible ending '/'
    $win_title =~ s/.*\/(.*)/$1/ ;    # del all but last folder in pat
+h

}

######################

sub print_help {
    $right->delete(0.1,'end');

    $right->insert('end',"$version\n");
    $right->insert('end',&getDate."\n");

    $right->insert('end',$helptxt);
    
    $main->title("$name");
    &update_status('Help');
}

#####################
#
# pass in value to be put into status bar
###########

sub update_status {

    my ($status_value) = @_;
    $status_bar->configure(-text => $status_value, -justify => 'left')
+;
}

#######################

sub checkArgs {
    if ($#ARGV eq 0) {
        $folder = $ARGV[0] ;
    }
    elsif ( $ARGV[0] eq '-' && $#ARGV eq 1 ) {
        $folder = $ARGV[1] ;

        &refresh();
    }
}


####################################

sub hunt {

    # global vars
    ##############

    $pad        =();
    $ispad        = 0;
    @final_frames = ();
    @start_frames = ();



    # get the prefix and suffix
    ($gPrefix, $gSuffix) = split (/\#/, $search_pattern);

    &getPadding(0);       # This gets the initial amount of padding ze
+ros
                # There are conditional statements inside of &driver t
+o remove
                #  zeros when the frame count increases.
    &driver;

}    # end sub hunt

######################

sub showLegend {
    $right->insert('end',"Legend:\n");
    $right->insert('end',"  $gCharNormal -> Normal Frame            $g
+CharMissing -> Missing Frame\n");
    $right->insert('end',"  $gCharZero -> Zero-Sized Frame        $gCh
+arQuestionable -> Questionable Frame\n");
    if ($gFlagCheckBlank == 1) {
    $right->insert('end', "  $gCharBlank -> Possible Blank Frame      
+  \n");
    } # if
} # showLegend



#################################################

sub getPadding {
    my ($i) = @_;

    $pad = "";
    my $theFileName = "${gPrefix}${i}${gSuffix}";
    my $thePath = "${folder}/${theFileName}";

    my $isfound = 0 ; 

    while (! $isfound ) {

        if (-e "$thePath") {
            $isfound = 1; 
            $ispad = 1;
        }
        else {
            $pad = $pad."0";
            $theFileName = "${gPrefix}${pad}${i}${gSuffix}";
            $thePath = "${folder}/${theFileName}";
            if ($pad eq "0000") {
                $pad = "";
                $isfound = 1; # stop looping
            }
        }

    }  # end while

}



###########################

sub showKeyFrames {

    my $status_value = "Start/End Frame(s): ";

    my $frame = 0;
    while ($start_frames[$frame]) {
        $status_value .= "[ $start_frames[$frame], $final_frames[$fram
+e] ]  -  ";
    $frame++;
    }
    &update_status ($status_value);
    $right->insert('end', "\n$status_value\n");
}


#################

sub driver {
    my ($thePath, $theFileName, $theCount, $deltaSize,
      $previousSize, $size);

    # check desintation directory for readability.
    if (!((-d $folder) && (-x $folder))) {
    die "Not a readable directory: ${folder}\n";
    } # if

    $right->insert('end',"Checking $folder from $start  to $end \n");

    $theCount        = 0;
    $previousSize    = -2;

    my $i = ();

    for ($i = $start; $i <= $end; $i++) {
    # line header
    if (!($theCount % $entriesPerLine)) {
        $right->insert('end',"$i\t ");
    } else {
        if (!($theCount % ($entriesPerLine / 2))) {
        $right->insert('end'," | ");
        } # if
    } # else


    ############################
    # remove padding if needed
    ############################

    if ($ispad && $i =~ /^10{1,}$/) {
        if ($i eq 10 ) {
            $pad =~ s/\d// ;
        }
        elsif ($i eq 100 ) {
            $pad =~ s/\d//; 
        }
        elsif ($i eq 1000 ) {
            $pad =~ s/\d//; 
        }
        elsif ($i eq 10000 ) {
            $pad =~ s/\d//; 
        }
    }
    if (! $ispad ) {
        &getPadding($i);
    }


    $theFileName = "${gPrefix}${pad}${i}${gSuffix}";
    $thePath = "${folder}/${theFileName}";
#    $right->insert('end',"Checking for: ${thePath}\n");
    if (!(-r $thePath)) {
        $right->insert('end', $gCharMissing);

        if ($previousSize ne -1) {
            push @final_frames, ${i}-1 ;
        }

        $previousSize = -1;

    } else {
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime
+,$ctime,$blksize,$blocks) = stat $thePath;

        # get possible starting frames
        ###############################

        if ($previousSize lt 0 && $size ge 0) {
            push @start_frames, ${i} ;
        }
    

        if ($size == 0) {
        $right->insert('end',$gCharZero);
        } elsif (($gFlagCheckBlank == 1) && ($size == $gBlankFileSize)
+)  {
        $right->insert('end',$gCharBlank);
        } else {
        if ($previousSize != 0) {
            $deltaSize = abs($size - $previousSize);
            if (($deltaSize / $previousSize) > ($size_sensitive / 100.
+0)) {
            $right->insert('end',$gCharQuestionable);
            } else {
            $right->insert('end',$gCharNormal);
            } # else
        } else {
            $right->insert('end', $gCharNormal);
        } # else
        } # else
        $previousSize = $size;
    } # else
    $theCount++;
    if (!($theCount % $entriesPerLine) || (($i + 1) > $end)) {
        $right->insert('end'," $i\n");
    } # if
    } # for i

    $right->insert('end',"\n");
    &showLegend;

    &showKeyFrames;

} # driver
################
[download]