#!/usr/bin/wish

# This program is part of Geoduck, a set of graphical user
# interfaces for UNIX programs.
# Copyright (C) 2002 Allen B. Downey
#
# 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.
#
# For a copy of the GNU General Public License, go to
# www.gnu.org/copyleft/gpl.html
# or write to the Free Software Foundation, Inc.
# 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# Contact the author: me@allendowney.com

set dir [file dirname [info script]]
source [file join $dir geoduck.tcl]

proc getCommand {} {
    set cmd convert

    append cmd [getFlags]
    append cmd " " [getEntry en_input]
    append cmd " " [coval [getFormat] "" :][getEntry en_output]
}

proc test {} {
    cursorWatch

    set temp /tmp/convert.temp

    set output [getEntry en_output]
    fillEntry en_output $temp
    showCommand
    set cmd [getCommand]
    fillEntry en_output $output
    showCommand

    puts $cmd
    fillText text [execCatch $cmd]
    update

    set cmd "display $temp &"
    puts $cmd
    addText text [execCatch $cmd]
    update

    cursorNormal
}

proc listFormats {} {
    set list ""
    set fp [open "|convert -list format" r]
    while {[gets $fp line] != -1} {
	set name [lindex $line 0]
	set caps [lindex $line 1]
	if {[contains $caps w]} {
	    lappend list [string tolower [string range $name 0 end-1]]
	}
    }
    return $list
}

proc helpFormat {} {
    cursorWatch
    fillText text [listFormats]
    cursorNormal
}

proc getFormat {} {
    set format [enValue en_format]
    if {$format != ""} {
	return $format
    } else {
	return [mbValue mb_format]
    }
}

proc fr_topcol1 {args} {
    eval {fr fr_topcol1} $args

    la "Input files"
    en 0 en_input " " browse
#    fillEntry en_input "images/colby1.jpg"
    fillEntry en_input "Geoduck.jpg"

    endfr fr_topcol1
}

proc fr_topcol2 {args} {
    eval {fr fr_topcol2} $args

    la "Output files"
    en 0 en_output "" browse
    fillEntry en_output temp

    gr 4 {0 0 0 0}
    la "Output format:"
    mb "same as input" mb_format "" ""
    makemenu mb_format {bmp eps epsi fax gif gray html jpg mpg pdf \
			    png pnm ppm ps rgb tif txt}
    en 10 en_format "" ""
    bu "help" bu_help helpFormat
    config bu_help -padx 1 -pady 0
    endgr

    endfr fr_topcol2
}

proc getGeom {name {flag ""}} {
    set wh [getTuple $name {w h} x ]
    copend flag $wh
    set xy [getxy $name]
    copend flag $xy
    if { "$wh$xy" == "" } { return "" }
    append flag [getStatus pix$name]
    append flag [getStatus as$name]
    copend flag [getStatus gl$name] \" \"
}
 
proc xy {name} {
    tuple $name {x y}
}

proc getxy {name {flag ""}} {
    set x [enValue x$name]
    set y [enValue y$name]

    if {"$x$y" == ""} { return "" }

    if {$x == ""} { set x 0 }
    set ret [catch {append flag [format %+2d $x]}]
    if {$ret != 0} {return $flag}

    if {$y == ""} { return $flag }
    set ret [catch {append flag [format %+2d $y]}]
    if {$ret != 0} { return $flag }

    return $flag
}

proc greaterless {name args} {
    eval {mb always   $name "" ""} $args
    mb "if w>h" $name >  "" 
    mb "if w<h" $name <  ""
}

proc aspect {name args} {
    eval {mb "keep aspect ratio"  $name "" ""} $args
    mb "force dimensions"   $name !  ""
    mb "dims are maximum"   $name @  ""
}

proc geometry {name {flags %}} {

    gr 5 {0 1 0 1 0}
    la w
    en 0 w$name
    la h
    en 0 h$name

    if {[contains $flags %]} {
	mb pix     pix$name "" ""
	mb %       pix$name %  ""
    } else {
	la ""
    }

    la x
    en 0 x$name
    la y
    en 0 y$name
    la ""

    if {[contains $flags >]} {
	la ""
	greaterless gl$name -columnspan 3
	la ""
    }
    if {[contains $flags !]} {
	la ""
	aspect as$name -columnspan 3
	la ""
    }
    endgr
}

