pleins de bugs ...

src/ordali_StrucObj.tcl

@@ -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
 

src/ordali_affiche.tcl

@@ -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
+}
+
+
 
 
 

src/ordali_graphic3d.tcl

+
+
+
 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
 		}

src/ordali_misc.tcl

@@ -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
+}
+
+

src/ordali_mode.tcl

@@ -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

src/ordali_outils.tcl

+
+
+
 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]]]
     }

src/ordali_sequence.tcl

@@ -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} {