#!/usr/local/bin/wish -f
# config

# lib dir
set ht_libdir /home/bri/xhoughtool

source $ht_libdir/tkhough_config.tcl

# end of config

set dirvar picdir
set xscale 1
set yscale 1
set pic_x 1
set pic_y 1

proc cleanup {} {
    global tmpdir tmp_filesuffix idx
    set idx 1
    catch {file delete -force -- $tmpdir/points$tmp_filesuffix } 
    catch {file delete -force -- $tmpdir/accu$tmp_filesuffix.pgm }

    # oh well
    catch {file delete -force -- $tmpdir/tkhough.pgm$tmp_filesuffix }

    while {[file exists hough$idx.ptcl]} {
	catch {file delete -force -- hough$idx.ptcl}
	incr idx
    }
    exit 0
}

proc p_scale {w f t v l} {
    global $v
    scale $w.$v -label $l -variable $v -from $f -to $t -orient horizontal
    $w window create end -window $w.$v
    $w insert end "\n"
}

proc mkstdparms {w} {
    $w config -state normal
    $w delete 1.0 end

    mkdispparms $w
    p_scale $w 1 2000 num_max "NumOfMax"
    p_scale $w 1 100 minseglen "MinSegLen"
    p_scale $w 1 10 maxsegwidth "MaxSegWidth"
    p_scale $w 1 20 maxseggap "MaxSegGap"
    p_scale $w 0 25 noise "Noise"
    $w config -state disabled
}

proc mkdispparms {w} {
    label $w.dp -text "Display Parameters"
    $w window create end -window $w.dp
    $w insert end "\n"

    checkbutton $w.show_segments -text "Segments:" -variable show_segments \
	-offvalue 0 -onvalue 1 -relief raised -command {
	    showlines $segdisp
	}
    $w window create end -window $w.show_segments
    $w insert end "\n"
    button $w.raise_seg -text "Raise" -command { $segdisp raise thesegments }
    button $w.lower_seg -text "Lower" -command { $segdisp lower thesegments }
    button $w.del_seg -text "Delete" -command { $segdisp delete thesegments }
    $w window create end -window $w.raise_seg
    $w window create end -window $w.lower_seg
    $w window create end -window $w.del_seg
    $w insert end "\n"

    checkbutton $w.show_lines -text "Complete lines:" -variable show_lines \
	-offvalue 0 -onvalue 1 -relief raised -command {
	    showlines $segdisp
	}
    $w window create end -window $w.show_lines
    $w insert end "\n"
    button $w.raise_lines -text "Raise" -command { $segdisp raise fulllines }
    button $w.lower_lines -text "Lower" -command { $segdisp lower fulllines }
    button $w.del_lines -text "Delete" -command { $segdisp delete fulllines }
    $w window create end -window $w.raise_lines
    $w window create end -window $w.lower_lines
    $w window create end -window $w.del_lines
    $w insert end "\n"

    label $w.pp -text "Image:"
    $w window create end -window $w.pp
    $w insert end "\n"
    button $w.raise_pic -text "Raise" -command { $segdisp raise itag }
    button $w.lower_pic -text "Lower" -command { $segdisp lower itag }
    button $w.del_pic -text "Delete" -command { 
	$segdisp delete itag
	catch {image delete greypic}
    }
    $w window create end -window $w.raise_pic
    $w window create end -window $w.lower_pic
    $w window create end -window $w.del_pic
    $w insert end "\n"

    scale $w.gamma_accu -label "gamma v: disp accu" -variable gamma_accu \
	-from 0.5 -to 5.0 -resolution 0.05 -orient horizontal
    $w window create end -window $w.gamma_accu
    button $w.redisp_accu -text "Redisplay" -command {
	.control.t.p1 invoke
    }
    $w window create end -window $w.redisp_accu
    $w insert end "\n"

    $w insert end "\n"
}

proc set_defaults {} {
    global num_max minseglen maxsegwidth maxseggap noise segdisp
    set num_max 999
    set minseglen 10
    set maxsegwidth 2
    set maxseggap 5
    set noise 0.0
    set segdisp .display.segments
}

proc mkparms {} {
    global num_max minseglen maxsegwidth maxseggap noise
    return "-m $num_max -l $minseglen -w $maxsegwidth -g $maxseggap -n $noise"
}

