#!/usr/local/bin/wishikit
#
set copyright "Copyright (c) 1997 Picture Elements, Inc."
# Stephen Williams (steve@picturel.com)
#
#    This source code is free software; you can redistribute it
#    and/or modify it in source code form under the terms of the GNU
#    Library General Public License as published by the Free Software
#    Foundation; either version 2 of the License, or (at your option)
#    any later version. In order to redistribute the software in
#    binary form, you will need a Picture Elements Binary Software
#    License.
#
#    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 Library General Public License for more details.
#
#    You should have received a copy of the GNU Library General Public
#    License along with this program; if not, write to the Free
#    Software Foundation, Inc.,
#    59 Temple Place - Suite 330
#    Boston, MA 02111-1307, USA
#
#    You should also have recieved a copy of the Picture Elements
#    Binary Software License offer along with the source. This offer
#    allows you to obtain the right to redistribute the software in
#    binary (compiled) form. If you have not received it, contact
#    Picture Elements, Inc.,
#    777 Panoramic Way
#    Berkeley, CA 94704.
#
#ident "$Id: kit.tcl,v 1.28 1997/07/08 23:17:52 steve Exp $"
#
# $Log: kit.tcl,v $
# Revision 1.28  1997/07/08 23:17:52  steve
#  Rework palette handling.
#
# Revision 1.27  1997/02/03 20:09:09  steve
#  console message output interface.
#
# Revision 1.26  1997/02/01 06:35:13  steve
#  Better quoting of image labels.
#
# Revision 1.25  1997/02/01 02:11:45  steve
#  Add planing to cut planes out of images.
#
# Revision 1.24  1997/02/01 01:08:32  steve
#  Cascading function menu, and better dicumentation.
#
#
#
# --
# This script implements (with the help of the ikit Tcl/Tk extension)
# a graphical image manipulation tool. The intent is to allow a user
# to read in an image, apply various operators to the image, view the
# results, and possibly write the results into a file.
#

# --
# The first directory in the search path in the ikit library. This is
# usually enough. This directoy contains the ikit .so files if they
# exist, and we always load it from there, unless the package is
# already statically linked.

set ik_library /usr/local/lib/ikit
if {[info exists "env(IK_LIBRARY)"]} {
    set ik_library $env(IK_LIBRARY)
}

# --
# These are global variable controlling the behavior of the ikit core
# application.
set verbose_mode 1


if {[catch {load {} ikit}]}  {load $ik_library/libikit.so ikit}
if {[catch {load {} ikitx}]} {load $ik_library/libikitx.so ikitx}

# If there are any other directories were I should look for packages,
# add them here.

set ik_path "$ik_library"
if {[info exists "env(IK_PATH)"]} {
    foreach dir $env(IK_PATH) {lappend ik_path $dir}
}

# --
# The image_map array maps image names to image window numbers. This
# is used to locate a displayed image if it exists.

set image_number 0
proc get_image_number {name} {
    global image_number image_number_map

    if [info exists image_number_map($name)] {
	return "image$image_number_map($name)"
    }

    incr image_number
    set image_number_map($name) $image_number
    return "image$image_number"
}

frame .mbar

menubutton .mbar.file  -text "File"        -menu .mbar.file.menu
menubutton .mbar.func  -text "Functions"   -menu .mbar.func.menu
menubutton .mbar.stack -text "Stack"       -menu .mbar.stack.menu
menubutton .mbar.view  -text "View"        -menu .mbar.view.menu
menubutton .mbar.pref  -text "Preferences" -menu .mbar.pref.menu
menubutton .mbar.help  -text "Help"        -menu .mbar.help.menu

pack .mbar.file  -side left  -anchor nw
pack .mbar.func  -side left  -anchor nw
pack .mbar.stack -side left  -anchor nw
pack .mbar.view  -side left  -anchor nw
pack .mbar.pref  -side left  -anchor nw
pack .mbar.help  -side right -anchor ne

# --
# The File menu has commands for loading images from TIFF files.
menu .mbar.file.menu
.mbar.file.menu add cascade -label "Save" -menu .mbar.file.menu.save
.mbar.file.menu add cascade -label "Load" -menu .mbar.file.menu.load
.mbar.file.menu add separator
.mbar.file.menu add command -label "Exit" -command exit

