# zoomseq.tcl  -- VMD script to list/select sequence of a protein molecule
#
# Barry Isralewitz     2000-Dec-28   ZoomSeq 0.9a
# barryi@ks.uiuc.edu
#
#

puts "starting ZoomSeq 0.9a..."

trace vdelete scaley w redraw
trace vdelete scaley w redraw
trace vdelete vmd_pick_atom w  list_pick
trace vdelete vmd_pick_atom w list_pick


proc redraw {name func op} { 

    global x1 y1 so sb w xcanwindowmax ycanwindowmax xcanmax ycanmax  ybox ysize resnamelist structlist betalist sel canvasnew scaley dataVal dataValNum dataName dataNameNum ytopmargin ybottommargin textskip   xcolbond_rad bond_res rep xcol

    destroy $w.can   
    

    #----start make window

    set ysize [expr $ytopmargin+ $ybottommargin + ($scaley *  $ybox * ($dataValNum + 1) )]    

    makecanvas


    #----end make window

    #The first 3 fields, 0 to 2 are printed all together, they are text
    set xcol(0) 10.0

    #The 4th field (field 3) is the "first data field"
    set xcol(3) 83
    set xcol(4) 163
    set xcol(5) 243

    #when adding new column, add to this list (maybe adjustable later)

    #The picked fields 

    set y 0.0
    set field 0 
    #note that the column will be 0, but the data will be from picked
    
    
    
    for {set i 0} {$i<=$dataValNum} {incr i} {
	if  {$dataVal(picked,$i) == 1} {
	    set ypos [expr $ytopmargin+ ($scaley * $i *$ybox)]
	    
	    set red 255
	    set green 255
	    set blue 0
	    #convert red bblue green 0 - 255 to hex
	    set hexred     [format "%02x" $red]
	    set hexgreen   [format "%02x" $green]
	    set hexblue    [format "%02x" $blue]
	    
	    #draw data rectangle
	    set dataVal(pickedId,$i)  [$w.can create rectangle  [expr $xcol($field) - 5] [expr $ypos - ($scaley * 15)] [expr $xcol([expr $field + 3]) - 2 ] $ypos  -fill "\#${hexred}${hexgreen}${hexblue}" -outline "" ]
	    
	}
	
    }
    


    set yDataEnd [expr $ytopmargin + ($scaley * $ybox * ($dataValNum +1))]
    set y 0.0
    set yposlast  -10000.0
    set field 0    	 


    #don't do $dataValNum, its done at end
    for {set i 0} {$i <= $dataValNum} {incr i} {
	set ypos [expr $ytopmargin + ($scaley * $y)]
	if { ( ($ypos - $yposlast) >= $textskip) && ( ( $i == $dataValNum) || ( ($yDataEnd - $ypos) > $textskip) ) } {

	    $w.can create text [expr $xcol(3) - 4 ] $ypos -text "$dataVal(0,$i) $dataVal(1,$i) $dataVal(2,$i)" -width 200 -font fixed -justify right -anchor se -tags $dataName($field)
	    set yposlast  $ypos
	}        
	set y [expr $y + $textskip]
	
    }
    

    

    #print the beta field (field 3)
    set y 0.0
    set field 3
    
    for {set i 0} {$i<=$dataValNum} {incr i} {
	set ypos [expr $ytopmargin + ($scaley * $y)]

	#PRESCAN to find range of values!
	set intensity  [expr int (255 * ($dataVal($field,$i) /150))]
	if {$intensity < 0} {set intensity 0}
	if {$intensity > 255} {set intensity 255}
	set red $intensity
	set green [expr 255 - $intensity]
	set blue 150 
	#convert red bblue green 0 - 255 to hex
	set hexred     [format "%02x" $red]
	set hexgreen   [format "%02x" $green]
	set hexblue    [format "%02x" $blue]
	
	#draw data rectangle
	set sor [$w.can create rectangle  [expr $xcol($field)] [expr $ypos - ($scaley * 15)] [expr $xcol([expr $field + 1]) -15 ]  $ypos  -fill "\#${hexred}${hexgreen}${hexblue}" -outline "" ]
	
	set y [expr $y + $ybox]
	
    }
    
    
    #put struct
    
    set y 0.0
    set field 4
    
    for {set i 0} {$i<=$dataValNum} {incr i} {
	set ypos [expr $ytopmargin+ ($scaley * $y)]
	switch $dataVal($field,$i) {
	    
	    B {set red 180; set green 180; set blue 0}
	    C {set red 255; set green 255; set blue 255}
	    E {set red 255; set green 255; set blue 100}
	    T {set red 70; set green 150; set blue 150}
	    G {set red 255; set green 160; set blue 255}
	    H {set red 225; set green 130; set blue 225}
	    default {set red 100; set green 100; set blue 100}
	}
	
	set hexred     [format "%02x" $red]
	set hexgreen   [format "%02x" $green]
	set hexblue    [format "%02x" $blue]
	
	#draw data rectangle
	set sor [$w.can create rectangle  [expr $xcol($field)] [expr $ypos - ($scaley * 15)] [expr $xcol([expr $field + 1]) -15 ]  $ypos  -fill "\#${hexred}${hexgreen}${hexblue}" -outline "" ]

	
	set y [expr $y + $ybox]
    }
}