proc complain {t} {
    set w .parmout.out
    $w config -state normal
    $w delete 1.0 end
    $w insert end "$t"
    $w config -state disabled
}

proc loadpic {pic iname} {
    global demopic picdir w_size tmpdir tmp_filesuffix
    if [catch {exec pnmscale -xsize $w_size -ysize $w_size $picdir/$pic > \
      $tmpdir/tkhough.pgm$tmp_filesuffix 2> /dev/null}] {
	complain "\n  ERROR: cannot load image"
	return 0
    } else {
	$iname read $tmpdir/tkhough.pgm$tmp_filesuffix
	catch {file delete -force -- $tmpdir/tkhough.pgm$tmp_filesuffix }
	return 1
    }
}

proc lp2 {pic iname} {	# XXX - better to find a way around this.
    global demopic w_size tmpdir tmp_filesuffix
    if [catch {exec pnmscale -xsize $w_size -ysize $w_size $pic > \
      $tmpdir/tkhough.pgm$tmp_filesuffix 2> /dev/null}] {
	complain "\n  ERROR: cannot load accumulator"
	catch {file delete -force -- $tmpdir/tkhough.pgm$tmp_filesuffix }
	return 0
    } else {
	$iname read $tmpdir/tkhough.pgm$tmp_filesuffix
	catch {file delete -force -- $tmpdir/tkhough.pgm$tmp_filesuffix }
	return 1
    }
}

proc showlines {w} {
    global xscale yscale w_size line_color show_lines show_segments tmpdir
    global tmp_filesuffix

    # canvas seems to be set at 2 pixels more than specified..
    set ws_p_2 [expr $w_size + 2]

    $w delete thesegments fulllines
    set foo [exec cat $tmpdir/points$tmp_filesuffix]
    regsub ".*Y2." $foo "" bar
    while {[regexp {[^\)]*\)[^\)]*\)} $bar range]} {
	regsub -all {[\(\) ]} $range "" range
	regsub -all -- {-} $range "," range
#	regsub -all { } $range " " range
	set range [string trim $range]
	set nums [split $range ,]
	set x1 [expr [lindex $nums 0] * $xscale]
	set y1 [expr [lindex $nums 1] * $yscale]
	set x2 [expr [lindex $nums 2] * $xscale]
	set y2 [expr [lindex $nums 3] * $yscale]

#	puts stdout "$range"

	# this looks like a lot of code, but saves time in graphics
	# it is about the opposite of what you're taught in
	# school about lines.

	if {[expr $y2 - $y1] != 0} {
	    set b [expr ($x1 - $x2) / ($y2 - $y1)]
	    set c [expr $x1 + ($y1 * $b)]
	    if {$b < 1 && $b > -1} {
		# for lines tending to vertical
		set xx1 $c
		set yy1 0
		set xx2 [expr $c - ($b * $ws_p_2)]
		set yy2 $ws_p_2
	    } else {
		# for slope tending to horizonal
		set xx1 0
		set yy1 [expr $c / $b]
		set xx2 $ws_p_2
		set yy2 [expr ($c - $ws_p_2) / $b]
	    }
	} else {
	    # for horizontal lines
	    set xx1 0
	    set yy1 $y1
	    set xx2 $ws_p_2
	    set yy2 $y1
	}

	# line segment
	if {$show_segments} {
	    $w create line $x1 $y1 $x2 $y2 -tags thesegments
	}

	# "whole line"
	if {$show_lines} {
	    $w create line $xx1 $yy1 $xx2 $yy2 -tags fulllines -fill $line_color
	}

	regsub {[^\)]*\)[^\)]*\)} $bar "" bar
    }
    $w raise fulllines
    $w raise thesegments
}

