OUTPUT BUFFER:
#!/home/moumou/TclTk-8.5/bin/wish8.5 ###!/usr/local/bin/wish set LignesCoul ">seqlab I white magenta L white magenta M white magenta V white magenta ILMV white magenta R white blue K white blue RK white blue F white red Y white red W white red FYW white red D white forestgreen E white forestgreen DE white forestgreen Q white green P white black G black orange H black cyan N black cyan HN white cyan S white darkviolet T white darkviolet A white darkviolet C white darkviolet STAC white darkviolet SPC white darkslategrey " ######### # Tools proc ContenuDuFichier {{Fichier ""}} { if { $Fichier == "" } {return ""} set f [open $Fichier r] set Texte [read -nonewline $f] close $f return $Texte } proc LesLignesDuFichier {{Fichier ""}} { return [split [ContenuDuFichier $Fichier] "\n"] } ################# # Data generation # # Junk data or read a TFA file given as argument proc JunkData {} { global data Long Haut set l "ACDEF...GH..KLNP....QCS.." set rep [expr {int($Long/25)+1}] set dt "[string repeat $l $rep]\n" set data "[string repeat $dt $Haut]" set Long [string length $dt] return $data } proc LitLeTFA {file aNom aSeq} { upvar $aNom Nom upvar $aSeq Seq global Long Haut set Lignes [LesLignesDuFichier $file] lappend Lignes ">" set n 0 set laseq "" foreach l $Lignes { set l [string trim $l] if {$l eq ""} {continue} if {[string index $l 0] eq ">"} { if {$laseq ne ""} { regsub -all " " $laseq "" laseq regsub -all {\-} $laseq "." laseq regsub -all {\n} $laseq "" laseq lappend Nom $lenom set Seq($lenom) $laseq set laseq "" incr n } set l [string trim [string range $l 1 end]] set ib [string first " " $l] if {$ib == -1} { set ib end } else { incr ib -1 } set lenom [file rootname [string range $l 0 $ib]] } else { append laseq $l } } set Haut $n set Long [string length [set Seq([lindex $Nom 0])]] return $n } # tfa file proc TfaData {{f ""}} { global data LitLeTFA $f Nom Seq set data "" foreach n $Nom { append data "[set Seq($n)]\n" } return $data } ############################## ################################### # Configure tags for 20 amino acids # almost taken from ordali proc ConfTag {} { global LignesCoul global wt foreach c [lrange [split $LignesCoul "\n"] 1 end] { foreach {n f b} $c {} $wt tag configure Tag$n -foreground $f -background $b } return } ############################## # Window and attached commands # # trash window test ... no grid , nothing ... proc InitWindow {} { global data Long Haut global wt wx wy global prms set WdHt 50 set WdWd 120 set wt .f3.t set wx .f3.sx set wy .f3.sy set wdt 1 set hgt 1 set ypm 0 set xpm 0 set xpx 0 set ypx 0 frame .f3 text .f3.t -font "Courier 8 bold" -wrap none \ -yscrollcommand "$wy set" \ -xscrollcommand "$wx set" \ -height 35 -width 150 scrollbar .f3.sy -command "ScrollY $Haut $wt $wy" scrollbar .f3.sx -command "ScrollX $Long $wt $wx" -orient horizontal pack .f3.sy -side right -fill y -expand 1 pack .f3.sx -side bottom -fill x pack .f3.t -expand 1 -fill both pack .f3 $wt configure -foreground white -background "#303030303030" $wt insert end $data $wt see "100.500" bindtags $wt $wt bind $wt <4> "ScrollY $Haut $wt $wy scroll -2 units" bind $wt <5> "ScrollY $Haut $wt $wy scroll 2 units" update set wdt [winfo width $wt] set hgt [winfo height $wt] foreach {ypm xpm} [split [$wt index @0,0] .] {} foreach {ypx xpx} [split [$wt index @$wdt,$hgt] .] {} set prms [list $ypm $ypx $xpm $xpx] ConfTag TagZone $wt $ypm $ypx $xpm $xpx return } # command invoked then invoking scrollbars # # xpm, ypm :x, y min prev # xpx, ypx :x, y max prev proc ScrollX {Long w wx args} { global prms # move the text widget ! # Must be done first to update new coordinates ! eval [list $w xview] $args update idletasks foreach {ypm ypx xpm xpx} $prms {} # Where are we ? foreach {fxMin fxMax} [$wx get] {} set xMin [expr {int(floor($Long*$fxMin)-1)}] set xMax [expr {int(floor($Long*$fxMax)+1)}] # define if we go left or right set prms [list $ypm $ypx $xMin $xMax] if {$xMin-$xpm < 0} { TagZone $w $ypm $ypx $xMin $xpm } else { TagZone $w $ypm $ypx $xpx $xMax } return } # same as ScrollX for y proc ScrollY {Haut w wy args} { global prms eval [list $w yview] $args update idletasks foreach {ypm ypx xpm xpx} $prms {} foreach {fyMin fyMax} [$wy get] {} set yMin [expr {int(floor($Haut*$fyMin)-1)}] set yMax [expr {int(floor($Haut*$fyMax)+1)}] set prms [list $yMin $yMax $xpm $xpx] if {$yMin-$ypm < 0} { TagZone $w $yMin $ypm $xpm $xpx } else { TagZone $w $ypx $yMax $xpm $xpx } return } proc TagZone {w ym yx xm xx} { if {$ym >= $yx} {return} set Lgaa [list STAC DE ILMV FYW P RK Q G HN] set Lfreg [list "S|T|A|C" "D|E" "I|L|M|V" "F|Y|W" "p" "R|K" "Q" "G" "H|N"] set xmp [expr {$xm+1}] set xxp [expr {$xx+1}] for {set i $ym} {$i <= $yx} {incr i} { lappend Lx $i.$xm $i.$xxp lappend Li $i } set Ls [eval [list $w get] $Lx] foreach s $Ls i $Li { foreach freg $Lfreg g $Lgaa { set lv [regexp -all -inline -indices -- $freg $s] set lt {} foreach e $lv { foreach {d f} $e {} lappend lt $i.[expr {$d+$xm}] $i.[expr {$f+$xmp}] } catch {eval [list $w tag add Tag$g] $lt} } } update idletasks return } ################################# set Long 2000 set Haut 300 foreach v $argv { switch [string index $v 0] { "f" { set data [TfaData [string range $v 2 end]] } "h" { set Haut [string range $v 2 end] } "w" { set Long [string range $v 2 end] } default { puts "usage : h=