proc fullgeom {name} {
    geometry $name %>!
}

proc affine {} {
    cb "affine transformation" cb_affine "getAffine"

    gr 4 {0 1 1 1}
    la ""
    foreach ch {s r t} { la $ch }
    foreach dim {x y } {
	la $dim
	foreach ch {s r t} {
	    en 0 $ch$dim 
	    fillEntry $ch$dim 0
	}
    }
    fillEntry sx 1
    fillEntry sy 1
    endgr
}

proc getAffine {} {
    set flag " -affine "
    foreach var { sx rx ry sy tx ty } {
	set val [enValue $var]
	if {$val == ""} { set val 0}
	append flag $val,
    }
    set flag [string trimright $flag ,]
    return $flag
}

proc cmCommand {name color} {
    array set example {
	rgb    ff/ff/ff
	rgbi   1.0/1.0/1.0
        CIEXYZ 1/1/1
        CIEuvY 0.6/0.6/1.0
	CIExyY 0.75/0.85/1.0
        CIELab 100/1.0/1.0
        CIELuv 100/1.0/1.0
        TekHVC 360/100/100
    }
    if {[info exists example($color)]} {
	fillEntry en$name $color:$example($color)
    } else {
	fillEntry en$name $color
    }
    miCommand $color cm$name $color
}

proc color {name} {
    set colors {black white gray red green blue cyan magenta yellow \
		orange purple \
		rgb rgbi CIEXYZ CIEuvY CIExyY CIELab CIELuv TekHVC }

    fr
    foreach color $colors {
	mb $color cm$name $color "" -side left -fill none -anchor e
	entryconf cm$name last -command "cmCommand $name $color"
    }
    en 15 en$name

    endfr
    entryinvoke cm$name 0
}

proc getColor {name flag} {
    return [getEntry en$name $flag]
}

proc option {opt flag args} {
    set gridflag 0
    if {![gridding]} {
	gr 2 {0 1}
	set gridflag 1
    }
    set name [join $opt ""]
    cb $opt cb_$name $flag -sticky nw
    fr
    eval $args
    endfr
    if {$gridflag} {
	endgr
    }
}

proc contrastmenu {} {
}

# replist: repeat the list n times
proc replist {item n} {
    set list ""
    for {set i 0} {$i<$n} {incr i} {
	append list $item
    }
    return $list
}

proc tuple {name labels args} {
    set n [llength $labels]
    set n2 [expr 2*$n]
    set ws [replist "0 1 " $n]

    eval {gr $n2 $ws} $args

    foreach label $labels {
	la $label
	en 5 $label$name
    }
    endgr
}

proc getTuple {name labels {delim " "} {before ""} {after ""} } {
    puts $name
    set val ""
    foreach label $labels {
	append val [enValue $label$name]$delim
    }
    set val [string trimright $val $delim]
    if {$val != ""} {
	return $before$val$after
    }
}

proc makemenu {name opts args} {
    foreach opt $opts {
	eval {mb $opt $name $opt ""} $args
    }
}

proc optmenu {text name flag menu} {
    option $text "getStatus $name \" $flag \"" \
	makemenu $name $menu -fill none -anchor w
}

proc opt {text {flag ""}} {
    if {$flag == ""} {
	set flag -[join $text ""]
    }
    option $text $flag
}

proc optuple {text labels {delim x} {flag ""}} {
    set name [join $text ""]
    if {$flag == ""} {
	set flag -$name
    }
    option $text "getTuple $name [list $labels] \"$delim\" \" $flag \"" \
	tuple $name $labels
}

proc optentry {text {flag ""} args} {
    set name [join $text ""]
    if {$flag == ""} {
	set flag -$name
    }
    eval {option $text "getEntry $name \" $flag \"" en 0 $name ""} $args
}

proc rotate {} {
    en 5 degrees "" "" -side left
    greaterless rotate
}

proc composemenu {} {
    makemenu compose \
      { Over In Out Atop Xor Plus Minus Add Subtract Difference \
        Multiply Bumpmap Copy CopyRed CopyGreen CopyBlue CopyOpacity }
}

