#!/usr/local/ActiveTcl/bin/wish -f
 #
 # idimage.tcl --
 #
 #    This file is a Tcl/Tk based GUI for ImageMagick's identify utility.
 #
 # RCS:
 #
 #    $RCSfile: 4277,v $
 #    $Date: 2006-11-12 19:00:35 $
 #    $Revision: 1.5 $
 
 package require Tclx
 package require xmlgen
 namespace import ::xmlgen::*
 
 set run_time [clock format [clock scan now] -format {%D %T} ]
 
 # Specify the identify format flag descriptions and flag values. See 
 # http://www.imagemagick.org/script/command-line-options.php#format 
 # for -format flag descriptions and values.
 set format(File_Size) %b
 set format(Comment) %c
 set format(Directory) %d
 set format(Filename_Extension) %e
 set format(Filename) %f
 set format(Unique_Colors) %k
 set format(Label) %l
 set format(Magick) %m
 set format(Number_of_Scenes) %n
 set format(Output_Filename) %o
 set format(Page_Number) %p
 set format(Quantum_Depth) %q
 set format(Scene_Number) %s
 set format(Top_of_Filename) %t
 set format(Temporary_Filename) %u
 set format(X_Y_Resolution) "%x %y"
 set format(Geometry) %wx%h
 set format(Signature) %#
 
 # Declare tags used for XML output
 declaretag Images
 declaretag Image
 declaretag Input_Filename
 
 # Iterate through format flags and declare tags
 foreach format_element [array names format] {
   declaretag $format_element
 }
 
 # Set a title for the window
 wm title . "Tcl/Tk Identify"
 
 # Construct a frame which holds the menubar
 frame .mbar -relief raised -bd 2
 pack .mbar -side top -fill x
 
 #######################################
 #
 # Configure the menubar
 #
 #######################################
 
 # Top-level menu items: File, Options
 menubutton .mbar.file -text File -menu .mbar.file.menu -underline 0
 menubutton .mbar.options -text Options -menu .mbar.options.menu -underline 0
 pack .mbar.file .mbar.options -side left
 
 # File menu
 menu .mbar.file.menu -tearoff 0
 .mbar.file.menu add command -label Open -underline 0 -accelerator "Ctrl+O" \
         -command "file_dialog"
 
 .mbar.file.menu add command -label "Identify All" -underline 9 -accelerator \
         "Ctrl+A" -command "dir_dialog"
 .mbar.file.menu add command -label Quit -underline 0 -accelerator "Ctrl+Q" \
         -command exit 
 
 # Keyboard shortcuts for file menu options
 bind all <Control-o> {file_dialog}
 bind all <Control-a> {dir_dialog}
 bind all <Control-q> {exit}
 
 # Options menu
 menu .mbar.options.menu -tearoff 1
 
 # Populate the options menu
 foreach format_element [array names format] {
 
   # Substitute " " for "_" for display in options menu
   regsub -all "_" $format_element " " gui_format_element
 
   .mbar.options.menu add checkbutton -label "$gui_format_element" -variable \
           $format_element
 }
 
 
 #######################################
 #
 # Text widget to display output
 #
 #######################################
 
 text .text -relief flat -bd 2 -yscrollcommand ".scroll set" -font \
         -adobe-courier-medium-r-*-*-12-*-*-*-*-*-*-*
 
 # Enable gridding in the text widget
 .text configure -setgrid 1
 
 scrollbar .scroll -command ".text yview"
 pack .scroll -side right -fill y
 # Pack the text widget so it fills both axes and will expand to fill screen
 pack .text -side left -fill both -expand 1
 
 
 # Procedure: file_dialog --
 #
 # Produce a dialog box that will allow the user open an individual file.
 #
 # Arguments:
 #    None
 #
 # Results:
 #    Passes a file name to the identify_file procedure.
 
 proc file_dialog {} {
 
   # This is used as an attribute value for the Images tag
   global run_time
 
   set types {
     {{All Files}        {*}}
   }
 
   set file [tk_getOpenFile -filetypes $types]
 
   if {$file != ""} {
   
     # Clear contents of text area
     .text delete 0.0 end
 
     set id_out [identify_file $file]
     set xml_out [Images date=$run_time $id_out]
     .text insert end $xml_out
   }
 }
 
 
 # Procedure: identify_file --
 #
 # Execute identify using the user designated options and show the results in
 # the text widget.
 #
 # Arguments:
 #    Name of file to identify.
 #
 # Results:
 #    Identify results written to text widget.
 
 proc identify_file {thisfile} {
 
   set flags [identify_options]
 
   set result [catch {exec identify -format "$flags" $thisfile} msg]
 
   if {$result==0} {
     set id_out [Image $msg]
     return $id_out
   } else {
     
     # An error has occurred, so inform user and continue
     .text insert end "An exception has occurred:\n$msg"
   }
 
 }
 
 
 # Procedure: identify_options --
 # 
 # Creates a string of -format flags based upon what the user checks in the
 # Options menu.
 #
 # Arguments:
 #    None
 #
 # Results:
 #    A string of -format flags and additional formatting elements.
 
 proc identify_options {} {
 
   # Make format array available to this proc
   global format
 
   # Input filename is the default flag
   set flags " [Input_Filename {%i}]\n"
 
   foreach format_element [array names format] {
 
     global $format_element
     set format_element_checked $$format_element
 
     regsub -all "_" $format_element " " gui_format_element
 
     if [expr $format_element_checked] {
       append flags [$format_element $format($format_element)]\n
     }
   }
 
   return $flags
 }
 
 
 # Procedure: dir_dialog --
 # 
 # Open a directory chooser dialog box
 #
 # Arguments:
 #    None
 #
 # Results:
 #    A directory name passed to the identify_all procedure.
 
 proc dir_dialog {} {
   
   set dir [tk_chooseDirectory -mustexist 1]
 
   if {$dir != ""} {
 
     # Clear contents of text area
     .text delete 0.0 end
 
     # Readdir puts the names of all files in the target dir in a list.
     set files [readdir $dir]
     identify_all $dir $files
   }
 }
 
 
 # Procedure: identify_all --
 # 
 # 
 #
 # Arguments:
 #    A directory name.
 #
 # Results:
 #    Pass each filename within the target directory to the identify_file
 #    procedure.
 
 proc identify_all {dir files} {
 
   # This is used as an attribute value for the Images tag
   global run_time
 
   # Identify each file and append results to id_out
   foreach file $files {
     append id_out [identify_file $dir/$file]
   }
 
   set xml_out [Images date=$run_time $id_out]
   .text insert end $xml_out  
 }