Commit 9d00ff9a authored by luc.moulinier's avatar luc.moulinier

fix bugs runOrdali, ordali-source, ...

parent 06c6da9b
#!/usr/local/bin/wish
#package require biotext
#source /home/moumou/ordali/src/ordali_sequence.tcl
#load Windows/biotext0.1.dll
#load Linux-x86_64/libbiotext0.1.so
package require biotext
puts "dll loaded"
set OrdaliDir [file join [pwd] .. ..]
puts "ordalidir : $OrdaliDir"
source ../../src/ordali_source.tcl
set OrdaliDir /home/moumou/ordali
source /home/ripp/gscope/gscope_outils.tcl
puts "sources done"
source /home/moumou/ordali/src/ordali_source.tcl
load /home/moumou/ordali/Extensions/biotext0.1/test/libbiotext0.1.so
source /home/moumou/ordali/Extensions/biotext0.1/biotext.tcl
proc TailleFonte {incr} {
puts "\nTAILLE-FONT" ; flush stdout
set size [font configure SeqFont -size]
incr size $incr
# keep font sizes sane...
if {$size >= 6 && $size <= 32} {
font configure SeqFont -size $size
}
update idletasks
return
}
proc CoupleY {args} {
.f.b yview {*}$args
.f.t yview {*}$args
return
}
proc RandSeq {{nlines 150} {len 100}} {
set Lseq [list]
set Lnom [list]
set a ".A.CDEFGH.I.KLMN.PQRST.VW.Y.A.CDEFGH.I.KLMN.PQRST.VW.Y."
set la [string length $a]
# create first sequence
set s ""
for {set j 0} {$j < $len} {incr j} {
if {! ($j%1000)} {
puts " $j done ..."
}
set x [expr {int($la*rand())}]
append s [string index $a $x]
}
lappend Lseq $s
lappend Lnom "Seq-0"
for {set i 1} {$i < $nlines} {incr i} {
set ix [expr {int($len*rand())}]
set n "[string range $s $ix end][string range $s 0 $ix-1]"
lappend Lseq $n
lappend Lnom "Seq-$i"
}
return [list $Lseq $Lnom]
}
set tfa ">seq-1
GACDEF...GHIKLM.NPQRS.TVWY
......@@ -77,53 +119,18 @@ X black dimgrey
8 black white
9 black white
Space white white"
set Lmap [list]
set Lmap [list] ; set Lmapbw [list]
foreach l [split $Lignes \n] {
lassign [split [string trim $l] " "] n f b
if {$n eq "Space"} {set n " "}
lappend Lmap [list $n $f $b]
}
proc CoupleY {args} {
.f.b yview {*}$args
.f.t yview {*}$args
return
}
proc RandSeq {{nlines 150} {len 100}} {
set Lseq [list]
set Lnom [list]
set a ".A.CDEFGH.I.KLMN.PQRST.VW.Y.A.CDEFGH.I.KLMN.PQRST.VW.Y."
set la [string length $a]
# create first sequence
set s ""
for {set j 0} {$j < $len} {incr j} {
if {! ($j%1000)} {
puts " $j done ..."
}
set x [expr {int($la*rand())}]
append s [string index $a $x]
}
lappend Lseq $s
lappend Lnom "Seq-0"
for {set i 1} {$i < $nlines} {incr i} {
set ix [expr {int($len*rand())}]
set n "[string range $s $ix end][string range $s 0 $ix-1]"
lappend Lseq $n
lappend Lnom "Seq-$i"
}
return [list $Lseq $Lnom]
lappend Lmapbw [list $n black white]
}
##########################
font create Luc -family Courier -size 10
font create SeqFont -family "Courier" -size 8
frame .f
frame .f -background blue
grid .f -row 0 -column 0 -sticky news
grid columnconfig . 0 -weight 1
grid rowconfig . 0 -weight 1
......@@ -131,16 +138,25 @@ grid rowconfig . 0 -weight 1
text .f.t \
-width 10 \
-height 10 \
-font Luc \
-wrap none
biotext .f.b \
-font SeqFont \
-bd 0 \
-yscrollcommand ".f.sv set" \
-xscrollcommand ".f.sh set" \
-width 20 \
-highlightthickness 0 \
-pady 0 \
-relief flat \
-setgrid 1 \
-wrap none \
-yscrollcommand ".f.sv set "
biotext .f.b \
-width 23 \
-height 10 \
-font SeqFont \
-bd 0 \
-relief flat \
-yscrollcommand ".f.sv set " \
-xscrollcommand ".f.sh set " \
-foreground black \
-background white \
-class Biotext
.f.b font family Courier size 10 weight normal
scrollbar .f.sh \
-bg blue \
-orient horiz \
......@@ -148,25 +164,32 @@ scrollbar .f.sh \
scrollbar .f.sv \
-bg blue \
-command "CoupleY "
grid .f.t -row 0 -column 0 -sticky ns
grid .f.b -row 0 -column 1 -sticky news
grid .f.sv -row 0 -column 2 -sticky ns
grid .f.sh -row 1 -column 1 -sticky ew
grid .f.sh -row 1 -column 1 -sticky ew -pady 5
grid columnconfig .f 1 -weight 1
grid rowconfig .f 0 -weight 1
#lassign [RandSeq] Lseq Lnom
if {[llength $argv]} {
set tfa $argv
if {[llength $argv] > 0} {
set tfa [lindex $argv end]
puts "fasta : $tfa"
}
LitLeTFA $tfa Ltmp Tseq
set Lseq [list] ; set Lnom [list]
foreach n $Ltmp {
if {[string trim $n] ne ""} {
lappend Lnom $n
lappend Lseq [set Tseq($n)]
}
}
LitLeTFA $tfa Lnom Tseq
puts "TFA loaded"
puts "[llength $Lnom] seqs [string length [lindex $Lseq 0]] aminoacids"
set Lseq [list]
foreach n $Lnom {lappend Lseq $Tseq($n)}
.f.b sequences $Lseq
.f.b mapping $Lmap
.f.b mapping $Lmapbw
.f.b map on
.f.b configure -state normal
......@@ -174,13 +197,23 @@ foreach n $Lnom {lappend Lseq $Tseq($n)}
.f.t insert end "[join $Lnom \n]"
.f.t configure -state disabled
proc BindSpace {w} {
set idx [$w cursor]
lassign [split $idx .] y x
$w chars "." $idx 1
}
#bind .f.b <Control-Key-c> {%W delete colsgaps}
#bind .f.b <Key-space> {BindSpace %W}
bind . <Control-4> {.f.b xview scroll -10 units ; break}
bind . <Control-5> {.f.b xview scroll 10 units ; break}
bind . <4> {CoupleY scroll -1 units ; break}
bind . <5> {CoupleY scroll 1 units ; break}
set Toggle(Scores) 0
bind . <Control-KP_Add> [list TailleFonte +2]
bind . <Control-plus> [list TailleFonte +2]
bind . <Control-equal> [list TailleFonte +2]
bind . <Control-minus> [list TailleFonte -2]
bind . <Control-KP_Subtract> [list TailleFonte -2]
.f.t configure -state disabled
puts "\nbiotext : [.f.b configure -font]"
puts "text : [.f.t configure -font]"
puts "SeqFont : [font configure SeqFont -size]\n"
foreach cf {pady spacing1} {
puts "$cf [.f.t cget -$cf]"
}
#exit
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -516,7 +516,7 @@ BiotextPushInSeq(register Biotext *BiotextPtr,
*--------------------------------------------------------------
*/
void
BiotextComputeGeometry(Biotext *BiotextPtr)
BiotextComputeGeometry(register Biotext *BiotextPtr)
{
int width, height, bdi;
......
......@@ -80,24 +80,17 @@ if {! $InStarPack} {
set OrdaliDejaSource 1
source [file join $GscopeDir gscope_source.tcl]
}
set OrdaliDejaSource 0
puts "OrdSrcDir $OrdSrcDir"
source [file join $OrdSrcDir ordali_source.tcl]
puts "*RunO* [info procs "*RunO*"]"
}
puts "auto_path : $auto_path"
#######################
# procs utilitaires
set VariablesAuDepart [info globals]
if {[lindex $argv 0] == "ToutesLesProcs"} {
ToutesLesProcsDeGscope toto
exit
}
### Launch ORDALIE ######
# Main principal
# Main program
InitLesDefauts
set retour [InterpreteLaLigneDeCommande $argv]
......@@ -110,6 +103,5 @@ if {$retour eq ""} {
LanceOrdali master
}
######## Ca finit ici #####################
proc FinDemarrage {{w ""}} {
if {! [ModeI]} {
return
......@@ -194,7 +197,7 @@ proc FenetreAjoutePDB {} {
if {[TypeAli] eq "pasdali" || [QuelMode] eq "seqlab"} {
return
}
global ListePDB WAP
set w .apdb
......@@ -1642,13 +1645,13 @@ proc InfosDeLaSeq {w nseqCombo {quoi "edit"}} {
set nseq [set TEdit(corr,$nseqCombo)]
if {[ExisteAABizarres $nseq]} {
label ${ww}.wrn \
-background red -foreground white \
-text "Warning !\n The values given below\nare only indicative as this sequence\ncontains unhandled amino acids" \
-justify left -anchor w
-background red -foreground white \
-text "Warning !\n The values given below\nare only indicative as this sequence\ncontains unhandled amino acids" \
-justify left -anchor w
grid ${ww}.wrn -column 2 -row 0 -pady 10 -padx 10 -sticky w
}
}
if {$w ne "" && [set TEdit(mode)] eq "edit"} {
# nold is seqname
set TEdit(desc,$nold) [string trim [[set TEdit(tdes)] get 1.0 end]]
......@@ -2031,6 +2034,7 @@ proc AppliqueCouleurs {type w} {
proc TailleFonte {incr} {
set size [font configure SeqFont -size]
incr size $incr
# keep font sizes sane...
if {$size >= 6 && $size <= 32} {
font configure SeqFont -size $size
......@@ -2038,12 +2042,12 @@ proc TailleFonte {incr} {
return
}
if {[QuelMode] eq "seqlab"} {
if {0 && [QuelMode] eq "seqlab"} {
#puts "change fonte $incr"
set wgt [font configure SeqFont -weight]
set fam [font configure SeqFont -family]
set fam [string map [list " " ""] $fam]
$::NomTextSeq font family $fam size $size weight $wgt
#set wgt [font configure SeqFont -weight]
#set fam [font configure SeqFont -family]
#set fam [string map [list " " ""] $fam]
#$::NomTextSeq font family $fam size $size weight $wgt
if {$incr > 0} {
#$::NomTextSeq font bigger
} else {
......@@ -2051,7 +2055,8 @@ proc TailleFonte {incr} {
}
}
update
update idletasks
ReDessineLesScores
FenetreAuCentre $::NomFenetreOrdali
......@@ -3635,6 +3640,8 @@ proc ChercheMotif {} {
}
set i 0
set Chrc(NextOc) {}
eset Chrc(NbrOccus) ""
set Loccu {}
foreach seq $LSeqs nom $LNoms {
incr i
......@@ -3661,7 +3668,6 @@ proc ChercheMotif {} {
}
}
set Chrc(NextOc) {}
set Chrc(LOccus) [list]
foreach o $Loccu {
lassign $o d f
......@@ -4484,7 +4490,7 @@ proc MontreLesStrSecDetaillees {} {
text $w.lesseq.textnomseq \
-relief sunken \
-bd 2 \
-bd 0 \
-cursor left_ptr \
-font SeqFont \
-yscrollcommand "$w.lesseq.scrolly set" \
......@@ -8256,7 +8262,7 @@ proc AfficheFrameSequences {} {
set w $NomFenetreOrdali
set FrmSequence "$w.lessequences"
frame $FrmSequence
grid $FrmSequence -row 2 -column 0 -padx 5 -sticky news
grid $FrmSequence -row 2 -column 0 -sticky news -padx 5
#
# widgets to display names of sequences, and
......@@ -8287,10 +8293,11 @@ proc AfficheFrameSequences {} {
-cursor left_ptr \
-yscrollcommand [list .ordali.lessequences.scrolly set] \
-setgrid 1 \
-height $Defauts(seqHeight) \
-width $WdtNom \
-wrap none \
-foreground black \
-background white \
-foreground white \
-background black \
-selectforeground black \
-selectbackground white \
-inactiveselectbackground white \
......@@ -8303,10 +8310,11 @@ proc AfficheFrameSequences {} {
# Sequences : biotext widget for seqlab ,
# text widget otherwise
biotext $FrmSequence.biotextsequence \
-font Seqfont \
-yscrollcommand FromScrollYBiotext2Names \
-xscrollcommand [list .ordali.lessequences.scrollxseq set] \
-height 20 \
-width 60 \
-height $Defauts(seqHeight) \
-width $Defauts(seqWidth) \
-relief sunken \
-class Biotext \
-bd 0
......@@ -8315,8 +8323,8 @@ proc AfficheFrameSequences {} {
-xscrollcommand [list .ordali.lessequences.scrollxseq set] \
-yscrollcommand [list .ordali.lessequences.scrolly set] \
-relief sunken \
-height 20 \
-width 60 \
-height $Defauts(seqHeight) \
-width $Defauts(seqWidth) \
-bd 2 \
-cursor left_ptr \
-font SeqFont \
......@@ -8473,13 +8481,12 @@ proc ReDessineLesScores {} {
proc DessineLesScores {{f ""}} {
global NomFenetreOrdali Toggle LongueurTotale FrmSequence NomTextSeq ScoreMeth
#puts "dessine [set Toggle(Scores)]"
if {! [set Toggle(Scores)]} {
return
}
set HgLtr [font metrics SeqFont -linespace]
set LgLtr [font measure SeqFont Z]
set LgLtr [font measure SeqFont "Z"]
set LgPxl [expr {$LgLtr * $LongueurTotale}]
set HgPxl 50
......@@ -8497,21 +8504,20 @@ proc DessineLesScores {{f ""}} {
-xscrollincrement 1 \
-xscrollcommand "$FrmSequence.scrollxseq set"
grid $FrmSequence.csc -in $FrmSequence -row 2 -column 1 -columnspan 2 -sticky ew
#grid columnconfigure $FrmSequence 2 -weight 1 -minsize 0
} else {
# canvas scores already exists
set Lcou [lindex [$Ccs cget -scrollregion] 2]
if {$Lcou != $LgPxl} {
$Ccs configure -scrollregion [list 0 0 $LgPxl $HgPxl]
}
}
if {$f eq ""} {
$Ccs delete all
return
}
set Lg [set ScoreMeth($f,ListeGrps)]
#puts "Lg $Lg"
#
# Min/Max global or not
......@@ -8533,15 +8539,14 @@ proc DessineLesScores {{f ""}} {
foreach g $Lg {
if {$g eq "grise" || $g eq "bidon"} {continue}
#puts " g= $g"
if {$g eq "GroupeToutLeMonde"} {
set col black
} else {
set No [string range $g 5 end]
set col [CouleurO2Ordali [CouleurDuGroupe $No]]
}
#puts " col $col"
set Lv {} ; set Lx {}
set Li [array names ScoreMeth "$f,$g,*"]
#puts " Li [llength $Li]"
......@@ -8618,10 +8623,7 @@ proc PrendPDBDansPilier {args} {
proc ToggleScores {{args ""}} {
global Toggle LFeatCourantes NomFenetreOrdali FrmSequence Cons ListeTypesDeFeatures
#rRRR puts "toggleScores [info level 0]"
#rRRR catch {puts " -1 [info level -1]"}
update
switch [QuelMode] {
"feature" {
set Lft [lsearch -regexp -all -inline $ListeTypesDeFeatures {^Cons\-|^Score\-}]
......@@ -8635,13 +8637,11 @@ proc ToggleScores {{args ""}} {
set Toggle(Scores) [set Cons(Show)]
set Lft [lindex [set Cons(ConsCou)] 0]
if {$Lft eq "None"} {
#return
set Lft ""
}
}
default return
}
#puts "Lft $Lft"
if {[set Toggle(Scores)]} {
if {[QuelMode] eq "feature"} {
......@@ -8649,7 +8649,6 @@ proc ToggleScores {{args ""}} {
foreach e $Lft {
set w [BtnDeLaFeature $e]
if {[EtatDuBouton $w]} {
#puts "e= $e"
DessineLesScores $e
}
}
......@@ -8657,6 +8656,7 @@ proc ToggleScores {{args ""}} {
DessineLesScores $Lft
}
} else {
# Toggle(scores) = 0
if {[winfo exists $FrmSequence.csc]} {
grid forget $FrmSequence.csc
destroy $FrmSequence.csc
......@@ -8676,7 +8676,7 @@ proc AfficheFrameScores {} {
set w $NomFenetreOrdali
set FrmScores "$w.scores"
frame $FrmScores
grid $FrmScores -row 3 -column 0 -sticky ew
grid $FrmScores -row 3 -column 0 -sticky ew -padx 5
return
}
......@@ -8812,7 +8812,7 @@ proc AfficheFrameFeatures {} {
set FrmBouton $NomFenetreOrdali.fbout
frame $FrmBouton
grid $FrmBouton -row 4 -column 0 -padx 10 -pady 10 -sticky news
grid $FrmBouton -row 4 -column 0 -sticky ew -padx 10 -pady 10
frame $FrmBouton.fimg
grid $FrmBouton.fimg -row 0 -column 0 -sticky ""
......@@ -8961,8 +8961,10 @@ proc AfficheFenetreOrdali {} {
global Defauts NomFenetreOrdali
set menustatus " "
set w [winfo toplevel $NomFenetreOrdali]
#set w [winfo toplevel $NomFenetreOrdali]
set w $NomFenetreOrdali
grid rowconfig $w {0 1 3 4 5} -weight 0
grid rowconfig $w 2 -weight 1
grid columnconfig $w 0 -weight 1
......@@ -9134,8 +9136,8 @@ proc InitialiseFenetreOrdali {{behave slave} w} {
frame $w
grid $w -row 0 -column 0 -sticky news
grid rowconfig $w 0 -weight 1
grid columnconfig $w 0 -weight 1
#grid rowconfig $w 0 -weight 1
#grid columnconfig $w 0 -weight 1
AfficheFenetreOrdali
......
......@@ -11865,3 +11865,23 @@ proc dfast {} {
puts "and [llength [land $Lcou $Lnew]]"
exit
}
proc aatest {} {
set Laa [split "ACDEFGHIKLMNPQRSTVWY" ""]
set o [open diaa.tfa w]
foreach a $Laa {
foreach b $Laa {
set nom "$a$b$a$b"
set seq [string repeat "${nom}.." 1000]
puts $o ">${nom}-$nom"
puts $o $seq
}
}
close $o
exit
}
proc lesso {} {
set Ls [LesLignesDuFichier lso]
foreach l $Ls {
regsub -all { +} [string trim $l] " " l
set o [lindex [split $l " "] 4]
while {$o ne "" && [string index $o end] ne "l"} {
set o [string range $o 0 end-1]
update
}
lappend lo $o
}
puts [join [lsort $lo] " \\ \n"]
exit
}
proc CreeLesRBJOVVSurFondGris {} {
global SDG
global LongueurTotale
......@@ -91,7 +111,6 @@ proc CreeLesRBJOVVSurFondGris {} {
# 7 = Orange
# 8 = Violet
# 9 = Vert
proc CreeLesSimilaires {{OGlob 0}} {
global SDG LongueurTotale ListeDesAcidesAmines
global ListeDesPiliersDuGroupe ListeDesConsensusDuGroupe
......@@ -128,7 +147,7 @@ proc CreeLesSimilaires {{OGlob 0}} {
}
set Consensus [string replace $Consensus $i $i $CG]
}
puts "$Consensus"
set ListeDesConsensusDuGroupe($NomDeGroupe) $Consensus
}
......@@ -142,9 +161,6 @@ proc CreeLesSimilaires {{OGlob 0}} {
# 4 = F,Y,W
# 5 = K,R,H
proc CreeLesOranges {} {
global LNOrdali
global Sequences
......@@ -195,7 +211,6 @@ proc CreeLesOranges {} {
return
}
proc CreeLesViolets {} {
global LNOrdali
global Sequences
......@@ -571,7 +586,9 @@ proc CreeLesPiliers {} {
proc CreeLesIdentitesDuGroupe {NomDeGroupe} {
global Threshold LongueurTotale LNDG SDG ListeDesConsensusDuGroupe ListeDesPiliersDuGroupe ListeDesAcidesAmines Defauts
if {$NomDeGroupe eq "grise" || $NomDeGroupe eq "bidon"} {return}
if {$NomDeGroupe eq "grise" || $NomDeGroupe eq "bidon"} {
return
}
set ConsensusGlobalDuGroupe [set ListeDesConsensusDuGroupe($NomDeGroupe)]
set NouveauConsensusDuGroupe ""
......@@ -622,7 +639,9 @@ proc OteConsensusGlobal {} {
global NombreDeGroupes
set DernierGroupe [lindex $LNDG end]
if {$DernierGroupe != "grise"} {return}
if {$DernierGroupe != "grise"} {
return
}
set LNDG [lreplace $LNDG end end]
unset ListeDesConsensusDuGroupe($DernierGroupe)
set NombreDeGroupes [llength $LNDG]
......@@ -644,7 +663,7 @@ proc StockScoreOrdali {f} {
if {$Lv == {}} {
continue
}
set Lx {}
foreach v $Lv {
lassign [split $v ,] i tmp
......@@ -654,6 +673,7 @@ proc StockScoreOrdali {f} {
# Method Ordali is still running from 0 go n-1
# columns. All methods runs form 1 to N
set Lx [lsort -integer $Lx]
set max -99999.
set c 0
foreach i $Lx {
while {$c != $i} {
......@@ -667,16 +687,21 @@ proc StockScoreOrdali {f} {
{^CoulG} {set v $sIde}
}
set v [expr {int($v)}]
set ScoreMeth($f,$g,[expr {$i+1}]) $v
if {$v > $max} {
set max $v
}
incr c
}
while {$c < [LongueurDeLAlignement]} {
set ScoreMeth($f,$g,[expr {$c+1}]) 0
incr c
}
set ScoreMeth($f,${g}-min) 0
set ScoreMeth($f,${g}-max) $max
}
return
}
......@@ -687,14 +712,15 @@ proc CreeFeaturesOrdali {{OGlob 0}} {
if {! [info exists ListeTypesDeFeatures]} {
set ListeTypesDeFeatures {}
}
set ft "tmpCons-T$Threshold"
set ic [lsearch -all -regexp $ListeTypesDeFeatures "^$ft"]
set nmax 1
foreach i $ic {
set f [lindex $ListeTypesDeFeatures $i]
set n [string range $f [expr {[string last "_" $f]+1}] end]
if {$n > $nmax} {set nmax $n}
if {$n > $nmax} {
set nmax $n}
}
if {$nmax > 1} {
set ft "${ft}_$nmax"
......@@ -702,7 +728,7 @@ proc CreeFeaturesOrdali {{OGlob 0}} {
lappend ListeTypesDeFeatures $ft
set LesVals [array get TableauCouleurEtGroupe]
foreach {v b} $LesVals {
lassign [split $v ,] r Grp
......@@ -710,11 +736,11 @@ proc CreeFeaturesOrdali {{OGlob 0}} {
if {$OGlob && $Grp ne "GroupeToutLeMonde"} {
continue
}
if {$Grp eq "grise" || $Grp eq "bidon"} {
continue
}
set start $r
set stop $r
set score 0.0
......@@ -726,24 +752,26 @@ proc CreeFeaturesOrdali {{OGlob 0}} {
lassign [set Couleurs($b)] f col
}
set csys "global"
set nl [list "fstart" $start "fstop" $stop "fcolor" $col "fscore" $score "fnote" $note "fcsys" $csys]
foreach n [set SDG($Grp)] {
if {$n in $ListePDB && ! [set Defauts(PDBDansPilier)]} {continue}
lappend TabSF($n,$ft) $nl
}
}
set ScoreMeth($ft,Edit) 0
set ScoreMeth($ft,ListeGrps) $::LNDG
puts "CreeFeatureOrdali $ft"
return $ft
}
proc MetAJourFeatures {} {
if {! [ModeI]} {return}
if {! [ModeI]} {
return
}
set ft [CreeFeaturesOrdali]
DetruitBoutonsOrdali
......@@ -779,7 +807,7 @@ proc PrepareRunOrdali {} {
FaireLire "Leave [string totitle [QuelMode]] mode first !"
return
}
set method $Cons(Method)
if {! [ModeI]} {
set method [set Defauts(MethodeConservation)]
......@@ -790,19 +818,19 @@ proc PrepareRunOrdali {} {
if {$mode eq "feature"} {
ColorieSelonFeature "Clear"
}