proc makecanvas {} {
    global xcanmax ycanmax w ysize xcanwindowmax ycanwindowmax
    
    set xcanmax 700.0
    set ycanmax $ysize

    canvas $w.can -width $xcanwindowmax -height $ycanwindowmax -bg grey -xscrollcommand "$w.xs set" \
	-yscrollcommand "$w.ys set" -scrollregion  "0 0 $xcanmax $ycanmax" 

    pack $w.can $w.ys -in $w.cfr -side left -fill x -fill y    
    

    place $w.xs -in $w.can -bordermode outside -rely 1.0 -relx 0.0 -anchor nw -relwidth 1.0
    bind $w.can <ButtonPress>  {GetStarted %x %y}
    bind $w.can <B1-Motion> {KeepMoving %x %y}
    bind $w.can <ButtonRelease> {LetGo %x %y}
}

proc list_pick {name element op} {
    

    global   w xcanmax ycanmax  xcanwindowmax ycanwindowmax ybox ytopmargin ybottommargin textskip scaley dataVal dataValNum dataName dataNameNum bond_rad bond_res rep xcol vmd_pick_atom ysize
    # get the coordinates


    set current_mol 0
    #later deal with top (and rep)  etc. for multi-mol use

    set sel [atomselect $current_mol "index $vmd_pick_atom"]
    
    set pickedresid [lindex [$sel get {resid}] 0] 
    set pickedchain  [lindex [$sel get {chain}] 0] 
    set pickedresname [lindex  [$sel get {resname}] 0]

    for {set i 0} {$i <= $dataValNum} {incr i} {

	if {($dataVal(0,$i) == $pickedresid) && ($dataVal(1,$i) == $pickedresname) &&  ($dataVal(2,$i) == $pickedchain)} {
	    set pickedOne $i

	    break
	}
    }

    set ypos [expr $ytopmargin+ ($scaley * $i *$ybox)]

    #delete all from canvas
    for {set i 0} {$i <= $dataValNum} {incr i} {
	set dataVal(picked,$i) 0
	if {$dataVal(pickedId,$i) != "null"} {
	    $w.can delete $dataVal(pickedId,$i)
	    set dataVal(pickedId,$i) "null"
	}
	
    }
    
    set dataVal(picked,$pickedOne) 1
    #make a new highlight on canvas
    set red 255
    set green 255
    set blue 0
    #convert red green  blue to: 0 - 255 to hex
    set hexred     [format "%02x" $red]
    set hexgreen   [format "%02x" $green]
    set hexblue    [format "%02x" $blue]
    set field 0

    
    #draw highlight
    set dataVal(pickedId,$pickedOne)  [$w.can create rectangle  [expr $xcol($field) - 5] [expr $ypos - ($scaley * 15)] [expr $xcol([expr $field + 3]) - 2 ] $ypos  -fill "\#${hexred}${hexgreen}${hexblue}" -outline "" ]
    
    $w.can lower $dataVal(pickedId,$pickedOne)  [list "resid"]
    
    set center [expr $ytopmargin + ($ybox * $scaley * $pickedOne) ] 
    set top [expr $center - 0.5 * $ycanwindowmax]
    if {$top < 0} {
	set top 0
    }
    set yfrac [expr $top / $ysize]

    $w.can yview moveto $yfrac
    
    
    mol selection resid $dataVal(0,$pickedOne) and  chain $dataVal(2,$pickedOne)
    mol modrep $rep(0) 0 
    mol color ColorID 4 
    mol modstyle $rep(0)  0 Bonds $bond_rad $bond_res
    
    
}




#------------------------
#------------------------
# main code starts here

set eo 0
set x1 0
set y1 0
set bond_rad 0.5
set bond_res 10
#set canvasnew 1
set sb "" 
set so ""
global sb so x1 y1 lw  ;#declare some globals
global xcanmax ycanmax ybox ysize 

#lets these be destroyed in earlier tcl's
set w ""
set $w.can ""
destroy w
destroy w.can

set scaley 1


set ybox 15.0
set ytopmargin 20
set ybottommargin 20
set xcanwindowmax 260
set ycanwindowmax 620
#text skip doesn't need to be same as ybox (i.e. bigger numbers than boxes in 1.0 scale)
set textskip 15

