#!/bin/sh -e
# Start wish without assume install location \
        exec wish $0 ${1+"$@"}

#  SAM:  Sequence Alignment and Modeling Software System
#                                                                  
#  Baskin Center for Computer Engineering and Information Sciences 
#  University of California, Santa Cruz                            
#                                                                  
#  Copyright 1992-1999, The Regents of the University of California     
#
#  Citations:  A. Krogh et al., JMB 235:1501-1531, Feb. 1994.
#              R. Hughey, A. Krogh, CABIOS 12:95-107, 1996.
#
#  Distributed for non-commercial use only.
#  http://www.cse.ucsc.edu/research/compbio/sam.html
#  Questions or comments to sam-info@cse.ucsc.edu
#

set ppmtogif /usr/bin/ppmtogif
set xwd      /usr/X11R6/bin/xwd
set font -*-Helvetica-Medium-R-Normal--*-140-*-*-*-*-*-*
set rectx 0
set recty 0
set minx 0
set maxx 0
set miny 0
set maxy 0

proc read_data_file {filename} {
	global data name max_val min_val row column
	puts "Reading Data"
    set fp [open $filename r]
	set row 0
	while {([gets $fp line])!=-1} {
	    # Old format:  Residue 71 prob prob prob ....
	    if {([string range $line 0 6]=="Residue")} { 

		set name($row) [lindex $line 1]
		set data($row) [lrange $line 2 end]
		if {( $row == 0 )} {
			set max_val [lindex $data($row) 0]
			set min_val [lindex $data($row) 0]
		} 
		foreach val $data($row) {
			if {( $val > $max_val )} {set max_val $val}
			if {( $val < $min_val )} {set min_val $val}
		}
		incr row 1
	    }
            # New format: (Residue 71 DM+MM+IM) prob prob prob prob ...
	    if {([string range $line 0 7]=="(Residue")} { 
		set name($row) [lindex $line 1]
		set data($row) [lrange $line 3 end]
		if {( $row == 0 )} {
			set max_val [lindex $data($row) 0]
			set min_val [lindex $data($row) 0]
		} 
		foreach val $data($row) {
			if {( $val > $max_val )} {set max_val $val}
			if {( $val < $min_val )} {set min_val $val}
		}
		incr row 1
	    }
	}
	set column [llength $data(0)]
	close $fp
}
proc make_image {min max} {
    global data row  pid column

    # here comes some bogus stuff, ppm is not working in wish, so
    # create a ppm, write it out, convert to gif, read in gif.
    # yeah it's bogus...

puts "Creating PPM"
	set fp [open /tmp/temp$pid.ppm w]
	puts $fp P2
	puts $fp "$column $row"
	puts $fp 255
	set conversion_factor [expr 255./($max -$min)]
	for { set n [expr $row -1] } { ( $n >= 0 ) } { incr n -1 } {
	    foreach val $data($n) {
		set compute [expr int(($val-$min) * $conversion_factor)]
		if { ( $compute < 0 )}  { set compute 0 } 
		if { ( $compute > 255 )}  { set compute 255 } 
		puts $fp  [expr 255 - $compute]
	    }
		
	}

	close $fp
puts "Creating GIF"
exec sh -c  "ppmtogif /tmp/temp$pid.ppm > /tmp/temp$pid.gif 2> /dev/null "
exec sh -c "rm /tmp/temp$pid.ppm"

	
}
proc contrast-redisplay {} {
	global pid min_val max_val
	set val [.full.contrast get]
	set newmin 0
	set newmax [expr (1-$val) * $max_val]
	make_image $newmin $newmax
	im1 read /tmp/temp$pid.gif
}
proc redisplay_zoom {} {
	global minx maxx miny maxy
	set zoom [.zoom.sc-zoom get]
	im-zoom blank
	im-zoom copy im1 -from [expr int($minx)] [expr int($miny)] \
		[expr int($maxx)] [expr int($maxy)] -zoom $zoom 

	.zoom.c delete axis
	.zoom.c addtag axis withtag [.zoom.c create rect 0 0 \
		[expr ($maxx-$minx)*$zoom] \
		[expr ($maxy-$miny)*$zoom] -outline blue]
	label_zoom_axis
}
proc show_spot_zoom {x y} {
    global data name column row
	global minx maxx miny maxy

	set zoom [.zoom.sc-zoom get]
	if {(($y <=[expr $zoom * $maxy]) && ( $x <= [expr $zoom * $maxx]))} {
	    if {($y >=[expr $zoom * $maxy])} {set y [expr $zoom * $maxy-1]}
	    if {($x >=[expr $zoom * $maxx])} {set x [expr $zoom * $maxx-1]}
	    set xz [expr int($x/$zoom) +int($minx)]
	    set yz [expr int($y/$zoom) +int($miny)]
	     #puts stdout " DEBUG $xz $yz $minx $maxx $miny $maxy"
	    if {(( $row-$yz-1)>=0)} {
		if {($xz <= $maxx) && ($yz<=$maxy)} {
		     puts stdout "Zoom window  x=$xz y=$yz \
		     residue=$name([expr $row-$yz-1]) \
		     value=[lindex $data([expr $row-$yz-1]) $xz]"
		 }
		.zoom.label configure -text "x=$xz y=$yz\
		    residue=$name([expr $row-$yz-1]) \
		    value=[lindex $data([expr $row-$yz-1]) $xz]"
	    }

     }

}
proc GetAPid {} {
    return [exec sh -c {echo $$}]
}
proc rect_move {c x y} {
	global minx maxx miny maxy row column rectx recty
	$c delete newrect
	set rectx $x
	set recty $y
	set zoom [.zoom.sc-zoom get]
	#Melissa can change the following lines to get a non-changing
	#zoom window size
	set minx [expr $x-(250/$zoom) ]
	set maxx [expr $x+(250/$zoom) ]
	set miny [expr $y-(250/$zoom) ]
	set maxy [expr $y+(250/$zoom) ]
	if {($minx<0)} { set minx 0}
	if {($miny<0)} { set miny 0}
	if {($maxx<0)} { set maxx 0}
	if {($maxy<0)} { set maxy 0}
	if {($minx>$column)} { set minx [expr $column-1]}
	if {($miny>$row)} { set miny $row}
	if {($maxx>$column)} { set maxx [expr $column-1]}
	if {($maxy>$row)} { set maxy $row}
	#puts "Debug in here $minx $miny $maxx $maxy zoom=$zoom"
	$c addtag newrect withtag [$c create rect $minx $miny $maxx $maxy \
			-outline red]
}

