#!/usr/bin/tclsh
 
 #
 # This program reads an X11 rgb.txt file that holds a small, simple
 # database that maps color names to RGB component values.  It then
 # displays the colors in alphabetical order allowing the user to
 # preview each color.
 #
 # It is possible to pipe the colors into this program.  Just make sure
 # you specify the rgb.txt file on the command line as "-".  For
 # example, the following command line will display the "black" and
 # "white" colors:
 #
 #     printf "0 0 0 black\n255 255 255 white\n" | ./rgb.tcl -
 #
 # Warning: Don't change the shebang above to directly start "wish."
 # The problem is that "wish" crashes if "-h" is passed in on the
 # command line, but we need "-h" to allow the user to ask for help.
 # The work around is to inspect "argv" before loading Tk.  (See
 # below.)
 #
 
 ##
 # Program version
 set rgb_version 1.0.1
 
 ##
 # Message to display in the main frame.
 set rgb_message "It was the best of times, it was the worst of times,\
 it was the age of wisdom, it was the age of foolishness,\
 it was the epoch of belief, it was the epoch of incredulity,\
 it was the season of Light, it was the season of Darkness,\
 it was the spring of hope, it was the winter of despair,\
 we had everything before us, we had nothing before us,\
 we were all going direct to Heaven, we were all going direct\
 the other way--in short, the period was so far like the present\
 period, that some of its noisiest authorities insisted on its\
 being received, for good or for evil, in the superlative degree\
 of comparison only."
 
 ##
 # Parse the command line options.  If an rgb.txt file is specified on
 # the command line, <code>fname</code> will be set to match.
 #
 # @param[out] fnameName name of variable to hold the file name
 proc parse_command_line {fnameName} {
     global argv
     global progname
 
     upvar 1 $fnameName fname
 
     # Iterate over the command-line arguments.
     foreach arg $argv {
 
         # -help
         if {($arg == "-h") || ($arg == "-help") || ($arg == "--help")} {
             puts ""
             puts "Usage: $progname \[-h\] \[<rgb.txt>\]"
             puts ""
             puts "    Note: If <rgb.txt> is specified as \"-\", stdin is used."
             puts ""
             exit 0
         }
 
         # Check for invalid flags.
         if {([string length $argv] > 1) && ([string index $arg 0] == "-")} {
             puts stderr "$progname: Error: invalid flag: $arg"
             exit 1
         }
 
         # Must be the name of the file.
         if {$fname == ""} {
             set fname $arg
         } else {
             puts stderr "$progname: Error: extra rgb file specified: $arg"
             exit 1
         }
     }
 }
 
 ##
 # Parse the "rgb.txt" file specified by the path <code>fname</code>.
 # This causes each color listed in <code>fname</code> to be mapped in
 # <code>cnames</code> to a list of its red, green, and blue component
 # colors.
 #
 # @param[in] fname file name for "rgb.txt" file
 # @param[out] cnamesName name of array that maps color names to RGB
 proc parse_rgb_file {fname cnamesName} {
     upvar 1 $cnamesName cnames
 
     # Open file.
     if {$fname == "-"} {
         set f stdin
     } else {
         set f [open $fname r]
     }
 
     # Iterate over each line in the "rgb.txt" file.
     while {[gets $f line] >= 0} {
 
         # Skip comments.
         if {[string index $line 0] == "!"} {
             continue
         }
 
         # Reset.
         set red 0
         set green 0
         set blue 0
         set cname ""
 
         # Parse the line.
         regexp -- {([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)[ \t]+(.*)$} \
                   $line all red green blue cname
 
         # Sanity check.
         if {$cname == ""} {
             continue
         }
 
         # Insert results into "cnames" array.
         set cnames($cname) [list $red $green $blue]
     }
 
     # Close file.
     if {$fname != "-"} {
         close $f
     }
 }
 
 ##
 # Convert the <code>rgb</code> list of component colors into the
 # format "#RRGGBB" and return the result.
 #
 # @param[in] rgb RGB component colors as a list
 # @return RGB component colors as a string
 proc format_color {rgb} {
     foreach {red green blue} $rgb {}
     format "#%02x%02x%02x" $red $green $blue
 }
 
 ##
 # This function returns "black" unless the list of component colors in
 # <code>rgb</code> indicates that the color is dark.  Then, this
 # function returns "white".  The idea is that the color returned is
 # suitable for use as the foreground (or text) color if
 # <code>rgb</code> is the background color.
 #
 # @param[in] rgb RGB component colors as a list
 # @return RGB component colors as a string
 proc get_fg_color {rgb} {
     set rv black
     foreach {red green blue} $rgb {}
     if {($red < 0xa0) && ($green < 0xa0)} {
         set rv white
     }
     return $rv
 }
 
 ##
 # Enable the menu item <code>item</code>.
 #
 # @param[in] item menu item
 proc enable_menu_item {item} {
     global progname
     global menu_indexes
 
     # Get the parent menu.
     set parent [file rootname $item]
     if {![winfo exists $parent]} {
         puts stderr "$progname: Warning: enable_menu_item:\
                     no parent: $parent"
         return
     }
 
     # Make sure the menu item exists.
     if {![info exists menu_indexes($item)]} {
         puts stderr "$progname: Warning: enable_menu_item:\
                     no menu item: $item"
         return
     }
 
     # Enable the menu item.
     $parent entryconfigure $menu_indexes($item) -state normal
 }
 
 ##
 # Disable the menu item <code>item</code>.
 #
 # @param[in] item menu item
 proc disable_menu_item {item} {
     global progname
     global menu_indexes
 
     # Get the parent menu.
     set parent [file rootname $item]
     if {![winfo exists $parent]} {
         puts stderr "$progname: Warning: disable_menu_item:\
                     no parent: $parent"
         return
     }
 
     # Make sure the menu item exists.
     if {![info exists menu_indexes($item)]} {
         puts stderr "$progname: Warning: disable_menu_item:\
                     no menu item: $item"
         return
     }
 
     # Disable the menu item.
     $parent entryconfigure $menu_indexes($item) -state disabled
 }
 
 ##
 # Center the dialog window <code>d</code> over the window
 # <code>p</code>.  If <code>p</code> does not exist, the dialog is
 # centered over the entire screen.
 #
 # @param[in] d dialog window
 # @param[in] p parent window
 # @see ::tk::PlaceWindow (in tk.tcl)
 proc center_dialog {d {p ""}} {
 
     # Force the geometry manager to update the layout so we can query
     # the correct size of the window.
     update idletasks
 
     # Get the width and height requested by the geometry manager.
     # This often is not the same as the current width and height
     # because the Window Manager may not have resized the window yet.
     set d_width [winfo reqwidth $d]
     set d_height [winfo reqheight $d]
 
     # If the parent exists, use the geometry of the parent window.
     if {[winfo exists $p]} {
         set p_x [winfo rootx $p]
         set p_y [winfo rooty $p]
         set p_width [winfo width $p]
         set p_height [winfo height $p]
     } else {
         # Otherwise, use the geometry of the screen.
         set p_x 0
         set p_y 0
         set p_width [winfo screenwidth $d]
         set p_height [winfo screenheight $d]
     }
 
     # Set the new location for the dialog window.  We subtract 25 to
     # raise the dialog a little on the screen.
     set new_x [expr {$p_x + ($p_width - $d_width) / 2}]
     set new_y [expr {$p_y + ($p_height - $d_height) / 2 - 25}]
 
     # Bounds check.
     if {$new_x < 0} {
         set new_x 0
     }
     if {$new_y < 0} {
         set new_y 0
     }
 
     # Move the dialog window into place.
     wm geom $d "+$new_x+$new_y"
 }
 
 ##
 # This function is called when the selects a color in the list box.
 # It queries the list box for the color and uses it to set the
 # background color of the <code>.f</code> frame.  It also changes the
 # label for the <code>.f</code> frame to be the name of the color.
 proc on_color_selection {} {
     global apply_to_bg
     global apply_to_fg
     global default_bg_color
 
     # Get the index of the selected row.
     set index [.lbox curselection]
     if {$index == ""} {
         return;
     }
 
     # Get the text of the selected row.
     set row [.lbox get $index]
 
     # Recover the name of the color and the rgb value from the row.
     regexp -- {(.*) \((#[0-9a-fA-F]+)\)} $row all cname rgb
 
     # Split RGB string into component colors.
     scan $rgb "#%02x%02x%02x" red green blue
 
     # Split the text at the top of the frame so we can update each part.
     set f_text_parts [split [.f cget -text] "/"]
     set bg_name [lindex $f_text_parts 0]
     set fg_name [lindex $f_text_parts 1]
     if {$bg_name == ""} {
         set bg_name $default_bg_color
     }
     if {$fg_name == ""} {
         set fg_name black
     }
 
     # Update the background color.
     if {$apply_to_bg} {
         # Update the background of the frame and the frame's message.
         .f configure -bg $rgb
         .f.msg configure -bg $rgb
         set bg_name $cname
 
         # Update the foreground color for the frame (i.e., text color
         # of the frame's label).  This needs to be done so that the
         # label's color will contrast with the new background color.
         set frame_fg [get_fg_color [list $red $green $blue]]
         .f configure -fg $frame_fg
     }
 
     # Update the foreground color.
     if {$apply_to_fg} {
         .f.msg configure -fg $rgb
         set fg_name $cname
     }
 
     # Update the text at the top of the frame.
     set bg_name [string trim $bg_name]
     set fg_name [string trim $fg_name]
     .f configure -text "$bg_name / $fg_name"
 }
 
 ##
 # This function tries to open the rgb.txt file <code>fname</code>.  If
 # <code>fname</code> is an empty string, a <code>tk_getOpenFile</code>
 # dialog will prompt the user for a file name.  Either way, the
 # function then tries to parse the file extracting the names of the
 # colors and their RGB components.  It then updates the GUI to dislay
 # the new list of colors.
 #
 # @param[in] fname file name
 proc on_file_open {fname} {
     global rgb_fname
     global menu_indexes
 
     # Close the old file before loading the new file.
     if {![on_file_close]} {
         # User canceled the close.
         return
     }
 
     # Prompt the user for a file name if one isn't supplied.
     if {$fname == ""} {
         # Display the common "File Open" dialog.
         set fname [tk_getOpenFile]
         if {$fname == ""} {
             # Operation canceled.
             return
         }
     }
 
     # Create a temporary array to hold the colors.  Each array name
     # maps to a list that holds the RGB components of the color.
     array set cnames [list]
 
     # Parse the rgb.txt file.
     parse_rgb_file $fname cnames
 
     # Iterate over the array in alphabetical order inserting colors
     # into the ".lbox" listbox.
     foreach cname [lsort -dictionary [array names cnames]] {
         .lbox insert end "$cname ([format_color $cnames($cname)])"
         .lbox itemconfigure end -bg [format_color $cnames($cname)]
         .lbox itemconfigure end -fg [get_fg_color $cnames($cname)]
     }
 
     # Select the first row.
     .lbox selection set 0
 
     # Let the GUI know we have programmatically made a selection.
     on_color_selection
 
     # Enable the File/Close menu item.
     enable_menu_item .m.file.close
 
     # Enable the Edit/Copy menu item.
     enable_menu_item .m.edit.copy
     bind . <Control-c> {on_edit_copy}
 
     # Enable the "Edit/Apply to Foreground" menu item.
     enable_menu_item .m.edit.apply_to_fg
     bind . <Control-f> {set apply_to_fg [expr !$apply_to_fg]}
 
     # Enable the "Edit/Apply to Background" menu item.
     enable_menu_item .m.edit.apply_to_bg
     bind . <Control-b> {set apply_to_bg [expr !$apply_to_bg]}
 
     # Give the focus to the list box.
     focus .lbox
 
     # Remember the name of the rgb file.
     set rgb_fname $fname
 }
 
 ##
 # Close the current rgb.txt file.
 #
 # @return whether the user agreed to close the file
 proc on_file_close {} {
     global default_bg_color
     global rgb_fname
 
     # Only prompt the user if a file is already loaded.
     if {$rgb_fname != ""} {
         set message_rv [tk_messageBox -type okcancel \
                                       -title "Close" \
                                       -message "Ok to close?" ]
         if {$message_rv != "ok"} {
             return 0
         }
     }
 
     # Clear the list box.
     .lbox delete 0 end
 
     # Clear the frame.
     .f configure -text {} -bg $default_bg_color
     .f.msg configure -bg $default_bg_color -fg black
 
     # Disable the "File/Close" menu item.
     disable_menu_item .m.file.close
 
     # Disable the "Edit/Copy" menu item.
     disable_menu_item .m.edit.copy
     bind . <Control-c> {}
 
     # Disable the "Edit/Apply to Foreground" menu item.
     disable_menu_item .m.edit.apply_to_fg
     bind . <Control-f> {}
 
     # Disable the "Edit/Apply to Background" menu item.
     disable_menu_item .m.edit.apply_to_bg
     bind . <Control-b> {}
 
     # Take the focus away from the list box.
     focus .
 
     # Clear the file name.
     set rgb_fname ""
 
     return 1
 }
 
 ##
 # Prompt the user to exit the program.
 proc on_exit {} {
     global rgb_fname
 
     # Only prompt the user if a file is currently loaded.
     if {$rgb_fname != ""} {
         set message_rv [tk_messageBox -type okcancel \
                                       -title "Exit" \
                                       -message "Ok to exit?"]
     }
 
     # Exit if a file is not currently loaded or if the user said it was ok.
     if {($rgb_fname == "") || ($message_rv == "ok")} {
         exit 0
     }
 }
 
 ##
 # Copy the text for the currently selected row to the clipboard.  If
 # no row is selected, nothing is copied to the clipboard.
 proc on_edit_copy {} {
     # Get the index of the selected row.
     set index [.lbox curselection]
     if {$index == ""} {
         return;
     }
 
     # Get the text of the selected row.
     set row [.lbox get $index]
 
     # Set the clipboard text.
     clipboard clear
     clipboard append $row
 }
 
 ##
 # Display the "About" dialog.
 proc on_help_about {} {
     global rgb_version
 
     # Make sure the old dialog is destroyed.
     if {[winfo exists .about]} {
         destroy .about
     }
 
     # Create the "About" dialog.
     toplevel .about -class Dialog -bd 4
     wm resizable .about 0 0
     wm title .about "About RGB"
     wm withdraw .about
 
     set cwidth 375
     set cheight 150
     canvas .about.canvas -bg white -width $cwidth -height $cheight
     pack .about.canvas -expand 1 -fill both -pady 4
 
     # Draw the colored blocks.
     set i 0
     set clist [list azure1 azure2 azure3 azure4 \
                     cornsilk1 cornsilk2 cornsilk3 cornsilk4]
     set block_width 100
     set block_height 12
     set x_offset  10
     set y_offset  20
     foreach c $clist {
         set x0 $x_offset
         set y0 [expr {$i * $block_height} + $y_offset]
         set x1 [expr {$x_offset + $block_width}]
         set y1 [expr {($i + 1) * $block_height} + $y_offset]
         .about.canvas create rectangle $x0 $y0 $x1 $y1 -fill $c
         incr i
     }
 
     # Create the labels.  These run down the left side.
     set left_side ""
     append left_side "Program: \n"
     append left_side "Version: \n"
     append left_side "License: \n"
     append left_side "Author: \n"
     append left_side "E-Mail: \n"
     append left_side "URL: \n"
     .about.canvas create text \
         [expr {$cwidth / 2}] \
         [expr {$cheight / 2}] \
         -font "helvetica -12 bold" \
         -justify right \
         -anchor e \
         -text $left_side
 
     # Create the values.  These run down the right side.
     set right_side ""
     append right_side "RGB\n"
     append right_side "$rgb_version\n"
     append right_side "BSD\n"
     append right_side "Paul Serice\n"
     append right_side "[email protected]\n"
     append right_side "http://www.serice.net/rgb/\n"
     .about.canvas create text \
         [expr {$cwidth / 2}] \
         [expr {$cheight / 2}] \
         -font "helvetica -12 bold" \
         -justify left \
         -anchor w \
         -text $right_side
 
     button .about.ok -text "OK" -command {destroy .about}
     pack .about.ok -side right -ipadx 16 -pady 4
 
     focus .about.ok
 
     # Wait until everything has been added to the dialog before trying
     # to center it.
     center_dialog .about .
 
     # Show the dialog.
     wm deiconify .about
 }
 
 ##
 # Create the main menu.
 proc create_main_menu {} {
     global menu_indexes
 
     # Create the main menu.
     menu .m -tearoff 0
     . configure -menu .m
 
     # File
     menu .m.file -tearoff 0
     .m add cascade -menu .m.file -label "File" -underline 0
 
     # File/Open
     .m.file add command -label "Open" \
                         -underline 0 \
                         -accelerator Ctrl+O \
                         -command {on_file_open ""}
     bind . <Control-o> {on_file_open ""}
     set menu_indexes(.m.file.open) [.m.file index end]
 
     # File/Close
     .m.file add command -label "Close" \
                         -underline 0 \
                         -state disabled \
                         -command {on_file_close}
     set menu_indexes(.m.file.close) [.m.file index end]
 
     # Separator
     .m.file add separator
 
     # File/Exit
     .m.file add command -label "Exit" \
                         -underline 1 \
                         -command {on_exit}
     set menu_indexes(.m.file.exit) [.m.file index end]
 
     # Edit
     menu .m.edit -tearoff 0
     .m add cascade -menu .m.edit -label "Edit" -underline 0
 
     # Edit/Copy
     .m.edit add command -label "Copy" \
                         -underline 0 \
                         -accelerator Ctrl+C \
                         -state disabled \
                         -command {on_edit_copy}
     set menu_indexes(.m.edit.copy) [.m.edit index end]
 
     # Separator
     .m.edit add separator
 
     # Edit/Apply to Background
     .m.edit add checkbutton -label "Apply to Background" \
                             -underline 9 \
                             -accelerator Ctrl-B \
                             -state disabled \
                             -variable apply_to_bg
     set menu_indexes(.m.edit.apply_to_bg) [.m.edit index end]
 
     # Edit/Apply to Foreground
     .m.edit add checkbutton -label "Apply to Foreground" \
                             -underline 9 \
                             -accelerator Ctrl-F \
                             -state disabled \
                             -variable apply_to_fg
     set menu_indexes(.m.edit.apply_to_fg) [.m.edit index end]
 
     # Help
     menu .m.help -tearoff 0
     .m add cascade -menu .m.help -label "Help" -underline 0
 
     # Help/About
     .m.help add command -label "About" \
                         -underline 0 \
                         -command on_help_about
     set menu_indexes(.m.help.about) [.m.edit index end]
 }
 
 #
 # Script starts here.
 #
 
 # Set the program name.
 set progname [file tail $argv0]
 
 # Set the rgb file name.
 set rgb_fname ""
 
 # Set the file name passed in on the command line.
 set cmd_fname ""
 
 # Global array that maps each menu item to its index.
 array set menu_indexes [list]
 
 # Whether to apply the color to the background.  This variable is tied
 # to the "Edit/Apply to Background" checkbutton.
 set apply_to_bg 1
 
 # Whether to apply the color to the foreground.  This variable is tied
 # to the "Edit/Apply to Foreground" checkbutton.
 set apply_to_fg 0
 
 # Parse the command line.
 parse_command_line cmd_fname
 
 # Wait until after checking "argv" to load Tk; otherwise, Tk crashes
 # or balks when it sees "-h" on the command line.
 package require Tk
 
 # Hide the window.
 wm withdraw .
 
 # Set the title.
 wm title . RGB
 
 # Create the main menu.
 create_main_menu
 
 # Set the main font.
 set main_font "helvetica -12 bold"
 
 # Create the frame to display the color.
 labelframe .f -font $main_font
 pack .f -side left -expand 1 -fill both
 
 # Create the message in the frame.
 message .f.msg -fg black -font $main_font -text $rgb_message
 pack .f.msg -side top -expand 1 -fill both
 
 # Get the default background color from .f
 set default_bg_color [.f cget -bg]
 
 # Create the list box.
 listbox .lbox -setgrid 1 \
               -relief flat \
               -width 32 \
               -height 14 \
               -font $main_font \
               -yscrollcommand {.vsb set}
 bind .lbox <ButtonRelease-1>         {+on_color_selection}
 bind .lbox <KeyPress-Up>             {+on_color_selection}
 bind .lbox <KeyRelease-Up>           {+on_color_selection}
 bind .lbox <KeyPress-Down>           {+on_color_selection}
 bind .lbox <KeyRelease-Down>         {+on_color_selection}
 bind .lbox <Control-KeyRelease-Home> {+on_color_selection}
 bind .lbox <Control-KeyRelease-End>  {+on_color_selection}
 pack .lbox -side left -expand 0 -fill y
 
 # Create the scroll bar.
 scrollbar .vsb -takefocus 0 -command {.lbox yview}
 pack .vsb -side left -expand 0 -fill y
 
 # Parse the rgb file which loads the colors.
 if {$cmd_fname != ""} {
     on_file_open $cmd_fname
 }
 
 # Show the window.
 wm deiconify .