set rep(0) [molinfo 0 get numreps]
set sel [atomselect 0 "all and name CA"]
#below assumes sel retrievals in same order each time, fix this 
#by changing to one retreival and chopping up result
set datalist  [$sel get {resid resname chain}]




# the names for  three fields of data 

#just for self-doc
# dataVal(picked,n) set if the elem is picked
# dataVal(pickedId,n) contains the canvas Id of the elem's highlight rectangle

set dataName(picked) "picked" 
set dataName(pickedId) "pickedId"
#not included in count of # datanames

set dataName(0) "resid"
set dataName(1) "resname"
set dataName(2) "chain"

set dataNameNum 3
#The number of dataNames

#lets fill  a dataNameNum x dataValNum array
#dataValNum we'll be the number of objects we found with VMD search
#if doing proteins, liekly all residues, found with 'name CA'
set dataValNum 0
foreach elem $datalist {

    #set picked state to false -- 'picked' is only non-numerical field
    set dataVal(picked,$dataValNum) 0
    set dataVal(pickedId,$dataValNum) "null"
    set dataVal(0,$dataValNum) [ lindex [split $elem] 0]

    set dataVal(1,$dataValNum) [ lindex [split $elem] 1]
    set dataVal(2,$dataValNum) [ lindex [split $elem] 2]

    incr dataValNum
}
set dataValNum [expr $dataValNum -1]


if {$dataValNum < 1 } {
    puts "Couldn't find protein loaded.\n"
}
#So dataValNum is number of the last dataVal.  It is also #elements -1, 
#sicne we zero-count.

#Other variable-adding methods
#should not change this number.  We trust $sel to always
#give dataValNum elems, other methods might not work as well.


#handle if this value is 0 or -1


#don't need datalist anymore
unset datalist 

#draw first selection, as first residue 

mol selection resid $dataVal(0,0) and chain  $dataVal(2,0)   
mol material Opaque
mol color ColorID 4
mol addrep 0
mol modstyle $rep(0)  0 Bonds $bond_rad $bond_res


#now lets fill in some data


#fill in betalist (B-factors/temp factors called beta by VMD)
set betalist [$sel get beta]


set dataName($dataNameNum) "beta"


set i 0
foreach elem $betalist {

    set dataVal($dataNameNum,$i) $elem
    incr i
}


unset  betalist ;#done with it
incr dataNameNum ;
# Now there are 4 dataNames, last is numbered 3.  current
#value of dataNameNum is 4.

#fill in structlist
set structlist [$sel get structure]
set dataName(dataNameNum) "struct"


set i 0
foreach elem $structlist {
    set dataVal($dataNameNum,$i) $elem
    incr i
}
incr dataNameNum

unset structlist; #done with it



#set the interface
set w [toplevel .zoomSeqWindow]
wm title $w "ZoomSeq"

label $w.title -text "ZoomSeq"

frame $w.fr -width 700 -height 800 -bd 2 ;#main frame
pack $w.fr

label $w.txtlab -text "Zoom "




#frame $w.fr.menubar -relief raised -bd 2
#pack $w.fr.menubar -padx 1 -fill x

frame $w.fr.panl -width 130 -height 700 -bg grey  
frame $w.cfr -width 500 -height 640 -bd 1

scale $w.fr.panl.zoomlevel -from 0.01 -to 2.0 -length 150 -sliderlength 30  -resolution 0.01 -tickinterval 0.5 -showvalue true -variable scaley 

pack $w.fr.panl $w.cfr -in $w.fr -side left -padx 2
pack $w.fr.panl.zoomlevel -in $w.fr.panl -side right -padx 2 
#drw canvas

scrollbar $w.ys -command "$w.can yview" 
scrollbar $w.xs -orient horizontal -command "$w.can xview"


#the w.can object made here
set ysize [expr $ytopmargin+ $ybottommargin + ($scaley *  $ybox * ($dataValNum + 1))]    
makecanvas

place $w.txtlab -in $w.fr.panl.zoomlevel  -bordermode outside -rely 0.0 -relx 0.5 -anchor s

#done with interface elements     



#watch the slider value, tells us when to redraw
trace variable scaley w {redraw}
trace variable vmd_pick_atom w list_pick

#redraw first time
redraw name func ops

#set the canvas tool, right now there's only one, object selector
set sb "obj"


proc  GetStarted {x y} {
    global w x1 y1 sb so str eo g
    global xcanmax ycanmax

    
    #calculate offset for canvas scroll
    
    set x [expr $x + $xcanmax * [lindex [$w.can xview] 0]] 
    set y [expr $y + $ycanmax * [lindex [$w.can yview] 0]] 
    
    set x1 $x
    set y1 $y

    #Might have other canvas tools in future..	 
    if { [string compare $sb "obj"] == 0} {
	set so [$w.can create rectangle $x $y $x $y -fill {} -outline red]
	set eo $so
	return
    } 

    
}


