Commit 39458774 authored by luc.moulinier's avatar luc.moulinier

pleins de bugs ...

parent 26aae2a3
This diff is collapsed.
......@@ -1062,6 +1062,14 @@ proc SetupPDBObject {} {
}
oo::define Structure method _typeChn {chn} {
my TypRes
set L [DenombreLaListe $TypRes($c)]
return [lindex [lindex $L 0] 0]
}
oo::define Structure method selcolor {col} {
my variable ResSel ResCol
......
......@@ -314,21 +314,6 @@ proc DetruitUnPDB {pdbid} {
}
proc UpdateVisibleAnnotations {} {
global db Anno
set Lanno [ManageAnnotation getall [MacCourant]]
set Anno(Lnoms) [list]
set Anno(Lnoms) [list "None" "All"]
foreach {pka pks nom col zone} $Lanno {
lappend Anno(Lanno) [list $pka $nom $col $zone]
lappend Anno(Lnoms) $nom
}
return
}
proc AjoutePDB {{what ok}} {
global WAP LNOrdali ListePDB
......@@ -612,10 +597,10 @@ proc AskAddSeqs {} {
set TAddS(KeepClus) 0
}
if {0} {
set TAddS(File) "add_jaris.tfa"
if {1} {
set TAddS(File) "2zbk_b.tfa"
set TAddS(Position) "end"
set TAddS(seqInsert) "Q5ZAV6"
set TAddS(seqInsert) "A9TJG7"
set TAddS(Align) 1
}
set res [array get TAddS]
......@@ -3389,243 +3374,6 @@ proc CherchePCI {w args} {
}
proc ShowAnnotation {args} {
foreach {pka pks nom text col zone} [ManageAnnotation get $::Anno(Nom)] {
$NomTextSeq tag configure Anno_$pka -bg $col
$NomTextSeq tag add Anno_$pka {*}$zone
}
return
}
proc EditeAnnotation {} {
set ::Anno
return
}
proc ManageAnnotation {what pk {nom ""} {txt ""} {col ""} {zon ""}} {
set Lann [list]
switch $what {
"record" {
lappend ::Anno(Lanno) [list $::Anno(iAnno) -1 $txt $col $zon]
incr ::Anno(iAnno)
}
"edit" {
$::db eval {update annotation set annotation=$txt, color=$col, zone=$zon where pk_annotation=$pk}
}
}
return $Lann
}
proc AjouteAnnotation {} {
set zon [$::NomTextSeq tag ranges selZone]
if {$zon == {} } {
FaireLire "No alignment zones defined !"
return
}
$::NomTextSeq tag remove selZone 1.0 end
set txt [$::Anno(WText) get 1.0 end]
set txt [string map {"'" " "} $txt]
$::Anno(WText) delete 1.0 end
set col $::Anno(Color)
set colAff [CouleurO2Ordali $::Anno(Color)]
set nom $::Anno(Nom)
set txt "$::Anno(iAnno) - $txt"
set txtnsp [string map {_ @ " " _} $txt]
set Ntag "FDisp_$txtnsp"
$::NomTextSeq tag configure $Ntag -background $colAff
$::NomTextSeq tag add $Ntag {*}$zon
ManageAnnotation "record" [MacCourant] $nom $txt $col $zon
return
}
proc FindTagPatch {tag x y} {
global NomTextSeq
set Lranges [$NomTextSeq tag ranges $tag]
set LgoodX [list]
foreach {p1 p2} $Lranges {
lassign [split $p1 .] y1 x1
lassign [split $p2 .] y2 x2
if {$x >= $x1 && $x < $x2} {
lappend LgoodX $y1
lappend Lx1 $x1
lappend Lx2 $x2
}
}
set LggodX [lsort -integer $LgoodX]
set jprev [lindex $LgoodX 0]
set jstart $jprev ; set jfin -1
if {$jprev == $y} {
set jy 1
} else {
set jy 0
}
foreach j [lrange $LgoodX 1 end] {
if {$j == $y} {set jy 1}
if {$j != ($jprev + 1)} {
if {$jy} {
set jfin $jprev
break
} else {
set jstart $j
}
}
set jprev $j
}
if {$jfin == -1} {
set jfin $jprev
}
# cree liste du patch
set x1 [lsort -unique -integer $Lx1]
set x2 [lsort -unique -integer $Lx2]
set Lres [list]
for {set y $jstart} {$y <= $jfin} {incr y} {
lappend Lres $y.$x1 $y.$x2
}
return $Lres
}
proc PositionAnnotation {w xp yp {quoi ""}} {
lassign [split [$w index @$xp,$yp] .] y x
$::NomTextSeq configure -state normal
switch $quoi {
"debut" {
set Lt [$::NomTextSeq tag names $y.$x]
set disp [lsearch -inline -regexp $Lt {^FDisp\_[0-9]+\_}]
if {$disp ne ""} {
regexp {FDisp_([0-9]+)_(.+)} $disp tmp ian txt
set anno [lsearch -inline -exact -index 0 $::Anno(Lanno) $ian]
lassign $anno ian pka txt col zone
$::Anno(WText) delete 1.0 end
$::Anno(WText) insert end $txt
set Lcol [$::WOrdali(ComboColAnno) cget -values]
set icol [lsearch -exact $Lcol $::Anno(Color)]
$::WOrdali(ComboColAnno) index $icol
$::NomTextSeq configure -state disabled
return
}
set ::Anno(xdebut) $x
set ::Anno(ydebut) $y
}
"move" {
set xd [set ::Anno(xdebut)]
set yd [set ::Anno(ydebut)]
if {$x < $xd} {
set xt $xd
set xd $x
set x $xt
}
if {$y < $yd} {
set yt $yd
set yd $y
set y $yt
}
set Lt {}
for {set i $yd} {$i <= $y} {incr i} {
lappend Lt $i.$xd $i.$x
}
if {$Lt != {}} {
$w tag add selZone {*}$Lt
}
}
"termine" {
if {0} {
#$w configure -state disabled
set xd $::Anno(xdebut)
set yd $::Anno(ydebut)
if {$xd < $x} {
set xm $xd ; set xx $x
} else {
set xm $x ; set xx $xd
}
if {$yd < $y} {
set ym $yd ; set yx $y
} else {
set ym $y ; set yx $yd
}
set tx [expr {$xx-$xm+1}]
set ty [expr {$yx-$ym+1}]
text .tmsg -bg yellow -fg blue -font "Helvetica 22 bold"
place .tmsg \
-x $xp -y $yp \
-in $::NomTextSeq
}
}
"delete" {
set Lt [$::NomTextSeq tag names $y.$x]
set disp [lsearch -inline -regexp $Lt {^FDisp\_[0-9]+\_}]
if {$disp ne ""} {
regexp {FDisp_([0-9]+)} $disp tmp ian
set iLanno [lsearch -exact -index 0 $::Anno(Lanno) $ian]
set anno [lindex $::Anno(Lanno) $iLanno]
lassign $anno ian pka txt col zone
set Lr [FindTagPatch $disp $x y]
$::NomTextSeq tag remove $disp {*}$Lr
foreach p $Lr {
set i [lsearch -exact $zone $p]
if {$i == -1} {
puts "$p not in zone"
} else {
set zone [lreplace $zone $i $i]
}
update
}
lset ::Anno(Lanno) $iLanno 4 $zone
}
}
}
$::NomTextSeq configure -state disabled
return
}
proc NouvelleAnnotation {} {
global NomTextSeq
$NomTextSeq tag remove selZone 1.0 end
$::Anno(WText) delete 1.0 end
set $::Anno(NtagCou) ""
bind $NomTextSeq <ButtonPress-1> [list PositionAnnotation %W %x %y "debut"]
bind $NomTextSeq <B1-Motion> [list SelectZoneAnnotation %W %x %y]
bind $NomTextSeq <ButtonRelease-1> [list TermineZoneAnnotation %W %x %y]
return
}
proc QuitteAnnotation {} {
DetruitBoutonsOrdali
$::NomTextSeq tag delete selZone
return
}
# ordali motif
# W(X){13,15}Y
proc ChercheMotif {} {
......@@ -6204,7 +5952,7 @@ proc CalculeOverview {Id} {
set linew [string trim [string repeat $b $Twdt]]
# get the whole alignment
set s [$NomTextSeq get 1.0 end]
set smap [string map [list . $b " " $b * $b A $f B $f C $f D $f E $f F $f G $f H $f I $f J $f K $f L $f M $f N $f P $f Q $f R $f S $f T $f U $f V $f W $f X $f Y $f X $f Z $f] $s]
set smap [string map [list . $b " " $b * $b ~ $b "?" $b A $f B $f C $f D $f E $f F $f G $f H $f I $f J $f K $f L $f M $f N $f O $f P $f Q $f R $f S $f T $f U $f V $f W $f X $f Y $f Z $f] $s]
set Ls [split $smap "\n"]
set Data {}
foreach l $Ls {
......@@ -9821,7 +9569,29 @@ proc d2f {} {
image delete $im1
set im2
}
proc gcd {u v} {expr {$u? [gcd [expr $v%$u] $u]: $v}}
proc gcd {u v} {expr {$u? [gcd [expr $v%$u] $u]: $v}}
proc tsm {} {
DecortiqueUnTFA topo.tfa Ln Seq
set s ""
foreach k [array names Seq] {
append s $Seq($k)
}
set f "\#000000"
set b "\#ffffff"
puts "[time {set smap [string map [list . $b " " $b * $b ~ $b "?" $b A $f B $f C $f D $f E $f F $f G $f H $f I $f J $f K $f L $f M $f N $f O $f P $f Q $f R $f S $f T $f U $f V $f W $f X $f Y $f Z $f] $s]} 10]"
puts [time {
regsub -all {[a-zA-Z0-9]} $s "$f " smap1
regsub -all {[^a-zA-Z0-9]} $smap1 "$b " smap1
} 10]
puts "[expr {$smap eq $smap1}]"
return
}
proc CalculeRibbon {mol} {
global RadMol
global LesVecs
......@@ -550,6 +553,25 @@ proc SticksDe {liste pdbid} {
}
proc TraceAtomeIsole {qobj lx col ball} {
lassign [lindex $lx 0] x y z
set off 0.5
foreach {a b c} {1.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 1.0} {
set v1 [list \
[expr {$x + $a * $off}] \
[expr {$y + $b*$off}] \
[expr {$z + $c*$off}]]
set v2 [list \
[expr {$x - $a*$off}] \
[expr {$y - $b*$off}] \
[expr {$z - $c*$off}]]
TraceLigne "" $v1 $v2 $col $col
}
return
}
proc TraceLiaison {qobj la lb col1 col2 stick} {
if {$stick} {
#use_light
......@@ -609,7 +631,7 @@ proc TraceLigne {liste la lb col1 col2} {
puts " $vx $vy $vz"
puts " $x2 $y2 $z2\n"
}
# glColor3f {*}$col1
nolight_color3fv $col1
glLineWidth 1.0
......@@ -1061,8 +1083,8 @@ proc DrawAtomsProtein {cp cyl QObj Lx La Ln} {
# QObj : quadric object for stick/ball
set colCA [CouleurDeAtome "C"]
set first 1
if {$cp} {
set first 1
set colN [CouleurDeAtome "N"]
set colC $colCA
set colO [CouleurDeAtome "O"]
......@@ -1070,6 +1092,15 @@ proc DrawAtomsProtein {cp cyl QObj Lx La Ln} {
foreach rx $Lx rn $La n $Ln {
#if {! [EstUnBonResidu $rn]} {continue}
# CA atoms alone
if {[llength $rx] == 1} {
set first 1
TraceAtomeIsole $QObj $rx $colCA 0
continue
}
set ACA [lindex $rx 1]
if {$cp} {
set AN [lindex $rx 0]
......@@ -1114,7 +1145,7 @@ proc DrawAtomsProtein {cp cyl QObj Lx La Ln} {
set first 0
} else {
# check for correct distance between
# contiguous residues
# adjacent residues
if {[Dist2 [lindex $rx 0] $Cx] <= 3.8025} {
TraceLiaison $QObj [lindex $rx 0] $Cx ${colN} ${colC} $cyl
}
......
......@@ -11645,25 +11645,8 @@ proc Ter_checkdata {} {
exit
}
proc RemoveHTMLComment {txt} {
set id [string first "<!--" $txt]
while {$id > -1} {
set if [string first "-->" $txt $id+4]
set txt "[string range $txt 0 $id-1][string range $txt $if+3 end]"
set id [string first "<!--" $txt]
}
regsub -all "><" $txt ">\n<" txt
regsub -all "<div class='leftside2'>" $txt "" txt
return $txt
}
proc tsoc {} {
set db root
sqlite3 $db database.sqlite
......@@ -12206,3 +12189,120 @@ proc alscro {} {
exit
}
proc TrieDD {} {
cd /gstock/DD_database/Sequences/
set Ll [LesLignesDuFichier training-sequences.txt]
#set Ll [LesLignesDuFichier test-sequences.txt]
# search first PDB code
set i [lsearch -regexp $Ll {^\>}]
foreach l [lrange $Ll $i-1 end] {
set l [string trim $l]
if {$l eq ""} {continue}
if {[string first "FOLD" $l] == 0} {
# new fold, get fold number
set is [string first "(" $l]
set id [string first ")" $l]
set foldNb [string range $l $is+1 $id-1]
set foldName [string trim [string range $l [string first " " $l] end]]
set foldNm($foldNb) $foldName
set foldVu($foldNb) {}
continue
}
if {[string first ">" $l] == 0} {
# new PDB ID, get it
set pdbid [string trim [string range $l 1 end]]
set pdb [string range $pdbid 0 3]
set chn [string index $pdbid 5]
lappend Vu($pdb,$chn) $foldNb
puts "$pdb $chn"
continue
}
}
foreach key [array names Vu] {
if {[llength [set Vu($key)]] > 1} {
puts "$key : [llength $Vu($key)]"
}
}
puts "Vu [llength [array names Vu]]"
exit
}
proc chktiti {} {
set l [ContenuDuFichier titi.html]
set l [CleanHTML $l]
set l [string map {"><" ">\n<" "\t" " "} $l]
set Ll [split $l \n]
set new {}
foreach l $Ll {
if {[string trim $l] ne ""} {
set l [string trimleft $l]
lappend new $l
}
}
set l [join $new \n]
set o [open tutu.html w]
puts $o $l
close $o
lappend ::auto_path /home/moumou/ordali/lib
package require -exact tdom 0.8.3
set doc [dom parse -simple -html $l]
exit
}
proc clau {} {
set pdb "::2ZBK"
set spdb [$pdb _resname -chain B]
set spdb [join $spdb]
regsub -all { +} $spdb "" spdb
set pdb2 "::2Q2E"
set spdb2 [$pdb2 _resname -chain B]
set spdb2 [join $spdb2]
regsub -all { +} $spdb2 "" spdb2
set sseq $::Sequences(PDB_2ZBK_B)
set sseq [string map {"." ""} $sseq]
puts "[string range $spdb 0 40]"
puts "[string range $sseq 0 40]"
lassign [NW $spdb $sseq] al bl
set i 0
while {$i < [string length $al]} {
puts ""
set b [string range $al $i $i+49]
set a [string range $bl $i $i+49]
if {$a ne $b} {
puts [format "%3d %s" $i $a]
puts [format "%3d %s" $i $b]
}
incr i 50
}
set o [open 2zbk_b.seq w]
puts $o ">PDB_2ZBK_B"
puts $o $spdb
puts $o ">PDB_2Q2E_B"
puts $o $spdb2
close $o
exit
}
......@@ -298,7 +298,7 @@ proc AfficheBoutonsOrdali {} {
proc AfficheBoutonsAnnotation {} {
global FrmBouton Anno NomTextSeq WOrdali
if {[TypeAli] eq "pasdali"} {return}
set wp "${FrmBouton}.fanno"
......@@ -331,7 +331,7 @@ proc AfficheBoutonsAnnotation {} {
grid $wp.fshow.combo -row 0 -column 1
set wcol [PlusLongEltDe $Lcol]
set WaOrdali(ComboColAnno) $wp.ccol
set WOrdali(ComboColAnno) $wp.ccol
ttk::combobox $wp.ccol \
-state readonly \
-width $wcol \
......@@ -339,11 +339,11 @@ proc AfficheBoutonsAnnotation {} {
-textvariable Anno(Color)
#bind $wp.ccol <<ComboboxSelected>> [list ChangeCouleurAnnotation]
button $wp.bcre \
-text "Create" \
-text " Create " \
-bg cyan \
-command [list AjouteAnnotation]
button $wp.bedt \
-text "Edit" \
-text " Edit " \
-bg cyan \
-command [list EditeAnnotation]
frame $wp.tmp1
......@@ -372,15 +372,14 @@ proc AfficheBoutonsAnnotation {} {
-command "$wp.tmp2.A1AAAtxt yview "
button $wp.badd \
-bg yellow \
-text " Add " \
-command [list AjouteAnnotation %W]
button $wp.bdel \
-bg red \
-text "Delete" \
-bg red \
-command [list DetruitAnnotation]
button $wp.bret \
-bg green1 \
-text "Return" \
-bg green1 \
-command [list QuitteAnnotation]
grid columnconfig $wp.tmp1 1 -weight 1
......
proc RepresentantDeTaxId {t} {
global TDesTaxId TDesOrganismes LNOrdali
......@@ -2930,7 +2933,7 @@ proc DenombreLeTableau {aT} {
proc DenombreLaListe {l} {
set res [list]
set res {}
foreach e [lsort -unique $l] {
lappend res [list $e [llength [lsearch -all $l $e]]]
}
......
......@@ -1507,9 +1507,13 @@ proc InitSequences {} {
global LesPCI ListeDesFragments
global ListePDB BadPDB NomEtSeqAssPDB
set NombreDeSequences [llength $LNOrdali]
if {! $NombreDeSequences} {
return 0
if {[set Defauts(RemoveQuery)]} {
set iquery [lsearch -regexp -nocase $LNOrdali "query"]
if {$iquery != -1} {
set Qry [lindex $LNOrdali $iquery]
unset Sequences($Qry)
set LNOrdali [lreplace $LNOrdali $iquery $iquery]
}
}
# sequences doublonnees ...
......@@ -1531,18 +1535,6 @@ proc InitSequences {} {
return 0
}
DefinitTypeAlignement
LesDefauts Mapping [EditorMappingData]
if {[set Defauts(RemoveQuery)]} {
set iquery [lsearch -regexp -nocase $LNOrdali "query"]
if {$iquery != -1} {
set Qry [lindex $LNOrdali $iquery]
unset Sequences($Qry)
set LNOrdali [lreplace $LNOrdali $iquery $iquery]
}
}
# Nettoyage Nom et sequences
set ListePDB {}
set PBV 0.
......@@ -1566,11 +1558,21 @@ proc InitSequences {} {
}
# Enleve sequences vides
foreach i [lsort -integer -decreasing $LiVide] {
set s [lindex $LNOrdali $i]
set n [lindex $LNOrdali $i]
set LNOrdali [lreplace $LNOrdali $i $i]
unset Sequences($s)
unset Sequences($n)
}
update
set NombreDeSequences [llength $LNOrdali]
if {! $NombreDeSequences} {
return 0
}
DefinitTypeAlignement
LesDefauts Mapping [EditorMappingData]
DonneMemeLongueur Sequences
foreach n $LNOrdali {
lappend LSOrdali [set Sequences($n)]
}
......@@ -1740,7 +1742,6 @@ proc ExisteAABizarres {nseq} {
}
proc TraiteAABizarres {{force 0}} {
global Sequences Warn
......@@ -1777,6 +1778,10 @@ proc TraiteAABizarres {{force 0}} {
set val 1
lappend Warn(Numbers) $n
}
{[^a-zA-Z0-9\.-]} {
set val 1
set Warn(Unknown) $n
}
}
set Warn($n) $val
}
......@@ -2314,9 +2319,10 @@ proc DonneMolWeightDe {s} {
set s [string map [list "." "" "Z" ""] $s]
set M 0.0
foreach a [split $s ""] {
set M [expr {$M + [set TMassesAA($a)]}]
if {[info exists TMassesAA($a)]} {
set M [expr {$M + [set TMassesAA($a)]}]
}
}
set M [expr {$M + [set TMassesAA(H2O)]}]
......
......@@ -9,6 +9,7 @@ if {! [info exists OrdaliDejaSource] || ! $OrdaliDejaSource} {
ordali_StrucObj.tcl \
ordali_admin.tcl \
ordali_affiche.tcl \
ordali_annotation.tcl \
ordali_arc2.tcl \
ordali_arcball.tcl \
ordali_barcode.tcl \
......@@ -21,6 +22,7 @@ if {! [info exists OrdaliDejaSource] || ! $OrdaliDejaSource} {
ordali_doc.tcl \
ordali_features.tcl \
ordali_graphic3d.tcl \
ordali_html.tcl \
ordali_image.tcl \
ordali_math.tcl \
ordali_misc.tcl \
......
proc DismissSuper {} {
FinSuper
......
......@@ -33,6 +33,7 @@ proc AfficheDansViandox {} {
if {[info exists pgl(wogl)]} {
raise [winfo toplevel $pgl(wogl)]
update idletasks
return
}
......@@ -124,8 +125,6 @@ proc AfficheDansViandox {} {
($ymax-$ymin)**2 + \
($zmax-$zmin)**2) \
/ 2.}]
set pgl(Rad) $Rad
# backclip = z near (z neg)
......@@ -140,10 +139,7 @@ proc AfficheDansViandox {} {
set pgl(fogStart) [expr {0.3*$Rad}]
set pgl(fogEnd) [expr {0.6*$Rad}]