invalid command name "OUTPUT BUFFER:
>$ChainIdent<< res $ResidueNumber res3l >$NomRes3L< >$NomRes1L<"
}
## ATTENTION !!
# Cette version ne lit pas les hydrogenes
if {$AtomNA == 1} {continue}
# if {$AlterLocRes ne ""} {continue}
if {$ResiduCourant == -999} {
set ResiduCourant $ResidueNumber
set CC $ChainIdent
if {$Polymer} {
set tyres [DonneResidueType $NomRes3L]
} else {
set tyres "ligand"
}
}
if {$ResidueNumber != $ResiduCourant || $ChainIdent ne $CC} {
if {$Polymer} {
set tyres [DonneResidueType $N3LCou]
} else {
set tyres "ligand"
}
lappend TypRes($CC) $tyres
lappend NomRes1l($CC) $N1LCou
lappend NomRes3l($CC) $N3LCou
lappend NmrRes($CC) $ResiduCourant
lappend NomAtm($CC) $Latmn
lappend AtmXYZ($CC) $Latmx
lappend AtmBQ($CC) $Latmb
lappend AtmNA($CC) $Latmz
set Latmn {}
set Latmx {}
set Latmb {}
set Latmz {}
if {$ChainIdent ne $ChaineCourant} {
lappend ChnIdn $ChainIdent
set ChaineCourant $ChainIdent
set CC $ChainIdent
}
}
lappend Latmn $AtomName
lappend Latmx $AtomXYZ
lappend Latmb $AtomBQ
lappend Latmz $AtomNA
set ResiduCourant $ResidueNumber
set N3LCou $NomRes3L
set N1LCou $NomRes1L
}
# lappend ChnIdn $CC
lappend TypRes($CC) $tyres
lappend NomRes1l($CC) $N1LCou
lappend NomRes3l($CC) $N3LCou
lappend NmrRes($CC) $ResiduCourant
lappend NomAtm($CC) $Latmn
lappend AtmXYZ($CC) $Latmx
lappend AtmBQ($CC) $Latmb
lappend AtmNA($CC) $Latmz
return
}
oo::define Structure method _PDBSetup {} {
my variable NmrRes NomRes1l ChnIdn EqResType Header DictDesObjets ResSel ResCol NomRes3l
global Defauts
if {[info exists EqResType]} {return}
set EqResType [dict create]
foreach c $ChnIdn {
foreach e [set NmrRes($c)] a [set NomRes1l($c)] t [set NomRes3l($c)] {
set ResSel($c,$e) 0
set ResCol($c,$e) [set Defauts(CoulVariable)]
dict lappend EqResType "$t" "$c,$e"
}
}
dict set DictDesObjets Index 0
return
}
oo::define Structure method SecStr {args} {
if {! [llength $args]} {return ""}
my variable SecStr NomRes1l
set i [lsearch $args "-chain"]
if {$i == -1} {
puts "Error ! no >>-chain<< card !"
return
}
set c [lindex $args $i+1]
if {! [info exists NomRes1l($c)]} {
puts "Error ! Chain >>$c<< does not exists"
return
}
if {! [info exists SecStr($c)]} {
return {}
} else {
return [set SecStr($c)]
}
}
oo::define Structure method SSBin {type chn} {
my variable SSBin
set rep ""
switch [string tolower $type] {
"helix" {set rep [lindex [set SSBin($chn)] 0]}
"sheet" {set rep [lindex [set SSBin($chn)] 1]}
}
return $rep
}
oo::define Structure method _ExtraitSecStrucDuPDB {mol} {
my variable ChnIdn SSBin SecStr Header
set MolId [DonneIdDeAccessPDB $mol]
set chn [DonneChainDeAccessPDB $mol]
if {[info exists SecStr($chn)]} {return}
set LongAl [LongueurDeLAlignement]
set ssbh [string repeat "0" $LongAl]
set ssbs [string repeat "0" $LongAl]
set SStmp {}
foreach l $Header {
set t [string range $l 0 4]
switch $t {
"HELIX" {set lhelix [LitHelixDansPDB $l $chn]}
"SHEET" {set lhelix [LitSheetDansPDB $l $chn]}
"TURN " {set lhelix [LitTurnDansPDB $l $chn]}
default {continue}
}
if {$lhelix eq "PasBon"} {continue}
set ss [OteLesBlancsEnTrop $lhelix]
DecortiqueSS $ss Elmt NomChnDep NmrResDep NmrResFin Rmk
set DebAli [DonnePosSG $mol $NmrResDep]
set FinAli [DonnePosSG $mol $NmrResFin]
if {$DebAli == -999 || $FinAli == -999} {
continue
}
lappend SStmp $ss
switch $Elmt {
"Alpha" {
set ssbh [MetDesUnsDansSS $ssbh $DebAli $FinAli]
}
"Sheet" {
set ssbs [MetDesUnsDansSS $ssbs $DebAli $FinAli]
}
}
}
set SStmp [lsort -integer -index 4 $SStmp]
set SStmp [CombleSSParCoil $SStmp $MolId $chn]
set SecStr($chn) $SStmp
lappend SSBin($chn) $ssbh $ssbs
return
}
oo::define Structure method _DefinitTypeRes {s p c} {
my variable TypRes
set id [string first 0 $p]
set if [string last 0 $p]
if {$id == -1} {
set type [DefinitTypeSeq $s]
set TypRes($c) [lrepeat [string length $s] $type]
return
}
set nlg [expr {$if - $id + 1}]
set llg [lrepeat $nlg "ligand"]
if {$id == 0} {
set sub [string range $s [expr {$if+1}] end]
set type [DefinitTypeSeq $sub]
set TypRes($c) [concat $llg [lrepeat [string length $sub] $type]]
} else {
set sub [string range $s 0 [expr {$id-1}]]
set type [DefinitTypeSeq $sub]
set TypRes($c) [concat [lrepeat [string length $sub] $type] $llg]
}
set p [join [set TypRes($c)] ""]
set p [string map [list "Protein" "P" "ligand" "l"] $p]
set l [string length $p]
set i 0
while {0 && $i < $l} {
set f [expr {$i + 59}]
puts "[string range $s $i $f]"
puts "[string range $p $i $f]"
incr i 60
}
# puts ""
return
}
oo::define Structure method _SetB {d f B c} {
my variable AtmBQ
set pdb [string range [self] 2 end]
if {$c eq ""} {set c "a"}
if {$d eq "all"} {
set Add ""
} else {
set deb [format "%08s" $d]
set fin [format "%08s" $f]
set Add "and r.rnmr >= '$deb' and r.rnmr <= '$fin' "
}
$::db eval {begin transaction}
set La [$::db eval "select a.pk_atomes from atomes as a, residues as r, chaines as c, pdb as p where a.pk_residues = r.pk_residues and r.pk_chaines=c.pk_chaines and c.nom='$c' and r.pk_pdb = p.pk_pdb and p.nom='$pdb' $Add"]
# puts "Updated atomes in [self] $c : [llength $La]"
$::db eval "update atomes set b=$B where pk_atomes in ([join $La ,])"
$::db eval {commit}
return
}
oo::define Structure method center {} {
my variable Size
return [list $Size(xc) $Size(yc) $Size(zc)]
}
oo::define Structure method radius {} {
my variable Size
return $Size(Rad)
}
oo::define Structure method _chains {} {
my variable ChnIdn
return [lsort $ChnIdn]
}
oo::define Structure method _resname {args} {
my variable NomRes1l NomRes3l TypRes
if {! [llength $args]} {
puts "Error ! num args"
return
}
set 3lcode 0
if {"-code3l" in $args} {set 3lcode 1}
set polymer 1
if {"-allres" in $args} {set polymer 0}
set i [lsearch $args "-chain"]
if {$i == -1} {
puts "Error ! no >>-chain<< card !"
return
}
set c [lindex $args [expr {$i+1}]]
if {! [info exists NomRes1l($c)]} {
puts "Error ! Chain >>$c<< does not exists"
return
}
set res [list]
if {$polymer} {
if {! $3lcode} {
set Lres [set NomRes1l($c)]
} else {
set Lres [set NomRes3l($c)]
}
foreach p [set TypRes($c)] r $Lres {
if {$p ne "ligand"} {
lappend res $r
}
}
} else {
if {! $3lcode} {
set [set NomRes1l($c)]
} else {
set [set NomRes3l($c)]
}
}
return $res
}
oo::define Structure method CoordsSeq2PDB {c x} {
# Conversion pour PDB dans MACSIM
# seq macsim est 1,2,3 ... et seq PDB peut
# etre 67,68,69 ...
set lr [my _resnumber -chain $c -polymer]
return [lindex $lr $x-1]
}
oo::define Structure method CoordsPDB2Seq {c x} {
# Conversion pour PDB dans MACSIM
# seq macsim est 1,2,3 ... et seq PDB peut
# etre 67,68,69 ...
set lr [my _resnumber -chain $c -polymer]
# ATTENTION !
# return value starts at 0 !
return [lsearch $lr $x]
}
oo::define Structure method CoordsDeAtom {chn res atm} {
my variable NmrRes NomAtm AtmXYZ
set i [lsearch $NmrRes($chn) $res]
set a [lindex $NomAtm($chn) $i]
set x [lindex $AtmXYZ($chn) $i]
set ia [lsearch $a $atm]
return [lindex $x $ia]
}
oo::define Structure method _resnumber {args} {
my variable NmrRes NomRes1l TypRes NomRes3l
if {! [llength $args]} {
puts "Error ! num args"
return
}
set i [lsearch $args "-chain"]
if {$i == -1} {
puts "Error ! no >>-chain<< card !"
return
}
set c [lindex $args [expr {$i+1}]]
if {! [info exists NomRes1l($c)]} {
puts "Error ! Chain >>$c<< does not exists"
return
}
set ip [lsearch $args "-polymer"]
set il [lsearch $args "-ligand"]
if {$ip != -1 && $il != -1} {
return
}
if {$ip != -1} {
set quoi [list "Protein" "Nucleic"]
} elseif {$il != -1} {
set quoi "ligand"
} else {
set quoi [list Protein Nucleic ligand]
}
set Lres [list]
foreach t [set TypRes($c)] a [set NmrRes($c)] {
if {$t in $quoi} {
lappend Lres $a
}
}
return $Lres
}
oo::define Structure method selcolor {col} {
my variable ResSel ResCol
foreach e [array names ResSel] {
if {[set ResSel($e)]} {set ResCol($e) $col}
}
return
}
oo::define Structure method select {args} {
my variable NomAtm NomRes1l NmrRes ChnIdn AtmXYZ AtmBQ Sequence SSBin SecStr Header ResSel
global Defauts
if {! [llength $args]} {
puts "Error ! num args"
return
}
if {[llength $args] == 1 && $args eq "all"} {
foreach e [array names ResSel] {
set ResSel($e) 1
}
return
}
if {[llength $args] == 1 && $args eq "none"} {
foreach e [array names ResSel] {
set ResSel($e) 0
set ResCol($e) [set Defauts(CoulVariable)]
}
return
}
# Si pas de cle chain, -> toutes les chaines
if {"chain" in $args} {
set ChnSel -1
}
set LExp $args
# Si parentheses, traite d'abord interne
if {[lsearch $args "("] != -1} {
set LExp [_DecoupeParParenthese $args]
}
set rep [my _TraiteExp $LExp]
set i 0
foreach v $ChnIdn {
foreach n [set NomRes1l($v)] {
set ResSel($v,$n) [lindex $rep $i]
incr i
}
}
return
}
oo::define Structure method _DecoupeParParenthese {l} {
set LO [lreverse [lsearch -all $l "\("]]
set LF [lreverse [lsearch -all $l "\)"]]
if {! [info exists DSel]} {set DSel [dict create]}
set comp 0
foreach o $LO f $LF {
set exp [lrange $l [expr {$o+1}] [expr {$f-1}]]
set res [my _TraiteExp $exp]
dict set DSel tmp${comp} $res
set l [lreplace $l $o $f "tdict" tmp${comp}]
incr comp
}
return $l
}
oo::define Structure method _Mult {a b op} {
set res [list]
foreach x $a y $b {
if {$op eq "and"} {
lappend res [expr {$x & $y}]
} else {
lappend res [expr {$x | $y}]
}
}
return $res
}
oo::define Structure method _TraiteExp {exp} {
set Lelt {}
foreach e $exp {
if {$e eq "and" || $e eq "or"} {
lappend LHow $e
lappend Lexp $Lelt
set Lelt {}
} else {
lappend Lelt $e
}
}
lappend Lexp $Lelt
set init 0
set i 0
foreach x $Lexp {
set RS [my _ExecSel $x]
if {! $init} {
set init 1
set tmp $RS
} else {
set tmp [my _Mult $RS $tmp [lindex $LHow $i]]
incr i
}
}
return $tmp
}
oo::define Structure method _ExecSel {sel} {
my variable ResSel NomRes1l NmrRes ChnIdn EqResType
set what [string tolower [lindex $sel 0]]
switch -regexp -- $what {
"chain" {
set c [lindex $sel 1]
foreach e [array names ResSel "$c,*"] {
set ResSel($e) 1
}
set res [list]
foreach v [set ChnIdn] {
if {$v eq $c} {set s 1} {set s 0}
set n [llength [set NomRes1l($v)]]
set res [concat $res [lrepeat $n $s]]
}
return $res
}
"resid" {
foreach e [array names ResSel] {
set ResSel($e) 0
}
set v [lindex $sel 1]
set Lx [split $v ","]
foreach x $Lx {
if {[regexp {:} $x]} {
lappend Lix [split $x ":"]
} else {
lappend Lix [list $x $x]
}
}
foreach v [set ChnIdn] {
foreach e $Lix {
lassign $e d f
for {set i $d} {$i <= $f} {incr i} {
set x "$v,$i"
set ResSel($x) 1
}
}
}
foreach c [set ChnIdn] {
foreach r [set NmrRes($c)] {
lappend res [set ResSel($c,$r)]
}
}
return $res
}
"ala|cys|asp|glu|phe|gly|his|ile|lys|leu|met|asn|pro|gln|arg|ser|thr|val|trp|tyr" {
# variable EqResType
set AA [string toupper $what]
set Li [dict get [set EqResType] $AA]
foreach c [set ChnIdn] {
foreach r [set NmrRes($c)] {
if {"$c,$r" in $Li} {set s 1} {set s 0}
lappend res $s
}
}
return $res
}
"tdict" {
variable DSel
set key [lindex $sel 1]
set res [dict get [set DSel] $key]
return $res
}
default {
puts "keyword not found : $what"
return
}
}
return
}
proc _CombleSSParCoil {{lss {} } molid chn} {
variable SecStr
variable NmrRes
set LesRes [set NmrRes($chn)]
set 1ResPDB [lindex $LesRes 0]
set DResPDB [lindex $LesRes end]
set df {}
foreach s $lss {
lassign $s Elt a z e Nm1 r Nm2 t q
lappend df [list $Nm1 $Nm2]
}
if {$df == {}} {
lappend df "Coil xxx xxx $chn $1ResPDB xxx $DResPDB xxx"
return $df
}
set 1ResSS [lindex [lindex $df 0] 0]
if {$1ResPDB - $1ResSS < 0} {
lappend lss "Coil xxx xxx $chn $1ResPDB xxx [expr {$1ResSS-1}]"
}
set debc [_NextResDuPdb $name [lindex [lindex $df 0] 1] $chn $molid]
foreach cpl [lrange $df 1 end] {
set finc [_PreviousResDuPdb $name [lindex $cpl 0] $chn $molid]
if {$finc-$debc >= 0} {
lappend lss "Coil xxx xxx $chn $debc xxx $finc xxx"
}
set debc [_NextResDuPdb $name [lindex $cpl 1] $chn $molid]
}
if {$debc ne ""} {
if {$DResPDB - $debc >= 0} {
lappend lss "Coil xxx xxx $chn $debc xxx $DResPDB xxx"
}
}
return [lsort -integer -index 4 $lss]
}
proc _NextResDuPdb {name res chn mol} {
variable NmrRes
set ires [lsearch [set NmrRes($chn)] $res]
set deb [lindex [set NmrRes($chn)] [expr {$ires+1}]]
return $deb
}
proc _PreviousResDuPdb {name res chn mol} {
variable NmrRes
set ires [lsearch [set NmrRes($chn)] $res]
set fin [lindex [set NmrRes($chn)] [expr {$ires-1}]]
return $fin
}
oo::define Structure method newObj {objname {init 0}} {
my variable DictDesObjets
set objname [BonObjName $objname]
if {[dict exists $DictDesObjets $objname]} {
puts "Error ! Object >>$objname<< already exists !"
return -1
}
set ix [dict get $DictDesObjets Index]
dict set DictDesObjets $objname $ix
incr ix
dict set DictDesObjets Index $ix
my variable $objname
dict set $objname OOn 1
dict set $objname globj 0
dict set $objname glList -1
dict set $objname glsel -1
dict set $objname glbox -1
dict set $objname FlagSrf 0
dict set $objname FlagRib 0
dict set $objname FlagCat 0
dict set $objname FlagAtm 0
dict set $objname FlagCPK 0
dict set $objname FlagPrl 0
dict set $objname FlagBox 0
if {$init} {return}
set pdb [string range [self] 2 end]
$::db eval {begin transaction}
set pkp [$::db eval {select pk_pdb from pdb where nom=$pdb}]
$::db eval "create table $objname as select * from objetinit where pk_pdb=$pkp"
$::db eval "create index idx_$objname on $objname (pk_obj, pk_residues, currsel, surface, ribbon, ribcol, catrace, cacol, atomes, atmcol, picked, label)"
$::db eval {commit}
my select none
return
}
oo::define Structure method CPK {obj} {
set obj [BonObjName $obj]
my variable ResSel ResCol $obj TypRes ChnIdn NmrRes
dict set $obj CPKatm [array names ResSel]
dict set $obj CPKcol [array names ResCol]
set pdb [string range [self] 2 end]
set sdb $::db
$sdb eval {begin transaction}
foreach c $ChnIdn {
set l1 [list]
set l0 [list]
foreach t $TypRes($c) r $NmrRes($c) {
if {$t eq "ligand"} {
continue
}
set v [set ResSel($c,$r)]
set Nn [format "%08s" $r]
if {$v} {
lappend l1 '$Nn'
} else {
lappend l0 '$Nn'
}
}
set ix1 [$sdb eval "select r.pk_residues from chaines as c, residues as r, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l1 ,])"]
$sdb eval "update $obj set atomes=1 where pk_residues in ([join $ix1 ,])"
set ix0 [$sdb eval "select r.pk_residues from chaines as c, residues as r, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l0 ,])"]
$sdb eval "update $obj set atomes=0 where pk_residues in ([join $ix0 ,])"
}
$sdb eval {commit}
dict set $obj FlagCPK 1
return
}
oo::define Structure method atomes {obj} {
set obj [BonObjName $obj]
my variable ResSel ResCol $obj TypRes ChnIdn NmrRes
dict set $obj atomes [array names ResSel]
dict set $obj atmcol [array names ResCol]
set pdb [string range [self] 2 end]
set sdb $::db
$sdb eval {begin transaction}
foreach c $ChnIdn {
set l1 [list]
set l0 [list]
foreach t $TypRes($c) r $NmrRes($c) {
if {$t eq "ligand"} {
continue
}
set v [set ResSel($c,$r)]
set Nn [format "%08s" $r]
if {$v} {
lappend l1 '$Nn'
} else {
lappend l0 '$Nn'
}
}
set ix1 [$sdb eval "select r.pk_residues from chaines as c, residues as r, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l1 ,])"]
$sdb eval "update $obj set atomes=1 where pk_residues in ([join $ix1 ,])"
set ix0 [$sdb eval "select r.pk_residues from chaines as c, residues as r, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l0 ,])"]
$sdb eval "update $obj set atomes=0 where pk_residues in ([join $ix0 ,])"
}
$sdb eval {commit}
dict set $obj FlagAtm 1
return
}
oo::define Structure method pearl {obj} {
set obj [BonObjName $obj]
my variable ResSel ResCol $obj TypRes ChnIdn NmrRes
dict set $obj pearl [array get ResSel]
dict set $obj prlcol [array get ResCol]
set pdb [string range [self] 2 end]
set sdb $::db
$sdb eval {begin transaction}
foreach c $ChnIdn {
set l1 [list]
set l0 [list]
foreach t $TypRes($c) r $NmrRes($c) {
if {$t eq "ligand"} {
continue
}
set v [set ResSel($c,$r)]
set Nn [format "%08s" $r]
if {$v} {
lappend l1 '$Nn'
} else {
lappend l0 '$Nn'
}
}
set ix1 [$sdb eval "select r.pk_residues from chaines as c, residues as r, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l1 ,])"]
$sdb eval "update $obj set pearl=1, ribbon=0 where pk_residues in ([join $ix1 ,])"
set ix0 [$sdb eval "select r.pk_residues from chaines as c, residues as r, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l0 ,])"]
$sdb eval "update $obj set pearle=0, ribbon=0 where pk_residues in ([join $ix0 ,])"
}
$sdb eval {commit}
dict set $obj FlagPrl 1
return
}
oo::define Structure method catrace {obj} {
set obj [BonObjName $obj]
my variable ResSel ResCol $obj TypRes ChnIdn NmrRes
dict set $obj catrace [array get ResSel]
dict set $obj cacol [array get ResCol]
set pdb [string range [self] 2 end]
set sdb $::db
$sdb eval {begin transaction}
foreach c $ChnIdn {
set l1 [list]
set l0 [list]
foreach t $TypRes($c) r $NmrRes($c) {
if {$t eq "ligand"} {
continue
}
set v [set ResSel($c,$r)]
set Nn [format "%08s" $r]
if {$v} {
lappend l1 '$Nn'
} else {
lappend l0 '$Nn'
}
}
set ix1 [$sdb eval "select r.pk_residues from chaines as c, residues as r, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l1 ,])"]
$sdb eval "update $obj set catrace=1, ribbon=0 where pk_residues in ([join $ix1 ,])"
set ix0 [$sdb eval "select r.pk_residues from chaines as c, residues as r, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l0 ,])"]
$sdb eval "update $obj set catrace=0, ribbon=0 where pk_residues in ([join $ix0 ,])"
}
$sdb eval {commit}
dict set $obj FlagCat 1
return
}
oo::define Structure method ribbons {obj} {
set obj [BonObjName $obj]
my variable ResSel ResCol $obj TypRes ChnIdn NmrRes
dict set $obj ribbon [array get ResSel]
dict set $obj ribcol [array get ResCol]
set val [dict get [set $obj] ribbon]
set pdb [string range [self] 2 end]
set sdb $::db
$sdb eval {begin transaction}
foreach c $ChnIdn {
set l1 [list] ; set l0 [list]
foreach t $TypRes($c) r $NmrRes($c) {
if {$t eq "ligand"} {continue}
set v [set ResSel($c,$r)]
set Nn [format "%08s" $r]
if {$v} {
lappend l1 '$Nn'
} else {
lappend l0 '$Nn'
}
}
set ix1 [$sdb eval "select r.pk_residues from residues as r, chaines as c, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l1 ,])"]
$sdb eval "update $obj set ribbon=1, catrace=0 where pk_residues in ([join $ix1 ,])"
set ix0 [$sdb eval "select r.pk_residues from residues as r, chaines as c, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and c.nom='$c' and r.pk_chaines=c.pk_chaines and r.rnmr in ([join $l0 ,])"]
$sdb eval "update $obj set ribbon=0, catrace=0 where pk_residues in ([join $ix0 ,])"
if {$obj eq "obj_tRNA"} {
puts "ribbons $c ix1 [llength $ix1] ix0 [llength $ix0]"
}
}
$sdb eval {commit}
dict set $obj FlagRib 1
return
}
oo::define Structure method surface {obj} {
set obj [BonObjName $obj]
my variable $obj ChnIdn ResSel
dict set $obj surface [array get ResSel]
$::db eval "update $obj set surface = 1 where ribbon=1 or catrace=1 or atomes=1 or cpk=1 or pearl=1"
dict set $obj FlagSrf 1
return
}
oo::define Structure method assignSelection {obj Lsel} {
set obj [BonObjName $obj]
my variable $obj ResSel ChnIdn
global db
set nom [string range [self] 2 end]
array set TSel $Lsel
$db eval {begin transaction}
foreach chn $ChnIdn {
catch {unset Rib}
catch {unset Atm}
catch {unset Cpk}
catch {unset Prl}
catch {unset Cap}
foreach e [array names TSel "$chn,*"] {
lassign [set TSel($e)] n type col
# grab all colors
lappend Lcols $col
set Nn [format "%08s" $n]
switch $type {
0 {
# None
}
1 {
# Atoms
lappend Atm($col) '$Nn'
}
2 {
# Ca/P trace
lappend Cap($col) '$Nn'
}
3 {
# Ribbon
lappend Rib($col) '$Nn'
}
4 {
# Ribbon + Atoms
lappend Rib($col) '$Nn'
lappend Atm($col) '$Nn'
}
5 {
# Ribbon + CPK
lappend Rib($col) '$Nn'
lappend Cpk($col) '$Nn'
}
6 {
# Pearls
lappend Prl($col) '$Nn'
}
7 {
# CPK
lappend Cpk($col) '$Nn'
}
}
}
set Lcols [lsort -unique $Lcols]
foreach col $Lcols {
if {$col eq "couldefond"} {
set colD [set ::Defauts(CoulVariable)]
} else {
set colD $col
}
# update table for ribbon
if {[info exists Rib] && [info exists Rib($col)]} {
dict set $obj FlagRib 1
set Lpkr [$db eval "select r.pk_residues from residues as r, chaines as c where
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.rnmr in ([join [set Rib($col)] ,])"]
$db eval "update $obj set ribcol='$colD', ribbon=1 where pk_residues in ([join $Lpkr ,])"
}
# update table for Ca/P trace
if {[info exists Cap] && [info exists Cap($col)]} {
dict set $obj FlagCat 1
set Lpkr [$db eval "select r.pk_residues from residues as r, chaines as c where
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.rnmr in ([join [set Cat($col)] ,])"]
$db eval "update $obj set cacol='$colD', catrace=1 where pk_residues in ([join $Lpkr ,])"
}
# update table for Atoms
if {[info exists Atm] && [info exists Atm($col)]} {
dict set $obj FlagAtm 1
set Lpkr [$db eval "select r.pk_residues from residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.rnmr in ([join [set Atm($col)] ,])"]
$db eval "update $obj set atmcol='$colD', atomes=1 where pk_residues in ([join $Lpkr ,])"
}
# update table for CPK
if {[info exists Cpk] && [info exists Cpk($col)]} {
dict set $obj FlagCPK 1
set Lpkr [$db eval "select r.pk_residues from residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.rnmr in ([join [set Cpk($col)] ,])"]
$db eval "update $obj set atmcol='$colD', cpk=1 where pk_residues in ([join $Lpkr ,])"
}
# update table for Pearl
if {[info exists Prl] && [info exists Prl($col)]} {
dict set $obj FlagPrl 1
set Lpkr [$db eval "select r.pk_residues from residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.rnmr in ([join [set Prl($col)] ,]) order by r.pk_residues"]
$db eval "update $obj set cacol='$colD', pearl=1 where pk_residues in ([join $Lpkr ,])"
}
}
}
$db eval {commit}
return
}
oo::define Structure method deleteObjects {} {
my variable DictDesObjets
$::db eval {begin transaction}
foreach o [my _ListeObjets] {
$::db eval "drop table $o"
dict unset DictDesObjets $o
my _dellist $o
}
$::db eval {commit}
dict set DictDesObjets Index 0
return
}
oo::define Structure method _dellist {obj} {
set obj [BonObjName $obj]
my variable $obj
foreach list [lreverse [dict get [set $obj] glList]] {
if {[glIsList $list]} {
glDeleteLists $list 1
}
}
dict set $obj glList -1
dict set $obj globj 0
return
}
oo::define Structure method GLListDe {type} {
set obj "${type}[string range [self] 2 end]"
my variable $obj
return [dict get [set $obj] ribobj]
}
oo::define Structure method _ListeObjets {} {
my variable DictDesObjets
set l [dict keys $DictDesObjets]
set Le {}
foreach e $l {
if {$e eq "Index"} {continue}
lappend Le $e
}
return $Le
}
oo::define Structure method _EtatDeObjet {obj} {
set obj [BonObjName $obj]
my variable $obj
return [dict get [set $obj] OOn]
}
oo::define Structure method ObjetOff {obj} {
set obj [BonObjName $obj]
my variable $obj
dict set $obj OOn 0
return
}
oo::define Structure method ObjetOn {obj} {
set obj [BonObjName $obj]
my variable $obj
dict set $obj OOn 1
return
}
oo::define Structure method Ind2Obj i {
my variable DictDesObjets
lassign [dict filter $DictDesObjets value $i] obj i
return $obj
}
oo::define Structure method ClearPicked {obj} {
set obj [BonObjName $obj]
$::db eval "update $obj set picked=0"
return
}
oo::define Structure method AddPicked {obj v} {
set obj [BonObjName $obj]
$::db eval "update $obj set picked=1 where pk_obj=$v"
return
}
oo::define Structure method _drawCPK obj {
my variable $obj ChnIdn
if {! [dict get [set $obj] FlagCPK]} {return}
set QObj [gluNewQuadric]
gluQuadricDrawStyle $QObj GLU_FILL
gluQuadricNormals $QObj GLU_SMOOTH
foreach chn $ChnIdn {
set La [my _AtomesDuCpk $obj $chn]
if {$La == {}} {continue}
foreach {x y z na col} $La {
if {$col eq "undefined"} {
set vcol [CouleurDeAtome $na]
} else {
set vcol [RGBDeLaTkCol $col]
}
set rad [RayonDeAtome $na]
glPushMatrix
glTranslatef $x $y $z
glColor4f {*}$vcol 1.0
gluSphere $QObj $rad 32 32
glPopMatrix
}
}
gluDeleteQuadric $QObj
return
}
oo::define Structure method _drawAtoms obj {
my variable $obj
global pgl
if {! [dict get [set $obj] FlagAtm]} {return}
foreach Lat [dict get [set $obj] atmvec] {
lassign $Lat tag type Lx La Ln Lan
# on ne trace pas la chaine principale si
# on est en ribbon ou catrace (flag cp)
if {$tag eq "Rib"} {
#use_light
set cp 0
set cyl 1
set QObj [gluNewQuadric]
gluQuadricDrawStyle $QObj GLU_FILL
gluQuadricNormals $QObj GLU_SMOOTH
} elseif {$tag eq "Cat"} {
set cp 0
set cyl 0
set QObj ""
} else {
set cp 1
set cyl 0
set QObj ""
}
switch $type {
"Protein" {
DrawAtomsProtein $cp $cyl $QObj $Lx $La $Ln
}
"Nucleic" {
DrawAtomsNucleic $cp $cyl $QObj $Lx $La $Ln
}
"ligand" {
DrawAtomsLigand $cp $cyl $QObj $Lx $La $Ln
}
}
if {$tag eq "Rib"} {
gluDeleteQuadric $QObj
}
}
return
}
oo::define Structure method _drawSurface obj {
my variable $obj
if {! [dict get [set $obj] FlagSrf]} {return}
puts "\nSurface de [self]"
glLightModelfv GL_LIGHT_MODEL_TWO_SIDE 0.0
glLightModeli GL_LIGHT_MODEL_COLOR_CONTROL $::GL_SEPARATE_SPECULAR_COLOR
glMaterialfv GL_FRONT_AND_BACK GL_AMBIENT {0.0 0.0 0.0 0.0}
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
glEnable GL_CULL_FACE
glCullFace GL_BACK
glPolygonMode GL_FRONT_AND_BACK GL_FILL
glHint GL_PERSPECTIVE_CORRECTION_HINT $::GL_NICEST
glEnable GL_TEXTURE_2D
#set FileTex "gold.jpg"
#set FileTex "glass.jpg"
set FileTex [file join $::OrdEtcDir fond.png]
#lassign [Bidon_LoadImage $FileTex] imgData imgW imgH type
set phImg [image create photo -file $FileTex]
set imgH [image height $phImg]
set imgW [image width $phImg]
set imgData [tcl3dVectorFromPhoto $phImg 1]
image delete $phImg
set latex [tcl3dVector GLuint 1]
glGenTextures 1 $latex
glBindTexture GL_TEXTURE_2D [$latex get 0]
gluBuild2DMipmaps GL_TEXTURE_2D $::GL_ALPHA $imgW $imgH $::GL_ALPHA GL_UNSIGNED_BYTE $imgData
$imgData delete
glEnable GL_TEXTURE_GEN_S
glEnable GL_TEXTURE_GEN_T
glTexEnvi GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_REPLACE
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_LINEAR
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_LINEAR
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
glTexGeni GL_S GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP
glTexGeni GL_T GL_TEXTURE_GEN_MODE $::GL_SPHERE_MAP
#glMaterialfv GL_BACK GL_AMBIENT_AND_DIFFUSE {0.0 0.0 0.0 1.0}
# Recupere atomes contribuant a la surface
set Lva [list]
$::db eval "select a.x, a.y, a.z, a.na from atomes as a, $obj as o where a.pk_atomes = o.pk_obj and o.surface=1" {lappend Lva [list $x $y $z $na 1]}
set Lva [lsort -unique $Lva]
#lassign [tsurf -sample 2 -expand 2 -contract 2 -smooth -connolly -filter 13 $Lva] Lv Ln
#lassign [tsurf -sample 2 -expand 2 -contract 2 -smooth -connolly $Lva] Lv Ln
lassign [tsurf -expand 2 -contract 2 -smooth -connolly $Lva] Lv Ln
# 1 glcol per vertex
set Lco [list]
for {set i 0} {$i<[llength $Lv]/3} {incr i} {
lappend Lco 0.2 0.2 0.05 0.05
}
dict set $obj globj 1
if {1} {
set Vec [tcl3dVectorFromList GLfloat $Lv]
set Nml [tcl3dVectorFromList GLfloat $Ln]
set Col [tcl3dVectorFromList GLfloat $Lco]
glEnableClientState GL_VERTEX_ARRAY
glEnableClientState GL_COLOR_ARRAY
glEnableClientState GL_NORMAL_ARRAY
glVertexPointer 3 GL_FLOAT 0 $Vec
glColorPointer 4 GL_FLOAT 0 $Col
glNormalPointer GL_FLOAT 0 $Nml
glDrawArrays GL_TRIANGLES 0 [expr {[llength $Lv]/3}]
} else {
set Lvert [list]
set Lnorm [list]
foreach {x y z} $Lv {nx ny nz} $Ln {
lappend Lvert [list $x $y $z]
lappend Lnorm [list $nx $ny $nz]
}
set Lcol [list]
set Lcol [lrepeat [llength $Lvert] [list 0.2 0.2 0.05 0.05]]
foreach {v1 v2 v3} $Lvert {n1 n2 n3} $Lnorm col $Lcol {
glBegin GL_TRIANGLES
glColor4fv $col
glNormal3fv $n1
glVertex3fv $v1
glNormal3fv $n2
glVertex3fv $v2
glNormal3fv $n3
glVertex3fv $v3
glEnd
}
}
glLightModeli GL_LIGHT_MODEL_COLOR_CONTROL $::GL_SINGLE_COLOR
glDisable GL_TEXTURE_GEN_S
glDisable GL_TEXTURE_GEN_T
glDisable GL_TEXTURE_2D
glDisable GL_BLEND
glDisable GL_CULL_FACE
glLightModelfv GL_LIGHT_MODEL_TWO_SIDE 1.0
return
}
oo::define Structure method _drawRibbon obj {
my variable $obj
if {! [dict get [set $obj] FlagRib]} {return}
set ListLesVecs [dict get [set $obj] ribvec]
if {[lindex $ListLesVecs 0] eq"Nucleic" || [lindex $ListLesVecs 0] eq "Protein"} {
# Only one ribbon
set ListLesVecs [list $LesVecs]
}
foreach LesVecs $ListLesVecs {
if {$LesVecs == {}} {continue}
if {0} {
DebugRib $LesVecs
return
}
# cas nucleic :
#glFrontFace GL_CW
if {[lindex $LesVecs 0] eq "Nucleic"} {
DrawRibbonNucleic [lindex $LesVecs 1] [lindex $LesVecs 2]
} else {
DrawRibbonProtein [lindex $LesVecs 1]
}
#glFrontFace GL_CCW
}
if {[dict get [set $obj] FlagBox]} {
set chn [string index $obj end]
my _drawBoite $obj $chn
}
return
}
oo::define Structure method _drawCatrace obj {
my variable $obj ChnIdn
if {! [dict get [set $obj] FlagCat]} {return}
#dont_use_light
foreach chn $ChnIdn {
set LLa [my _AtomesDuCaTrace $obj $chn]
foreach Lcc $LLa {
set C1 [lrange $Lcc 0 end-1]
set C2 [lrange $Lcc 1 end]
foreach e1 $C1 e2 $C2 {
set v1 [lrange $e1 0 2]
set c1 [lindex $e1 3]
set v2 [lrange $e2 0 2]
set c2 [lindex $e2 3]
TraceLiaison "" $v1 $v2 $c1 $c2 0
}
}
}
#use_light
return
}
oo::define Structure method _drawPearl obj {
my variable $obj ChnIdn TypChn
if {! [dict get [set $obj] FlagPrl]} {return}
set QObj [gluNewQuadric]
gluQuadricDrawStyle $QObj GLU_FILL
gluQuadricNormals $QObj GLU_SMOOTH
foreach chn $ChnIdn {
if {[set TypChn($chn)] eq "Protein"} {
set Rad 3.
} else {
set Rad 4.
}
set La [my _AtomesDuPearl $obj $chn]
if {$La == {}} {continue}
foreach {x y z col} $La {
set vcol [RGBDeLaTkCol $col]
glPushMatrix
glTranslatef $x $y $z
glColor4f {*}$vcol 1.0
gluSphere $QObj $Rad 32 32
glPopMatrix
}
}
gluDeleteQuadric $QObj
return
}
oo::define Structure method _SetupPicking {obj tag} {
set obj [BonObjName $obj]
my variable $obj ChnIdn DictDesObjets
global HashPDB
set nom [string range [self] 2 end]
set mx [set HashPDB($nom)]
set ox [dict get $DictDesObjets $obj]
set tag [format "%03d%02d" $mx $ox]
dont_use_light
glInitNames
glPushName 0
set id 1
foreach chn $ChnIdn {
set La [my _AtomesDuAtm $obj $chn $id]
foreach {ta tb x y z tc td i} $La {
glLoadName "1${i}$tag"
glBegin GL_POINTS
glVertex3f $x $y $z
glEnd
}
}
return
}
oo::define Structure method AtomXYZ {v} {
return [$::db eval {select x, y, z from atomes where pk_atomes=$v}]
}
oo::define Structure method _ClearIDs {} {
foreach o [my _ListeObjets] {
my _ClearObjIDs $o
}
return
}
oo::define Structure method _ClearObjIDs {obj} {
set obj [BonObjName $obj]
$::db eval "update $obj set picked=0"
return
}
oo::define Structure method _mapfeat {obj f la2} {
global TabSF Defauts StrucAVoir db
set obj [BonObjName $obj]
my variable $obj
if {$f eq ""} {return}
set nom [string range [self] 2 end]
if {$f eq "None" && ! $la2} {
set c [set Defauts(CoulVariable)]
$db eval {begin transaction}
$db eval "update $obj set atmcol='$c', ribcol='$c', cacol='$c'"
$db eval {commit}
return
}
set i [lsearch -regexp $StrucAVoir $nom]
set nomf [BonAccess [lindex $StrucAVoir $i]]
if {! [info exists TabSF($nomf,$f)]} {return}
$db eval {begin transaction}
foreach e [set TabSF(${nomf},$f)] {
DecortiqueUneFeature $e dg fg col score note
set dg [CorrespondanceGenPDB $nomf $dg]
set fg [CorrespondanceGenPDB $nomf $fg]
set fdeb [format "%08s" $dg]
set ffin [format "%08s" $fg]
switch -regexp -- $f {
{^Cons} {
if {$col eq "black"} {set c white}
}
"SS-Cons" {
set c $note
}
default {
set c [CouleurO2Ordali $col]
}
}
set Li [$db eval "select o.pk_obj from $obj as o, pdb as p, residues as r where (r.rnmr >= '$fdeb' and r.rnmr <= '$ffin') and o.pk_residues=r.pk_residues and o.pk_pdb=p.pk_pdb and p.nom='$nom'"]
$db eval "update $obj set atmcol='$c', ribcol='$c', cacol='$c' where pk_obj in ([join $Li ,])"
#puts "mapfeat $dg $fg [llength $Li]"
}
#puts ""
$db eval {commit}
return
}
oo::define Structure method _Labels obj {
my variable $obj
set sdb $::db
set Lx {}
set Ll {}
set Lv [$sdb eval "select a.x, a.y, a.z, o.label from atomes as a, $obj as o where a.pk_atomes=o.pk_obj and o.picked=1"]
foreach {x y z l} $Lv {
lappend Lx [list $x $y $z]
lappend Ll $l
}
return [list $Lx $Ll]
}
oo::define Structure method display {} {
my variable DictDesObjets
global pgl db HashPDB
set nom [string range [self] 2 end]
set mx [set HashPDB($nom)]
$::db eval {begin transaction}
set LObj [dict keys $DictDesObjets]
foreach obj $LObj {
if {$obj eq "Index"} {continue}
my variable $obj
set ox [dict get $DictDesObjets $obj]
set tag [format "%03d%02d" $mx $ox]
if {! [my _EtatDeObjet $obj]} {continue}
if {$pgl(GLMode) eq "select"} {
if {[regexp {^BOX} $obj]} {continue}
if {[dict get [set $obj] glsel] != -1} {
glCallList [dict get [set $obj] glsel]
} else {
set list [glGenLists 1]
dict set $obj glsel $list
glNewList $list GL_COMPILE_AND_EXECUTE
my _SetupPicking $obj $tag
glEndList
}
} else {
if {[dict get [set $obj] globj] == 1} {
glCallList [dict get [set $obj] glList]
} elseif {[dict get [set $obj] globj] == 2} {
glDrawArrays GL_TRIANGLES 0 [llength [dict get [set $obj] Ltrig]]
} else {
set list [glGenLists 1]
dict set $obj globj 1
dict set $obj glList $list
glNewList $list GL_COMPILE
my _drawRibbon $obj
my _drawCatrace $obj
my _drawPearl $obj
my _drawAtoms $obj
my _drawCPK $obj
my _drawSurface $obj
#my _drawboite $obj $chn
glEndList
glCallList [dict get [set $obj] glList]
}
lassign [my _Labels $obj] Lx Lt
AfficheLabels $Lx $Lt
}
glFlush
}
$::db eval {commit}
return
}
oo::define Structure method render {obj} {
set obj [BonObjName $obj]
my variable $obj DictDesObjets TypChn ChnIdn
global HashPDB db
set nom [string range [self] 2 end]
set mx [set HashPDB($nom)]
set ox [dict get $DictDesObjets $obj]
set tag [format "%03d%02d" $mx $ox]
$db eval {begin transaction}
# Trace le RIBBON
if {[dict get [set $obj] FlagRib]} {
set LesVecs [list]
foreach chn $ChnIdn {
set ListeLat [my _AtomesDuRibbon $obj $chn]
if {$ListeLat == 0} {continue}
puts "[self] render $chn $TypChn($chn)"
puts "ListeLat [llength $ListeLat]"
foreach Lat $ListeLat {
lassign $Lat Lca Lcol Lc Lo
puts " dans Lat : Lca [llength $Lca] Lcol [llength $Lcol]"
update idletasks
flush stdout
lappend LesVecs [CheminRibbon $TypChn($chn) $Lca $Lcol $Lc $Lo]
}
}
dict set $obj ribvec $LesVecs
# Pour Picking
# Faut cle atmvec, avec chaine principale
set Lv [$db eval "select r.pk_residues, r.rnom3l, a.x, a.y, a.z, a.anom, a.pk_atomes from residues as r, atomes as a, $obj as o, pdb as p where o.ribbon=1 and r.pk_residues=a.pk_residues and o.pk_obj=a.pk_atomes and r.type = 'Protein' and r.pk_pdb=p.pk_pdb and p.nom='$nom' and a.anom=' CA ' order by a.pk_atomes"]
set first 1
set LX [list] ; set LA [list]
set Li [list]
set ncou [lindex $Lv 0]
set rcou [lindex $Lv 1]
set Lxyz {} ; set Lnm {} ; set Lli {}
foreach {n r x y z a i} $Lv {
if {$n != $ncou} {
lappend Ln $rcou
lappend LX $Lxyz
lappend LA $Lnm
lappend Li $Lli
set Lxyz {}
set Lnm {}
set Lli {}
set rcou $r
set ncou $n
}
set xyz [list $x $y $z]
lappend Lxyz $xyz
lappend Lli [format "%d%03d%02d" $i $mx $ox]
lappend Lnm $a
}
lappend Ln $rcou
lappend LX $Lxyz
lappend LA $Lnm
lappend Li $Lli
#dict set $obj atmvec [list $Li $LX $LA $Ln]
}
if {0 && [dict get [set $obj] FlagCat]} {
foreach chn $ChnIdn {
set Lat [_AtoemesDuCaTrace $obj $chn $tag]
lassign $Lat Li Lca Lcol
dict lappend $obj catvec [list $Li $Lca]
dict lappend $obj catcol $Lcol
}
}
if {[dict get [set $obj] FlagAtm] || [dict get [set $obj] FlagCPK] || [dict get [set $obj] FlagSrf]} {
dict set $obj atmvec [list]
foreach chn $ChnIdn {
set Lat [my _AtomesDuAtm $obj $chn]
if {$Lat == {}} {continue}
if {[lindex $Lat 0] eq "Rib" || [lindex $Lat 0] eq "Cat" || [lindex $Lat 0] eq "Atm"} {
dict lappend $obj atmvec $Lat
} else {
dict lappend $obj atmvec {*}$Lat
}
}
}
$db eval {commit}
return
}
oo::define Structure method save {c d f} {
global db
set file [DemandeEtSauveFichier pdb]
if {$file eq ""} {return}
set pdb [string range [self] 2 end]
if {$c ne "all"} {
set Lc $c
} else {
set Lc [my _chains]
}
if {$d ne "all"} {
set deb [format "%08s" $d]
set fin [format "%08s" $f]
set Ar "and r.rnmr >= '$deb' and r.rnmr <= '$fin'"
} else {
set Ar ""
}
set f [open $file w]
$db eval {begin transaction}
set header [$db eval {select header from pdb where nom=$pdb}]
if {$header != {}} {
puts $f [join [lindex $header 0] \n]
}
set i 1
foreach c $Lc {
# Traite polymer
set Lv [$db eval "select a.anom, r.rnom3l, r.rnmr, a.x, a.y, a.z, a.b, a.q from atomes as a, residues as r, chaines as c, pdb as p where
p.nom = '$pdb' and
c.pk_pdb = p.pk_pdb and
c.nom = '$c' and
r.pk_chaines = c.pk_chaines and
r.type = 'Protein' and
a.pk_residues= r.pk_residues $Ar"]
foreach {an rn rr x y z b q} $Lv {
set rr [string trimleft $rr 0]
puts $f [format "ATOM %5d %4s %3s %1s%4s %8.3f%8.3f%8.3f%6.2f%6.2f" $i $an $rn $c $rr $x $y $z $q $b]
incr i
}
# Traite ligand
set Lv [$db eval "select a.anom, r.rnom3l, r.rnmr, a.x, a.y, a.z, a.b, a.q from atomes as a, residues as r, chaines as c, pdb as p where p.nom='$pdb' and c.pk_pdb=p.pk_pdb and r.pk_chaines=c.pk_chaines and c.nom='$c' and r.type='ligand' and a.pk_residues=r.pk_residues $Ar"]
if {$Lv != {}} {
puts $f "TER "
foreach {an rn rr x y z b q} $Lv {
set rr [string trimleft $rr 0]
puts $f [format "HETATM%5d %4s %3s %1s%4s %8.3f%8.3f%8.3f%6.2f%6.2f" $i $an $rn $c $rr $x $y $z $q $b]
incr i
}
}
}
$db eval {commit}
puts $f "END"
close $f
return
}
proc Tag2MolObjAtm {i} {
set x [expr {[string length $i]-5}]
scan $i "%${x}d%03d%02d" atm imol iobj
set mol [set ::HashPDB($imol)]
set obj [$mol Ind2Obj $iobj]
set atm [string range $atm 1 end]
return [list $mol $obj $atm]
}
oo::define Structure method GiveVar {n} {
my variable $n
return [set $n]
}
oo::define Structure method AddVar {n v} {
my variable $n
set $n $v
return
}
oo::define Structure method _AtomesDuAtm {obj chn {id ""}} {
my variable TypChn $obj
set nom [string range [self] 2 end]
set rtype $TypChn($chn)
# if id is not set, we retrieve atomes for
# display. If id is set, we just need x y z
# pk_atomes for picking
if {$id eq ""} {
set pexp ""
} else {
}
set Lres [list]
# three passes :
# first for ribbon main-chain
if {[dict get [set $obj] FlagRib]} {
set tag Rib
set Lv [$::db eval "select r.pk_residues, r.rnom3l, a.x, a.y, a.z, a.na, a.anom, a.pk_atomes from residues as r, atomes as a, $obj as o, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.type = '$rtype' and
a.pk_residues = r.pk_residues and
o.pk_obj = a.pk_atomes and
o.atomes = 1 and
o.ribbon = 1 $pexp
order by o.pk_obj"]
if {$Lv != {}} {
if {$id ne ""} {
set Lres $Lv
} else {
set Ln [list] ; set Lan [list]
set LX [list] ; set LA [list]
set Lna [list] ; set Li [list]
set first 1
set Lxyz {} ; set Lnm {}
set ncou [lindex $Lv 0]
set rcou [lindex $Lv 1]
puts "Lv [llength $Lv] [expr {[llength $Lv]/8}]"
foreach {n r x y z na a i} $Lv {
if {$n != $ncou} {
lappend Ln $rcou
lappend LX $Lxyz
lappend LA $Lnm
lappend Lan $Lna
set Lxyz {}
set Lnm {}
set Lna {}
set rcou $r
set ncou $n
}
lappend Lxyz [list $x $y $z]
lappend Lnm $a
lappend Lna $na
}
lappend Ln $rcou
lappend LX $Lxyz
lappend LA $Lnm
lappend Lan $Lna
puts "[self] AtomesDuAtm $tag [llength $LX]"
lappend Lres [list $tag $rtype $LX $LA $Ln $Lan]
}
}
}
# pass for Ca-Trace
if {[dict get [set $obj] FlagCat]} {
set tag Cat
set Lv [$::db eval "select r.pk_residues, r.rnom3l, a.x, a.y, a.z, a.na, a.anom, a.pk_atomes from residues as r, atomes as a, $obj as o, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.type = '$rtype' and
a.pk_residues = r.pk_residues and
o.pk_obj = a.pk_atomes and
o.atomes = 1 and
o.catrace = 1 $pexp
order by a.pk_atomes"]
if {$Lv != {}} {
if {$id ne ""} {
lappend Lres {*}$Lv
} else {
set Ln [list] ; set Lan [list]
set LX [list] ; set LA [list]
set Lna {}
set first 1
set Lxyz {} ; set Lnm {}
set ncou [lindex $Lv 0]
set rcou [lindex $Lv 1]
puts "Lv [llength $Lv] [expr {[llength $Lv]/8}]"
foreach {n r x y z na a i} $Lv {
if {$n != $ncou} {
lappend Ln $rcou
lappend LX $Lxyz
lappend LA $Lnm
lappend Lan $Lna
set Lxyz {}
set Lnm {}
set Lna {}
set rcou $r
set ncou $n
}
lappend Lxyz [list $x $y $z]
lappend Lnm $a
lappend Lna $na
}
lappend Ln $rcou
lappend LX $Lxyz
lappend LA $Lnm
lappend Lan $Lna
puts "[self] AtomesDuAtm $tag [llength $LX]"
lappend Lres [list $tag $rtype $LX $LA $Ln $Lan]
}
}
}
# pass for full all-atoms
set tag Atm
set Lv [$::db eval "select r.pk_residues, r.rnom3l, a.x, a.y, a.z, a.na, a.anom, a.pk_atomes from residues as r, atomes as a, $obj as o, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.type = '$rtype' and
a.pk_residues = r.pk_residues and
o.pk_obj = a.pk_atomes and
o.atomes = 1 and
o.ribbon = 0 and O.catrace = 0
order by o.pk_obj"]
if {$Lv != {}} {
if {$id ne ""} {
lappend Lres {*}$Lv
} else {
set Ln [list] ; set Lan [list]
set LX [list] ; set LA [list]
set Li [list] ; set Lna {}
set first 1
set Lxyz {} ; set Lnm {}
set ncou [lindex $Lv 0]
set rcou [lindex $Lv 1]
puts "Lv [llength $Lv] [expr {[llength $Lv]/8}]"
foreach {n r x y z na a i} $Lv {
if {$n != $ncou} {
lappend Ln $rcou
lappend LX $Lxyz
lappend LA $Lnm
lappend Lan $Lna
set Lxyz {}
set Lnm {}
set Lna {}
set rcou $r
set ncou $n
}
lappend Lxyz [list $x $y $z]
lappend Lnm $a
lappend Lna $na
}
lappend Ln $rcou
lappend LX $Lxyz
lappend LA $Lnm
lappend Lan $Lna
puts "[self] AtomesDuAtm $tag [llength $LX]"
lappend Lres [list $tag $rtype $LX $LA $Ln $Lan]
}
}
return $Lres
}
oo::define Structure method _AtomesDuCaTrace {obj chn} {
my variable TypChn
set nom [string range [self] 2 end]
set rtype $TypChn($chn)
if {$TypChn($chn) eq "Protein"} {
set caatm " CA "
} elseif {$TypChn($chn) eq "Nucleic"} {
set caatm " P "
}
set Lv [$::db eval "select o.cacol, a.x, a.y, a.z from atomes as a, $obj as o, residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.type = '$rtype' and
a.pk_residues = r.pk_residues and
a.anom = '$caatm' and
o.pk_obj = a.pk_atomes and
o.catrace = 1
order by o.pk_atomes"]
set Lcac [list]
foreach {c x y z} $Lv {
lappend Lcac [list $x $y $z [RGBDeLaTkCol $c]]
}
set Lcac [TestCoupeMainChain $rtype $Lcac]
return $Lcac
}
oo::define Structure method _AtomesDuPearl {obj chn} {
my variable TypChn
set nom [string range [self] 2 end]
set rtype $TypChn($chn)
if {$TypChn($chn) eq "Protein"} {
set caatm " CA "
} elseif {$TypChn($chn) eq "Nucleic"} {
set caatm " P "
}
set Lcac [$::db eval "select a.x, a.y, a.z, o.cacol from atomes as a, $obj as o, residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.type = '$rtype' and
a.pk_residues = r.pk_residues and
a.anom = '$caatm' and
o.pk_obj = a.pk_atomes and
o.pearl = 1
order by o.pk_obj"]
puts "Pearl Lcac [llength $Lcac]"
return $Lcac
}
oo::define Structure method _AtomesDuCpk {obj chn} {
my variable TypChn
set nom [string range [self] 2 end]
# must make two pass :
# - if ribbon set on the residue no main chain
# - if ribbon not set , send all atoms
if {[set TypChn($chn)] eq "Protein"} {
set exp " and (a.anom != ' CA ' and a.anom != ' C ' and a.anom != ' N ' and a.anom != ' O ') "
} else {
set exp ""
}
set La [$::db eval "select a.x, a.y, a.z, a.na, o.atmcol from pdb as p, chaines as c, atomes as a, $obj as o where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
a.pk_chaines = c.pk_chaines and
o.pk_obj = a.pk_atomes and
o.cpk = 1 order by pk_obj"]
lappend La {*}[$::db eval "select a.x, a.y, a.z, a.na, o.atmcol from pdb as p, chaines as c, residues as r, atomes as a, $obj as o where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
a.pk_residues = r.pk_residues and
o.pk_obj = a.pk_atomes and
o.cpk = 1 and
o.ribbon = 1 $exp
order by pk_obj"]
return $La
}
oo::define Structure method _AtomesDuRibbon {obj chn} {
my variable TypChn
set nom [string range [self] 2 end]
set rtype $TypChn($chn)
if {$rtype eq "Protein"} {
set caatm " CA "
} elseif {$rtype eq "Nucleic"} {
set caatm " P "
} else {
return 0
}
set Lca [list] ; set Lc [list] ; set Lo [list]
set tmp [$::db eval "select a.x, a.y, a.z, o.ribcol from atomes as a, $obj as o, residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.type = '$rtype' and
a.pk_residues = r.pk_residues and
a.anom = '$caatm' and
o.pk_obj = a.pk_atomes and
o.ribbon = 1
order by a.pk_atomes"]
# pas de ribbon !
if {$tmp == {}} {
return 0
}
foreach {x y z c} $tmp {
lappend Lcol [RGBDeLaTkCol $c]
lappend Lca [list $x $y $z]
}
if {$rtype eq "Protein"} {
set tmp [$::db eval "select a.x,a.y,a.z from atomes as a, $obj as o, residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.type = 'Protein' and
a.pk_residues = r.pk_residues and
a.anom = ' C ' and
o.pk_obj = a.pk_atomes and
o.ribbon = 1
order by a.pk_atomes"]
foreach {x y z} $tmp {
lappend Lc [list $x $y $z]
}
set tmp [$::db eval "select a.x,a.y,a.z from atomes as a, $obj as o, residues as r, chaines as c, pdb as p where
p.nom = '$nom' and
c.pk_pdb = p.pk_pdb and
c.nom = '$chn' and
r.pk_chaines = c.pk_chaines and
r.type = 'Protein' and
a.pk_residues = r.pk_residues and
a.anom = ' O ' and
o.pk_obj = a.pk_atomes and
o.ribbon = 1
order by a.pk_atomes"]
foreach {x y z} $tmp {
lappend Lo [list $x $y $z]
}
}
# regarde si le ribbon est coupe en
# plusieurs morceaux
set Lat [TestCoupeMainChain $rtype $Lca $Lcol $Lc $Lo]
return $Lat
}
oo::define Structure export CPK CoordsSeq2PDB CoordsPDB2Seq _SetB _EtatDeObjet ObjetOn ObjetOff _ListeObjets _mapfeat _dellist Ind2Obj AddPicked AtomXYZ _chains _resnumber _resname _Dimensions SecStr PDBInfos SSBin CoordsDeAtom AddVar GiveVar
return
}
proc Rescale {a1 a3 {cof 2.}} {
lassign $a1 nx ny nz
lassign $a3 vx vy vz
set rx [expr {$vx+$cof*$nx}]
set ry [expr {$vy+$cof*$ny}]
set rz [expr {$vz+$cof*$nz}]
return [list $rx $ry $rz]
}
proc DebugRib {l} {
#dont_use_light
set l [lindex $l 1]
set i 0
set col magenta
set coltmp cyan
foreach {n1 c1 v1 n2 c2 v2 n3 c3 v3} $l {
if {1} {
puts [format "Pts 1 %8.3f %8.3f %8.3f" {*}$a3]
puts [format "Pts 2 %8.3f %8.3f %8.3f" {*}$b3]
puts [format "Pts 3 %8.3f %8.3f %8.3f" {*}$c3]
puts [format "Nrm 1 %8.3f %8.3f %8.3f" {*}$a1]
puts [format "Nrm 2 %8.3f %8.3f %8.3f" {*}$b1]
puts [format "Nrm 3 %8.3f %8.3f %8.3f" {*}$c1]
puts ""
}
if {! ($i%4)} {
puts "$i col $col coltmp $coltmp"
set col2 $col
set col $coltmp
set coltmp ${col2}
set vcol [RGBDeLaTkCol $col]
puts " -> col $col coltmp $coltmp"
}
# triangle
glColor3fv $vcol
glBegin GL_LINES
glVertex3fv $v1
glVertex3fv $v2
glEnd
glColor3fv $vcol
glBegin GL_LINES
glVertex3fv $v2
glVertex3fv $v3
glEnd
glColor3fv $vcol
glBegin GL_LINES
glVertex3fv $v1
glVertex3fv $v3
glEnd
if {0} {
# Normals
set n1 [Rescale $n1 $v1]
set n2 [Rescale $n2 $v2]
set n3 [Rescale $n3 $v3]
glBegin GL_LINES
glVertex3fv $v1
glVertex3fv $n1
glEnd
glBegin GL_LINES
glVertex3fv $n2
glVertex3fv $v2
glEnd
glBegin GL_LINES
glVertex3fv $n3
glVertex3fv $v3
glEnd
}
incr i
if {$i > 40} {break}
}
glEnd
return
}
proc TraceTriangle {v1 v2 v3 n1 n2 n3 {Bar {} }} {
if {$Bar != {} } {
set v1 [V_VV $v1 - $Bar]
set v2 [V_VV $v2 - $Bar]
set v3 [V_VV $v3 - $Bar]
}
set n1 [Rescale $n1 $v1 1.]
set n2 [Rescale $n2 $v2 1.]
set n3 [Rescale $n3 $v3 1.]
glColor4f 0.4 0.4 0.6 1.0
glVertex3fv $v1
glVertex3fv $v2
glVertex3fv $v2
glVertex3fv $v3
glVertex3fv $v3
glVertex3fv $v1
glColor4f 1.0 1.0 1.0 1.0
glVertex3fv $v1
glVertex3fv $n1
glVertex3fv $v2
glVertex3fv $n2
glVertex3fv $v3
glVertex3fv $n3
return
}
proc BonObjName {obj} {
if {! [regexp {^obj_} $obj]} {
set obj "obj_${obj}"
}
return $obj
}
proc LoadObjFromDB {} {
foreach t [GetTables] {
if {[regexp {^obj_} $t]} {
set pdb [$::db eval "select p.nom from pdb as p, $obj as o where o.pk_pdb=p.pk_pdb"]
set obj [string range $t 4 end]
lappend Lpo [list $pdb $obj]
$pdb newObj $obj 1
}
}
return
}
proc CreatePDBFromDB {} {
global db HashPDB ListePDB BadPDB Warn
$db eval {begin transaction}
set LesPDBs [$db eval {select nom from pdb}]
set LNoms [$db eval {select access from seqinfo}]
$db eval {commit}
set HashPDB(iHmax) 0
set BadPDB [list]
set ListePDB [list]
set ix -1
foreach n $LNoms {
incr ix
if {! [EstUnAccessPDB $n]} {continue}
set nom [DonneIdDeAccessPDB $n]
set chn [DonneChainDeAccessPDB $n]
if {$chn eq ""} {set chn "a"}
if {$nom ni $LesPDBs} {
# Mauvais PDB
lappend Warn(BadPdb) $nom
set Warn($nom) 1
lappend BadPDB $ix
continue
}
set Warn($nom) 0
if {[set ixp [lsearch -regexp $ListePDB $nom]] != -1} {
# PDB deja vu, enregistre juste la chaine
lappend ListePDB [BonNomPDB ${nom}_$chn]
continue
}
set cok [LoadNouveauPDB $nom $chn]
if {! $cok} {
lappend BadPDB $ix
}
}
return
}
proc InfosDesPDB {} {
foreach e $::ListePDB {
set mol [DonneIdDeAccessPDB $e]
set chn [DonneChainDeAccessPDB $e]
if {$chn eq ""} {set chn "a"}
$mol PDBInfos $chn
}
return
}