proc KeepMoving {x y} {
    global x1 y1 so sb w xcanmax ycanmax
    
    #next two lines for debeugging only
    set windowx $x
    set windowy $y 
    #calculate offset for canvas scroll
    set x [expr $x + $xcanmax * [lindex [$w.can xview] 0]] 
    set y [expr $y + $ycanmax * [lindex [$w.can yview] 0]] 
    

    if {[string compare $sb "text"] == 0 } {
	return
    }


    $w.can coords $so $x1 $y1 $x $y


}

proc LetGo {x y} {

    global x1 y1 so sb eo w xcanmax ycanmax ySelStart ySelFinish ybox ytopmargin ybottommargin textskip scaley dataVal dataValNum dataName dataNameNum bond_rad bond_res rep xcol
    
    #calculate offset for canvas scroll
    set x [expr $x + $xcanmax * [lindex [$w.can xview] 0]] 
    set y [expr $y + $ycanmax * [lindex [$w.can yview] 0]] 

    #Might have other canvas tools in future...
    if { [string compare $sb "obj"] == 0} {


	if {$y1 < $y} {
	    set ySelStart $y1
	    set ySelFinish $y}  else {
		
		set ySelStart $y
		set ySelFinish $y1
	    }
	
	set startObject [expr 1.0 + ((0.0 + $ySelStart - $ytopmargin) / ($scaley * $ybox))]
	set finishObject [expr 1.0 + ((0.0 + $ySelFinish - $ytopmargin) / ($scaley * $ybox))]
	
	#set flag if single click only (change this to shift key method)
	if {$startObject == $finishObject} {
	    set singleClick 1

	} else {
	    set singleClick 0
	}

	if {$startObject < 0} {set startObject 0}
	if {$finishObject < 0} {set finishObject 0}
	if {$startObject > $dataValNum} {set startObject   $dataValNum }
	if {$finishObject > $dataValNum} {set finishObject $dataValNum }
	set startObject [expr int($startObject)]
	set finishObject [expr int($finishObject)]
	
	
	

	#clear all if was single click (change this to shift-key method)
	if {$singleClick == 1} {

	    for {set i 0} {$i <= $dataValNum} {incr i} {
		set dataVal(picked,$i) 0
		if {$dataVal(pickedId,$i) != "null"} {
		    $w.can delete $dataVal(pickedId,$i)
		    set dataVal(pickedId,$i) "null"
		}
	    }
	} else {
	    #for now, clear all anyway
	    for {set i 0} {$i <= $dataValNum} {incr i} {
		if {$dataVal(pickedId,$i) != "null"} {
		    $w.can delete $dataVal(pickedId,$i)
		    set dataVal(pickedId,$i) "null"
		}
		
	    }
	}
	    
	#set flags for selection
	for {set i $startObject} {$i <= $finishObject} {incr i} {
	    set dataVal(picked,$i) 1
	}
	
	
	
	set field 0
	#note that the column will be 0, but the data will be from picked
	
	
	
	for {set i 0} {$i<=$dataValNum} {incr i} {
	    if  {$dataVal(picked,$i) == 1} {
		set ypos [expr $ytopmargin+ ($scaley * $i *$ybox)]
		
		set red 255
		set green 255
		set blue 0
		#convert red blue green 0 - 255 to hex
		set hexred     [format "%02x" $red]
		set hexgreen   [format "%02x" $green]
		set hexblue    [format "%02x" $blue]
		
		#draw highlight
		set dataVal(pickedId,$i)  [$w.can create rectangle  [expr $xcol($field) - 5] [expr $ypos - ($scaley * 15)] [expr $xcol([expr $field + 3]) - 2 ] $ypos  -fill "\#${hexred}${hexgreen}${hexblue}" -outline "" ]


		$w.can lower $dataVal(pickedId,$i)  "resid"

	    }
	    
	}
	
	#make selection string to display in VMD
	set ll "" 
	set prevChain "Empty";#Cannot be held by chain
	for {set i 0} {$i <= $dataValNum} {incr i} {
	    if {$dataVal(picked,$i) == 1} {
		if { [string compare $prevChain $dataVal(2,$i)] != 0} {
		    #chain is new or has changed
		    append ll ") or (chain $dataVal(2,$i)  and resid $dataVal(0,$i)"
		} else {
		    append ll " $dataVal(0,$i)"
		}
		set prevChain $dataVal(2,$i)
	    }
	}
	append ll ")"
	set ll [string trimleft $ll ") or " ]

	
	mol selection $ll  
	mol modrep $rep(0) 0
	mol modstyle $rep(0)  0 Bonds $bond_rad $bond_res
	mol color ColorID 4 
	#get info about this
	

	$w.can delete $eo
	
    }
    
}