menu .mbar.file.menu.save -tearoff false

menu .mbar.file.menu.load -tearoff false

proc ik_add_saver  {label command} {
    .mbar.file.menu.save add command -label $label -command $command
}

proc ik_add_loader {label command} {
    .mbar.file.menu.load add command -label $label -command $command
}


# --
# The functions menu has image processing functions. Make a global function
# that ikit packages can use to add a menu selection here.
menu .mbar.func.menu

set function_cascade_idx 0
proc ik_add_function {label command} {
    global function_cascade_map function_cascade_idx

    set sep [string first "~" $label]
    if {$sep == -1} {
	.mbar.func.menu add command -label $label -command $command

    } else {
	set clabel [string range $label 0 [expr $sep - 1]]
	set label  [string range $label [expr $sep + 1] end]

	if {0 == [info exists function_cascade_map($clabel)]} {
	    incr function_cascade_idx
	    set menu ".mbar.func.menu.c_$function_cascade_idx"
	    set function_cascade_map($clabel) $menu

	    .mbar.func.menu add cascade -label $clabel -menu $menu
	    menu $menu -tearoff false
	}

	eval "$function_cascade_map($clabel) add command -label {$label} -command {$command}"
    }
}


# --
# The stack menu
menu .mbar.stack.menu
.mbar.stack.menu add command -label "Duplicate"        -command stack_dup
.mbar.stack.menu add separator
.mbar.stack.menu add command -label "Swap Top"         -command stack_swap_top
.mbar.stack.menu add command -label "Swap Selection"   -command stack_swap_sel
.mbar.stack.menu add separator
.mbar.stack.menu add command -label "Delete Top"       -command stack_del_top
.mbar.stack.menu add command -label "Delete Selection" -command stack_del_sel
.mbar.stack.menu add command -label "Delete Bottom"    -command stack_del_bot
.mbar.stack.menu add separator
.mbar.stack.menu add command -label "Delete All"       -command stack_clear

# --
# The View menu
menu .mbar.view.menu
.mbar.view.menu add command -label "Top Image"      -command view_top_image
.mbar.view.menu add command -label "Selected Image" -command view_sel_image
.mbar.view.menu add separator
.mbar.view.menu add command -label "Top Palette"      -command view_top_palette
.mbar.view.menu add command -label "Selected Palette" -command view_sel_palette

# --
# The Preferences menu
menu .mbar.pref.menu

proc raise_preference {widget} {
    scan [wm geometry .] "%dx%d+%d+%d" mw mh mx my

    set x [expr "$mx + $mw/3"]
    set y [expr "$my + $mh/3"]

    wm geometry  $widget "+$x+$y"

    wm deiconify $widget
}

proc ik_add_preference {label widget} {
    wm title     $widget "Preference: $label"
    wm transient $widget .
    wm withdraw  $widget

    .mbar.pref.menu add command \
	    -label $label \
	    -command "raise_preference $widget"
}


# --
# The Help menu
menu .mbar.help.menu
.mbar.help.menu add command \
	-label "About" \
	-command {raise_preference .help_about}
.mbar.help.menu add command \
	-label "Keyboard Bindings" \
	-command {raise_preference .help_keys}

toplevel .help_about
label    .help_about.copy -text "$copyright"
message  .help_about.msg -width 8c -text "For the latest release\
of this software, contact Picture Elements, or see the\
ftp site at ftp://ftp.picturel.com/pub/source."

button   .help_about.dismiss -text "Dismiss" -command "wm withdraw .help_about"
pack .help_about.copy .help_about.msg -expand true -fill x
pack .help_about.dismiss
wm transient .help_about .
wm withdraw .help_about

toplevel .help_keys
label    .help_keys.title -text "Keyboard Bindings"
message  .help_keys.msg -width 8c -justify left -text \
"IMAGE WINDOW:
c -- Crop the image
q -- Close the image window"
button   .help_keys.dismiss -text "Dismiss" -command {wm withdraw .help_keys}
pack .help_keys.title .help_keys.msg -expand true -fill x
pack .help_keys.dismiss
wm transient .help_keys .
wm withdraw .help_keys