proc print-zoom {} {
    global pid
    puts "Here goes attempted printout "
    puts "check out /tmp/temp$pid.xbm"
    exec sh -c "xwd -out /tmp/temp$pid.xbm -name zoom"
}
proc label_full_axis {} {
global data row column name

    for { set n 1 } { ( $n <= $row ) } { incr n 100 } {
	if {(( $row-$n-1)>=0)} {
	    .full.c create text [expr $column +7] [expr $n +5]\
		-text $name([expr $row-$n-1]) -anchor w
	}
    }
    for { set n 0 } { ( $n <= $column ) } { incr n 100 } {
	.full.c create text $n [expr 10 +$row] -text $n -anchor w
    }
}
proc label_zoom_axis {} {
global data row column name minx maxx miny maxy

    set zoom [.zoom.sc-zoom get]
    .zoom.c delete zoomaxis
    for { set n $miny } { ( $n <= $maxy ) } { incr n 10 } {
	 if {( ($row-1-$n) >=0 )} {
	    .zoom.c addtag zoomaxis withtag [.zoom.c create text  \
		[expr $zoom*($maxy-$miny) +7] [expr ($n-$miny)*$zoom +5]\
		-text $name([expr $row-1-$n]) -anchor w]
	   }
    }
    for { set n $minx } { ( $n <= $maxx ) } { incr n 10 } {
	.zoom.c addtag zoomaxis withtag [.zoom.c create text \
		[expr $zoom*($n-$minx)] \
		[expr 10 +($maxy-$miny)*$zoom] -text $n -anchor w] 
    } 
}
proc quit-all {} {
	global pid
	exec rm /tmp/temp$pid.gif
	destroy .
}


proc setup_full {} {
    global column row

    toplevel .full
    wm geom .full +0+20

    frame .full.menuBar
    pack .full.menuBar -side top -fill x
    menubutton .full.menuBar.file -text File -menu .full.menuBar.file.m \
	-underline 0
    menu .full.menuBar.file.m
    .full.menuBar.file.m add sep
    .full.menuBar.file.m add command -label "Quit" -command quit-all \
	    -underline 0
    pack .full.menuBar.file -side left

    image create photo im1
    canvas .full.c -width 13c -height 13c
    .full.c create image 0 0 -image im1 -anchor nw
    pack .full.c


    scale .full.contrast  -orient horizontal -resolution -1 -from 0 -to .99 \
	-label "Contrast Stretch" 
    pack .full.contrast  -fill x

    .full.c create rect 0 0 [expr 1+ $column] [expr 1+ $row] -outline blue
    label_full_axis
}

proc setup_zoom {} {
    toplevel .zoom
    wm geom .zoom -0+20
    frame .zoom.menuBar
    pack .zoom.menuBar -side top -fill x
    menubutton .zoom.menuBar.file -text File -menu .zoom.menuBar.file.m \
	-underline 0
    menu .zoom.menuBar.file.m
    .zoom.menuBar.file.m add command -label "Print Zoom (Not working)" \
	-command print-zoom -underline 0
    .zoom.menuBar.file.m add sep
    .zoom.menuBar.file.m add command -label "Quit" -command quit-all \
	-underline 0
    pack .zoom.menuBar.file -side left

    image create photo im-zoom
    scale .zoom.sc-zoom  -orient horizontal -from 2 -to 10 -label "Zoom Factor"
    .zoom.sc-zoom set 5
    label .zoom.label
    pack .zoom.label
    pack .zoom.sc-zoom -fill x

    im-zoom copy im1 -from 0 0 0 0 -zoom 5

    canvas .zoom.c -width 13c -height 13c
    .zoom.c create image 0 0 -image im-zoom -anchor nw
    pack .zoom.c
}

proc do_bindings {} {

    bind .full.c <B1-Motion> "rect_move .full.c %x %y"
    bind .full.c <B1-ButtonRelease> redisplay_zoom

    bind .full.contrast <B1-ButtonRelease> {contrast-redisplay; redisplay_zoom}

    bind .zoom.c <1> "show_spot_zoom %x %y"
    bind .zoom.sc-zoom <B1-ButtonRelease> { rect_move .full.c $rectx $recty;redisplay_zoom}

    bind all <3> quit-all
}
proc get_filename {} {
    global argc argv argv0 filename
    if {( $argc < 1 )} {
	    puts "Usage: $argv0 filename \n where filename has DNA match up data"
	    exit -1
    }
    set filename [lindex $argv 0]
}

set pid [GetAPid]
get_filename
    #set filename toy2.pdoc
#    set filename t2_1psdA.pdoc

read_data_file $filename
make_image  $min_val $max_val
set rectx [expr int($column/2)]
set recty [expr int($row/2)]

setup_full
im1 read /tmp/temp$pid.gif

setup_zoom
do_bindings
rect_move .full.c $rectx $recty
redisplay_zoom