proc plotlines {w f} {
    global w_size
    $w delete all
    set FD [open $f r]
    set type [string trim [gets $FD]]
    set xaxis [string trim [gets $FD]]
    set yaxis [string trim [gets $FD]]
    regsub -all -- { +} $yaxis , yaxis
    regsub -all -- { +} $xaxis , xaxis
    set xaxis [split $xaxis ,]
    set yaxis [split $yaxis ,]
    set mx [lindex $xaxis 0]
    set my [lindex $yaxis 0]
    set xscale [expr $w_size.0 / {(} [lindex $xaxis 1] - $mx {)} ]
    set yscale [expr $w_size.0 / {(} [lindex $yaxis 1] - $my {)} ]
    set smx [expr $mx * $xscale]
    set smy [expr $w_size + $my * $yscale]
#    puts stderr "$mx $my $xscale $yscale"
    set lastx 0
    set lasty $w_size
    while {[set input [string trim [gets $FD]]] != ""} {
	regsub -all -- { +} $input , input
	set input [split $input ,]
	set newx [expr [lindex $input 0] * $xscale - $smx]
	set newy [expr $smy - [lindex $input 1] * $yscale]
	$w create line $lastx $lasty $newx $newy
#	    gets $FD
#	    gets $FD
	    set lastx $newx
	    set lasty $newy
    }
    close $FD
    if {$type == "Hits"} {
	mk_axes $w $w_size $mx [lindex $xaxis 1] $my [lindex $yaxis 1] \
	    picks maxs $type
    } else {
	mk_axes $w $w_size $mx [lindex $xaxis 1] $my [lindex $yaxis 1] \
	    picks cells $type
    }
}

proc plotpoints {w f} {
    global w_size
    $w delete all
    set FD [open $f r]
    set type [string trim [gets $FD]]
    set xaxis [string trim [gets $FD]]
    set yaxis [string trim [gets $FD]]
    regsub -all -- { +} $yaxis , yaxis
    regsub -all -- { +} $xaxis , xaxis
    set xaxis [split $xaxis ,]
    set yaxis [split $yaxis ,]
    set mx [lindex $xaxis 0]
    set my [lindex $yaxis 0]
    if [catch {set xscale [expr $w_size.0 / {(} [lindex $xaxis 1] - $mx {)} ]}] { 
	return
    }
    set yscale [expr $w_size.0 / {(} [lindex $yaxis 1] - $my {)} ]
    set smx [expr $mx * $xscale]
    set smy [expr $w_size + $my * $yscale]
#    puts stderr "$mx $my $xscale $yscale"
    set crad 3
    while {[set input [string trim [gets $FD]]] != ""} {
	regsub -all -- { +} $input , input
	set input [split $input ,]
	set newx [expr [lindex $input 0] * $xscale - $smx]
	set newy [expr $smy - [lindex $input 1] * $yscale]
	$w create oval [expr $newx-$crad] [expr $newy-$crad] \
		       [expr $newx+$crad] [expr $newy+$crad] \
			 -width 1 -outline black -fill blue
#	    gets $FD
#	    gets $FD
    }
    close $FD
    mk_axes $w $w_size $mx [lindex $xaxis 1] $my [lindex $yaxis 1] a b $type
}

proc mk_axes {w ws x1 x2 y1 y2 l1 l2 title} {
    global ax_font ax_color
    # the [expr stuff * 1] is a cheap trick to not waste decimal space
    # on zeros.
    $w create text 2 $ws -font $ax_font -justify left -anchor sw \
	-text "[expr $y1 * 1]\n [expr $x1 * 1] ($l1)" -fill $ax_color
    $w create text $ws $ws -font $ax_font -justify left -anchor se \
	-text [expr $x2 * 1] -fill $ax_color
    $w create text 2 2 -font $ax_font -justify right -anchor nw \
	-text [expr $y2 * 1] -fill $ax_color
    $w create text 2 [expr $ws / 2] -font $ax_font -justify left -anchor w \
	-text [expr ($y1 + $y2) / 2] -fill $ax_color
    $w create text [expr $ws / 2] $ws -font $ax_font -justify center -anchor s \
	-text [expr ($x1 + $x2) / 2] -fill $ax_color
#    $w create text [expr $ws * 3 / 4] $ws -font $ax_font -justify right \
#	-anchor se -text ($l1) -fill $ax_color
    $w create text 2 [expr $ws / 4] -font $ax_font -justify left -anchor nw \
	-text ($l2) -fill $ax_color

    $w create text [expr $ws / 2] 2 -font $ax_font -justify center -anchor n \
	-text $title -fill $ax_color
}

proc make-filelist {w} {
    global dirvar
    global $dirvar
    $w config -state normal
    $w delete 1.0 end
    $w insert end "click on a file or directory\n"
    $w insert end [exec ls -a [set $dirvar]]
    $w tag add clickTag 2.0 end
    $w tag bind clickTag <ButtonRelease-1> {
	set txt [%W get "@%x,%y linestart" "@%x,%y lineend"]
	%W tag add sel "@%x,%y linestart" "@%x,%y lineend"
	if {[file isdirectory "[set $dirvar]/$txt"]} {
	    # this is a nasty hack
	    set tmpd [pwd]
	    cd "[set $dirvar]/$txt"
	    set $dirvar [pwd]
	    cd $tmpd
	    make-filelist %W
	} else {
	    $file_func $txt
	}
    }
    $w config -state disabled
}