#
# Make the body area, that includes the stack display and the console.
#
frame .body
frame .body.stack -relief ridge -borderwidth 2
button  .body.stack.view -text "View top" -command view_top_image
listbox .body.stack.list -borderwidth 0
button  .body.stack.del  -text "Delete bottom" -command stack_del_bot
pack .body.stack.view  -side top -fill x
pack .body.stack.list  -side top -fill y -expand true
pack .body.stack.del   -side top -fill x

text .body.console -width 50 -height 16 -yscrollcommand {.body.cscroll set}

scrollbar .body.cscroll -command {.body.console yview}

set pixel_info "Pixel info"
label .pixel -textvariable pixel_info

pack .body.stack -side left -fill y -padx 4 -pady 4
pack .body.console -side left
pack .body.cscroll -side left -fill y

pack .mbar -expand true -side top -fill x
pack .body -side top
pack .pixel -side top -anchor w

proc find_image_in_stack {name} {

    set result ""

    set size [.body.stack.list size]
    for {set i 0} {$i < $size} {incr i} {

	set image [.body.stack.list get $i]
	if {[string compare $name $image] == 0} {
	    set result [lappend $result $i]
	}
    }

    return $result
}

# --
# use the name passed as a suggestion for an image name. Check that
# the name is unique, and if not return a modified version that is.
proc ik_unique_image_name {name} {
    set suff ""
    set idx 0

    while {[string length [find_image_in_stack "$name$suff"]]} {
	incr idx
	set suff "<$idx>"
    }

    return "$name$suff"
}

proc keypress_integer {widget char} {

    if {[string length $char] == 0} return

    if {[string match {[a-zA-Z ]} $char]} {return -code break}

    if {[string first $char "0123456789"] >= 0} {
	eval $widget insert insert $char
	return -code break
    }

    return
}

proc complete_file {var} {
    global $var
    eval "set string \$$var"

    set list [glob -nocomplain -- "$string*"]

    if {[llength $list] == 1} {
	if {[file isdirectory $list]} {
	    set $var "$list/"
	} else {
	    set $var $list
	}
	return
    }

    if {[llength $list] == 0} {
	bell
	return
    }

    set res [lindex $list 0]
    set len [string length $res]

    foreach name $list {
	while {[string first $res $name] != 0} {
	    incr len -1
	    if {$len <= 0} { bell ; return }
	    set res [string range $res 0 [expr $len - 1]]
	}
    }

    set $var $res
    if {[string compare $res $string] == 0} { bell }
}

# --
# This is a generic value prompter box. The caller passes a list of
# {variable label type} sublists, and the function will build a dialog
# box to ask for the values, will edit the variables to suit what the
# user types, and will return when the user presses the OK button.

proc ik_get_values {options} {

    toplevel .values
    set focus_list ""

    foreach item $options {
	set var  [lindex $item 0]
	set lab  [lindex $item 1]
	set type [lindex $item 2]
	global $var

	# Make up a frame that contains all the interactions for the
	# specific type of the variable. Also save in the focus_list
	# the name of the widget that can accept the focus for the
	# variable.

	frame .values.$var
	switch $type {
	    text {
		label .values.$var.label -text $lab
		entry .values.$var.entry -textvariable $var
		pack  .values.$var.label .values.$var.entry -side left
		pack  .values.$var -side top
		lappend focus_list ".values.$var.entry"
	    }

	    filename {
		label .values.$var.label -text $lab
		entry .values.$var.entry -textvariable $var -width 32
		pack  .values.$var.label .values.$var.entry -side left
		pack  .values.$var -side top
		lappend focus_list ".values.$var.entry"
		bind .values.$var.entry "<space>" \
			"complete_file $var;\
			 .values.$var.entry icursor end;\
			 break"
	    }

	    integer {
		label .values.$var.label -text $lab
		entry .values.$var.entry -textvariable $var -width 8
		pack  .values.$var.label .values.$var.entry -side left
		pack  .values.$var -side top
		lappend focus_list ".values.$var.entry"
		bind .values.$var.entry \
		    "<KeyPress>" \
		    "keypress_integer .values.$var.entry %A"
	    }
	}
    }

    button .values.ok -text "OK" -command {destroy .values}
    pack .values.ok

    # If there is only one entry field, then add the extra feature of
    # allowing a return to complete the dialog window.

    bind .values.ok "<Return>" {destroy .values}
    if {[llength $focus_list] == 1} {
	bind $focus_list "<Return>" {destroy .values}
    }

    scan [wm geometry .] "%dx%d+%d+%d" mw mh mx my

    set x [expr "$mx + $mw/3"]
    set y [expr "$my + $mh/3"]

    focus [lindex $focus_list 0]
    wm transient .values .
    wm geometry  .values "+$x+$y"
    grab set     .values

    tkwait window .values

    return "ok"
}