proc fr_col1 {args} {
    eval {fr fr_col1 -side left} $args

    gr 2 {0 1}

    la "Image sequence:" 
    set ops {adjoin append average coalesce compose deconstruct flatten \
		 morph mosaic process write}
    set flags(adjoin)  ""
    set flags(compose) "getStatus compose \" -compose \""
    set flags(morph)   "getEntry  morph   \" -morph \""

    foreach op $ops {
	if {[info exists flags($op)]} {
	    set flag $flags($op)
	} else {
	    set flag -$op
	}
	mb $op mb_ops $op $flag
    }

    la "Morph frames:"
    en 0 morph
    fillEntry morph 10
    la;la

    option comment {getEntry en_comment " -comment \"" \"} en 20 en_comment
    option label {getEntry en_label " -label \"" \"} en 20 en_label
    la;la

    option "transparent color" {getColor transcolor " -transparent "} \
	color transcolor
    option "border color" {getColor bordercolor " -border "} \
	color bordercolor
    option "box color" {getColor boxcolor " -box "} \
	color boxcolor
    option "fill color" {getColor fillcolor " -fill "} \
	color fillcolor
    option "opaque color" {getColor opaquecolor " -opaque "} \
	color opaquecolor
    option "pen color" {getColor pencolor " -pen "} \
	color pencolor
    option "stroke color" {getColor strokecolor " -stroke "} \
	color strokecolor
    optentry "stroke width"
    fillEntry strokewidth 1

    la;la
    optmenu colormap colormap -colormap {private shared}
    optentry "map image" -map browse

    # this is the map option for animate and display
    #optmenu map map -map {default best gray red green blue}

    optmenu channel channel -channel \
	{Red Green Blue Opacity Cyan Magenta Yellow Black}
    optuple gamma {r g b} /
    optmenu intent intent -intent {Absolute Perceptual Relative Saturation}

    endgr
    la
    gr 2 {0 1}
    opt "make image monochrome?" -monochrome
    optentry "number of colors"
    optentry "tree depth for color reduction" -treedepth
    optentry "cycle (displace) colormap" -cycle
    endgr

    endfr fr_col1
}

proc fr_col2 {args} {
    eval {fr fr_col2 -side left} $args

    gr 2 {0 1}

    option "background color" {getColor background " -background "} \
	color background
    optentry "bg texture" -texture browse
    la;la

    option frame {getGeom frame " -frame "} geometry frame ""
    optuple border {w h} x
    optuple "raise edge" {w h} x -raise
    optuple "lower edge" {w h} x +raise

    la;la

    optentry "font name" -font
    optentry "font size" -pointsize
    optentry "text font" -textfont

    la;la

    option draw {getEntry en_draw " -draw \"" \"} en 20 en_draw
    optmenu gravity gravity -gravity { Center North NorthEast East SouthEast
	                               South SouthWest West NorthWest }
    optentry tile -tile browse

    endgr

    la

    gr 2 {0 1}
    optmenu depth depth -depth {8 16}
    optentry "quality (jpg/miff/png)"
    optmenu interlace interlace -interlace {Line Plane Partition}

    la;la
    optuple  "density (ps)"  {w h} x -density
    optentry "page geometry" -page
    optuple  "sampling factor\n(jpg/mpg/yuv)" {h v} x -sampling-factor
    endgr

    endfr fr_col2
}

proc fr_col3 {args} {
    eval {fr fr_col3 -side left} $args

    gr 2 {0 1}
    optmenu filter filter -filter \
	{ Lanczos Point Box Triangle Hermite Hanning Hamming Blackman \
	  Gaussian Quadratic Cubic Catrom Mitchell Bessel Sinc } 

    option geometry {getGeom geometry " -geometry "} fullgeom geometry
    la;la
    option resize {getGeom resize " -resize "} fullgeom resize
    la;la

    option scale {getGeom scale " -scale "} geometry scale 
    la;la
    option sample {getGeom sample " -sample "} geometry sample
    la;la
    option chop {getGeom chop " -chop "} fullgeom chop
    la;la
    option crop {getGeom crop " -crop "} geometry crop 
    la;la
    optuple shave {w h}
    endgr

    endfr fr_col3
}

proc fr_col4 {args} {
    eval {fr fr_col4 -side left} $args

    gr 6 {0 1 0 1 0 1}
    opt silent
    opt verbose
    opt debug
    endgr
    
    opt "suppress antialiasing?" +antialias
    opt "use shared memory?" -shared_memory
    opt "store matte channel?" -matte
    opt "determine characteristics efficiently?" -ping
    optmenu endian endian -endian {msb lsb}
    la

    # note: make the display option take host, display, screen tuple?
    optentry display -display

    gr 2 {0 1}

    option region {getGeom region " -region "} geometry region

    opt clip
    optentry mask -mask browse
    optuple displace {horiz vert} x -displace
    la;la

    optentry "loop (gif only)"
    optmenu preview preview -preview \
	{JPEG Rotate Shear Roll Hue Saturation Brightness Gamma Spiff Dull \
	     Grayscale Quantize Despeckle ReduceNoise Add Noise Sharpen Blur \
	     Threshold EdgeDetect Spread Shade Raise Segment Solarize Swirl \
	     Implode Wave OilPaint CharcoalDrawing }

    optentry "profile" -profile browse
    optentry scene

    endgr

    endfr fr_col4
}


proc fr_col5 {args} {
    eval {fr fr_col5 -side left} $args
    
    affine
    la

    gr 2 {0 1}


    optuple blur {rad sig}

    optuple colorize {r g b} ,

    optmenu compress compress -compress \
	{BZip Fax Group4 JPEG Lossless LZW RLE Zip}

    cb contrast cb_contrast "getStatus contrastmenu"
    mb increase contrastmenu " -contrast" "" -sticky w
    mb decrease contrastmenu " +contrast" ""

    opt despeckle
    opt dither

    optuple edge radius

    opt emboss
    opt enhance
    opt equalize
    opt flip
    opt flop

    optuple gaussian {rad sig}

    optuple implode factor
    optuple median radius

    optuple level {bl wh md} ,

    endgr
    la

    endfr fr_col5
}

proc makeNoise {} {
    set menu {Uniform Gaussian Multiplicative Impulse Laplacian Poisson}
    fr
    la radius -side left
    en 0 noise "" "" -side left
    makemenu noisemenu $menu -side left -fill none -anchor w
    endfr
}

proc getNoise {} {
    getEntry noise " +noise " /[getStatus noisemenu]
}

proc fr_col6 {args} {
    eval {fr fr_col6 -side left} $args

    gr 2 {0 1}

    optuple modulate {br sat hue} ,
    opt negate


    optuple "filter noise" radius x -noise

    optmenu "add noise" noise +noise \
        {Uniform Gaussian Multiplicative Impulse Laplacian Poisson}

    opt normalize
    optuple paint radius
    optuple charcoal factor

    option roll {getxy roll " -roll "} xy roll

    optuple rotate degrees

    optuple segment {cl sm}

    optuple shade {az el}

    optuple shadow {rad sig}

    optuple sharpen {rad sig}
    optuple unsharp {rad sig}

    optuple shear {xdeg ydeg}
    
    optuple solarize factor
    optuple spread amount
    optuple stegano offset

    optuple swirl degrees

    optuple threshold value
    
    optuple wave {amp wl}

    endgr

    endfr fr_col6
}

proc fr_page1 {args} {

    eval {fr fr_page1 -pady 10} $args

    set fill x

    fr_col1 -padx 5 -fill $fill

    fr_col2 -padx 5 -fill $fill

    fr_col3 -padx 5 -fill $fill

    endfr fr_page1
}

proc fr_page2 {args} {

    eval {fr fr_page2 -pady 10} $args
    
    set fill x

    fr_col4 -padx 5 -fill $fill

    fr_col5 -padx 10 -fill $fill

    fr_col6 -padx 5 -fill $fill

    endfr fr_page2
}

topFrame

fr fr_middle

gr 2 {1 0} -pady 5
fr_topcol1 -padx 5 -sticky new
fr_topcol2 -padx 5 -sticky new
endgr

fr_page2 -fill both
update
hide fr_page2

fr_page1 -fill both

endfr fr_middle

fr fr_bottom -padx 5 -pady 5
te text 5
endfr fr_bottom

# pack the "more options" button
proc more {} {
    if {[showing fr_page1]} {
	hide fr_page1
	show fr_page2
    } else {
	hide fr_page2
	show fr_page1
    }
}

pushfr fr_later
bu "More options" bu_more more
repack fr_later -anchor s
popfr



showCommand