proc make-transformlist {w} {
    global tformdir tforms
    $w config -state normal
    $w delete 1.0 end
    $w insert end "click on a transform to select\n"
    foreach t_f $tforms {
	$w insert end "$t_f\n"
    }
    $w tag add clickTag 2.0 end
    $w tag bind clickTag <ButtonRelease-1> {
	set txt [%W get "@%x,%y linestart" "@%x,%y lineend"]
	%W tag add sel "@%x,%y linestart" "@%x,%y lineend"
	load-transform $txt
    }
    $w config -state disabled
}

proc sizepic {p} {
    # all this just to get the size of a pgm file. (one multi-line perl exp)
    set index 0
    set firstvar width
    set secondvar height
    set FD [open $p r]
    while {$index < 3} {
	set input [gets $FD]
	regsub -- {P.} $input "" input
	regsub -- {#.*$} $input "" input
	if {[set input [string trim $input]] != ""} {
	    set nums [split $input]
	    set $firstvar [lindex $nums 0]
	    set $secondvar [lindex $nums 1]
	    if {$height == ""} {
		set firstvar $secondvar
		set secondvar foobar
	    } else { set index 3 }
	}
	if {[eof $FD]} { set index 5 }
    }
    close $FD
    return "$width $height"
}

proc load-edges {t} {
    global edpic xscale yscale picdir w_size pic_x pic_y
    if [loadpic $t edgepic] {
	set edpic $t
	set size [split [sizepic $picdir/$edpic]]
#	set size [split [exec head -2 $picdir/$edpic | tail -1]]
# grrr
	set xscale [expr $w_size.0 / [lindex $size 0]]
	set yscale [expr $w_size.0 / [lindex $size 1]]
#	puts stdout "$xscale $yscale"
	set pic_x [lindex $size 0]
	set pic_y [lindex $size 1]
	update-dis
	complain "$edpic: ok"
    }
}

proc load-grey {t} {
    global segdisp w_size

    catch {image delete greypic}

    image create photo greypic -palette 128 -width $w_size -height $w_size
    $segdisp create image 0p 0p -image greypic -anchor nw -tag itag
    set greypic $t
    loadpic $greypic greypic
    $segdisp lower itag
}

proc load_grey_accu {w} {
    global segdisp w_size gamma_accu tmpdir tmp_filesuffix

    catch {image delete accupic}

    $w delete all
    image create photo accupic -palette 128 -gamma $gamma_accu \
	-width $w_size -height $w_size
    $w create image 0p 0p -image accupic -anchor nw -tag accu
    # XXX gotta eliminate this
    lp2 $tmpdir/accu$tmp_filesuffix.pgm accupic
    $w lower itag
}

proc load-transform {t} {
    global theproc ht_libdir
    if {[regexp {_line} $t]} {
	source $ht_libdir/$t.tcl
	init_$theproc
#	set theproc $t
#	puts stdout "proc changed to $theproc"
	update-buttons
	update-dis
    } else {
	complain "ERROR: not a transform"
    }
}

proc update-dis {} {
    global theproc edpic pic_x pic_y
    set ww .files 
    $ww config -state normal
    $ww delete 1.0 end
    $ww insert end "transform: $theproc, edges: $edpic ($pic_x x $pic_y)"
    $ww config -state disabled
}

text .help -relief groove -height 1 -state disabled
pack .help -side bottom -fill x

proc confighelp {w m} {
    bind $w <Motion> "showhelp $w \"$m\""
    bind $w <Leave> "showhelp $w \"\""
}

proc showhelp {w m} {
    .help config -state normal
    .help delete 1.0 end
    .help insert end "$m"
    .help config -state disabled
}

frame .display
pack .display -side bottom -anchor w
# image create photo greypic -palette 128 -width $w_size -height $w_size
image create photo edgepic -palette 128 -width $w_size -height $w_size
exec pnmscale -xsize $w_size -ysize $w_size $picdir/$inpic > \
    $tmpdir/tkhough.pgm$tmp_filesuffix 2> /dev/null
# label .display.greypic -image greypic
# pack .display.greypic -side left

button .display.edgepic -image edgepic -relief flat -command {
    set file_func load-edges
    set dirvar picdir
    make-filelist .parmout.parms
}

pack .display.edgepic -side left

confighelp .display.edgepic "Edges: M1: Load edge image"

canvas .display.segments -width $w_size -height $w_size -background white
pack .display.segments -side left

bind .display.segments <Button-1> {
    set file_func load-grey
    set dirvar picdir
    make-filelist .parmout.parms
}
bind .display.segments <Double-Button-1> {
    .control.t.trans flash
    .control.t.trans invoke
}
bind .display.segments <Button-2> {
    .control.t.parms flash
    .control.t.parms invoke
}
bind .display.segments <Button-3> {
    .control.t.doit invoke
}

confighelp .display.segments \
 "Output: M1: Load grey, M2: Parms, M3: Run transform, DoubleM1: Pick transform"

canvas .display.graph -width $w_size -height $w_size -background white
	
pack .display.graph -side left

bind .display.graph <Button-1> {
    .control.t.p1 invoke
}
bind .display.graph <Button-2> {
    .control.t.p2 invoke
}
bind .display.graph <Button-3> {
    .control.t.p3 invoke
}

confighelp .display.graph \
    "Output Graph: M1: Accumulator, M2: Accum size, M3: Hits"

# loadpic $inpic greypic
loadpic $edpic edgepic

# one-line status indicator
text .files -height 1 -state disabled -relief flat
pack .files -side bottom -fill x

# parms, output window

frame .parmout
pack .parmout -side bottom -fill both -expand 1 -anchor w

text .parmout.parms -width 30 -height 12 -state disabled \
    -cursor top_left_arrow -yscrollcommand {.parmout.pbar set}
scrollbar .parmout.pbar -orient vertical -command {.parmout.parms yview}

text .parmout.out -width 45 -height 12 -state disabled\
    -cursor top_left_arrow -yscrollcommand {.parmout.obar set}
scrollbar .parmout.obar -orient vertical -command {.parmout.out yview}

pack .parmout.pbar -side left -fill y
pack .parmout.parms -side left -fill both -expand 1
pack .parmout.obar -side left -fill y
pack .parmout.out -side left -fill both -expand 1

# control frame(s)

frame .control
pack .control -side bottom -fill x

frame .control.t
pack .control.t -side top -fill x

button .control.t.trans -text "Transform.." -command {
#    set file_func load-transform
    make-transformlist .parmout.parms
}

button .control.t.parms -text "Parms" -command {
    mkstdparms .parmout.parms
}

button .control.t.doit -text "Do It" -command {
    do_$theproc .parmout.out
    showlines $segdisp
}

button .control.t.p1 -text "Accum" -command {
    if {$accum_type == "bitmap"} {
	load_grey_accu .display.graph
    } else {
	plotpoints .display.graph hough1.ptcl
    }
}
button .control.t.p2 -text "Ac. Size" -command {
    plotlines .display.graph hough2.ptcl
}
button .control.t.p3 -text "Hits" -command {
    plotlines .display.graph hough3.ptcl
}

proc update-buttons {} {
    set accum .control.t.p1
    set hist .control.t.p2
    set hits .control.t.p3

    foreach but {accum hist hits} {
	# this was kind of bad planning
	set blah $but
	append blah _type
	global $blah
	if {[set $blah] == "none"} {
	    [set $but] config -state disabled
	} else {
	    [set $but] config -state normal
	}
    }
}

button .control.t.quit -text "Quit" -command {
    cleanup
}

pack \
    .control.t.trans \
    .control.t.parms \
    .control.t.doit \
    .control.t.p1 .control.t.p2 .control.t.p3 \
	-side left -anchor w

pack \
    .control.t.quit \
	-side right -anchor e

confighelp .control.t.trans "Transformation: Choose transformation"
confighelp .control.t.parms "Parameters: Change parameters"
confighelp .control.t.doit "Do It: Run the transformation"
confighelp .control.t.p1 "Accum: Show accumulator"
confighelp .control.t.p2 "Size: Show accumulator size graph"
confighelp .control.t.p3 "Hits: Show hits graph"
confighelp .control.t.quit "Quit: Exit the program"

set_defaults
update-dis

source $ht_libdir/$theproc.tcl
init_$theproc
update-buttons