proc crop_image {label} {
    set iname [get_image_number $label]
    set box [eval ".im_$iname.port.pane box"]
    set point [lindex $box 0]
    set width [lindex $box 1]

    set x [lindex $point 0]
    set y [lindex $point 1]
    set w [lindex $width 0]
    set h [lindex $width 1]
    set image [image create ik_image -crop $label -cut $x $y $w $h]
    ik_stack_push $image "$image <-- CROP($label, ${w}x$h+$x+$y)\n"
}

# --
# Here are a bunch of operations for manipulating the image stack. The
# user cal manipulate the stack by pressing buttons that call these, and
# there are some functions that use these as well.
#

proc delete_if_not_stacked {name} {

    set size [.body.stack.list size]
    for {set i 0} {$i < $size} {incr i} {

	set image [.body.stack.list get $i]
	if {[string compare $name $image] == 0} return
    }

    catch {destroy ".im_[get_image_number $name]"}
    image delete $name
}

proc stack_dup {} {
    set size [.body.stack.list size]
    if {$size == 0} return

    set source [.body.stack.list get 0]
    .body.stack.list insert 0 $source
}

proc stack_del_top {} {
    set size [.body.stack.list size]
    if {$size == 0} return

    set source [.body.stack.list get 0]
    .body.stack.list delete 0
    delete_if_not_stacked $source
}

proc stack_del_sel {} {
    set sel [.body.stack.list curselection]
    if {[llength $sel] != 1} return

    set source [.body.stack.list get $sel]
    .body.stack.list delete $sel
    delete_if_not_stacked $source
}

proc stack_del_bot {} {
    set size [.body.stack.list size]
    if {$size == 0} return
    incr size -1
    set source [.body.stack.list get $size]
    .body.stack.list delete $size
    delete_if_not_stacked $source
}

proc stack_swap_top {} {
    set size [.body.stack.list size]
    if {$size < 2} return

    set source [.body.stack.list get 1]
    .body.stack.list delete 1
    .body.stack.list insert 0 $source
}

proc stack_swap_sel {} {
    set sel [.body.stack.list curselection]
    if {[llength $sel] != 1} return

    set source [.body.stack.list get $sel]
    .body.stack.list delete $sel
    .body.stack.list insert 0 $source
}

proc stack_clear {} {

    while {[.body.stack.list size] > 0} stack_del_top

}

proc ik_console {message {verbose ""}} {
    global verbose_mode
    .body.console insert end $message
    if $verbose_mode {.body.console insert end $verbose}
    .body.console see end
}

proc ik_stack_peek { {depth 0} } {
    if {[.body.stack.list size] <= $depth} return ""
    return [.body.stack.list get $depth]
}

proc ik_stack_push {name message {verbose ""}} {
    global verbose_mode

    .body.console insert end $message
    if $verbose_mode {.body.console insert end $verbose}
    .body.console see end
    .body.stack.list insert 0 $name
}

# --
# View the top image in a fresh toplevel, so that color-map issues don't
# make a mess of the controll window. Also, this way the user can close
# that window and all the resources (including colors) will be released.

proc view_image {label} {
    set name [get_image_number $label]
    if {[string length [info commands .im_$name]] > 0} {
	wm deiconify .im_$name
	raise .im_$name
	return
    }

    toplevel .im_$name
    wm title .im_$name "$label"
    ik_viewport .im_$name.port -width 600 -height 500

    ik_pane .im_$name.port.pane -image $label
    eval .im_$name.port place .im_$name.port.pane
    pack .im_$name.port -side top -expand true -fill both

    bind .im_$name.port.pane \
	    "<Button-1>" \
	    ".im_$name.port.pane box-start %x %y; draw_pixel_info {$label} %x %y"
    bind .im_$name.port.pane \
	   "<B1-Motion>" \
	   ".im_$name.port.pane box-stretch %x %y;draw_pixel_info {$label} %x %y"
    bind .im_$name.port.pane "<Key-c>" "crop_image $label"
    bind .im_$name.port.pane "<Key-q>" "destroy .im_$name"

    bind .im_$name.port.pane "<Enter>" "focus .im_$name.port.pane"
}

proc view_top_image {} {
    if {[.body.stack.list size] == 0} return
    set source [.body.stack.list get 0]

    view_image $source
}

proc view_sel_image {} {
    set source [.body.stack.list curselection]
    if {[llength $source] != 1} return

    set source [.body.stack.list get $source]

    view_image $source
}

# --
# The palette display shows a list of all the unique colors in the image.
# Each color is given its three hex pixel values, and three bars that show
# the relative intensities of the colors.

proc view_palette {label} {
    set name [get_image_number $label]
    if {[string length [info commands .pal_$name]] > 0} {
	wm deiconify .pal_$name
	raise .pal_$name
	return
    }

    toplevel .pal_$name
    wm title .pal_$name "$label"

    canvas .pal_$name.list -width 8c -height 225

    set y 0
    set list [ik_palette $label palette]

    foreach cell $list {
	foreach c $cell cname {red green blue} {set $cname $c}

	eval .pal_$name.list create text 1.2c $y \
		-text [format "%x" $red] \
		-justify right \
		-anchor ne

	if {[string length $green] > 0} {
	    eval .pal_$name.list create text 2.5c $y \
		    -text [format "%x" $green] \
		    -justify right \
		    -anchor ne

	    if {[string length $blue] > 0} {
		eval .pal_$name.list create text 3.8c $y \
			-text [format "%x" $blue] \
			-justify right \
			-anchor ne
	    }
	}

	eval .pal_$name.list create line 4c [expr $y + 4] \
		[expr $red * 4.0 / 65535 + 4.0]c [expr $y + 4] \
		-fill red \
		-width 3

	if {[string length $green] > 0} {
	    eval .pal_$name.list create line 4c [expr $y + 4 + 3] \
		    [expr $green * 4.0 / 65535 + 4.0]c [expr $y + 4 + 3] \
		    -fill green \
		    -width 3

	    if {[string length $blue] > 0} {
		eval .pal_$name.list create line 4c [expr $y + 4 + 6] \
			[expr $blue * 4.0 / 65535 + 4.0]c [expr $y + 4 + 6] \
			-fill blue \
			-width 3
	    }
	}

	incr y 15
    }

    eval .pal_$name.list configure \
	    -scrollregion \"0 0 8c $y\" \
	    -confine true \
	    -yscrollcommand "\".pal_$name.bar set\""

    scrollbar .pal_$name.bar -command ".pal_$name.list yview"
    eval .pal_$name.bar set 0 [expr 15.0*15.0 / $y]

    pack .pal_$name.list -side left -expand true -fill y
    pack .pal_$name.bar -side left -expand true -fill y
}

proc view_top_palette {} {
    if {[.body.stack.list size] == 0} return
    set source [.body.stack.list get 0]

    view_palette $source
}

proc view_sel_palette {} {
    set source [.body.stack.list curselection]
    if {[llength $source] != 1} return

    set source [.body.stack.list get $source]

    view_palette $source
}

proc draw_pixel_info {name x y} {
    global pixel_info
    set values [ik_palette $name pixel $x $y]
    set wid [ik_image $name width]
    set hei [ik_image $name height]

    set tmp "$name -- $wid x $hei -- Pixel ($x $y)"

    foreach intensity $values {
	lappend tmp [format "%04x" $intensity]
    }

    set pixel_info $tmp
}

# --
# Go through the library loading all the extension scripts that I
# find. These will add selections to do various things.

set ik_package_list ""
foreach ik_library $ik_path {
    foreach file [glob -nocomplain $ik_library/ikit_*.tcl] {

	set name [file tail $file]
	if {[lsearch -exact $ik_package_list $name] == -1} {
	    source $file
	    lappend ik_package_list $name
	} else {
	    puts "Duplicate package: $file"
	}

    }
}

