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

bugs claudine, overview, superposition, display, vrp, conservation

parent 9d00ff9a
Pipeline #1840 failed with stages
in 2 minutes and 5 seconds
proc SetupPDBObject {} {
oo::class create Structure {
......@@ -173,11 +176,11 @@ proc SetupPDBObject {} {
# if newid != null, superseeded !
if {$newid ne ""} {
set nom [string range $newid 2 end]
set nom [string toupper [string range $newid 2 end]]
} else {
set nom [string range [self] 2 end]
}
set nom [string range [self] 2 end]
set nom [string toupper [string range [self] 2 end]]
# database not open, create it
if {! [info exists db] || $db eq ""} {
......
......@@ -90,8 +90,8 @@ proc LoadTclPackages {} {
package require tclfastme
package require http
package require sqlite3
#package require La
#catch { namespace import La::*}
package require La
catch { namespace import La::*}
package require struct
package require tdom
......
......@@ -6118,6 +6118,52 @@ proc CentreOverview {Id x y} {
}
proc CheckImageOverview {img} {
set wdt [$img cget -width]
set hgt [$img cget -height]
set Ld [$img data]
set See1 0 ; set See2 0
set skip 0 ; set dupl 0
set Lnew {}
set iRow 0
foreach rowOri $Ld {
set row [lunique [split $rowOri]]
if {[llength $row] == 1 && $row eq "#ffffff"} {
# this is a blank line
if {! $See1} {
set See1 1
} elseif {! $See2} {
set See2 1
} else {
set skip 1
}
} else {
# not a blank line
if {$See1 && ! $See2} {
set dupl 1
}
}
if {$dupl} {
lappend Lnew [lindex $Ld $iRow-1]
set dupl 0
}
if {! $skip} {
lappend Lnew $rowOri
} else {
set skip 0
}
incr iRow
}
image delete $img
image create photo $img
$img put $Lnew
return
}
proc CalculeOverview {Id} {
global NomTextSeq Ovw LSOrdali
......@@ -6129,7 +6175,7 @@ proc CalculeOverview {Id} {
set Ovw(O$Id,Height) $Thgt
set Ovw(O$Id,WidthOri) 600.
set Ovw(O$Id,HeightOri) 300.
set Ovw(O$Id,HeightOri) 400.
set fx [expr {1.* $Ovw(O$Id,WidthOri)/$Twdt}]
set fy [expr {1.* $Ovw(O$Id,HeightOri)/$Thgt}]
......@@ -6169,6 +6215,7 @@ proc CalculeOverview {Id} {
# subsample image if necessary
LRI::imgtransform $img -scalex [expr {int($fx * 100)}] -scaley [expr {int($fy * 100.)}]
CheckImageOverview $img
if {! [info exists Ovw(O$Id,ScaleTot)] || $Ovw(O$Id,ScaleTot) eq ""} {
set Ovw(O$Id,ScaleTot) {}
} else {
......@@ -6474,8 +6521,8 @@ proc AfficheFenetreOverview {Id} {
set Ovw(O$Id,w) "$w.c"
set wc "$w.c"
canvas $w.c \
-height 300 \
-width 500 \
-height 400 \
-width 600 \
-background white
frame $w.btn
grid $w.c -row 0 -column 0 -sticky news
......@@ -7774,6 +7821,8 @@ proc AfficheBarreMenus {} {
$mse add command -label "Retrieve Seq. info" -command "CheckInfosSeqs"
$mse add command -label "Browse Seq. info" -command "MontreInfoSeq"
$mse add command -label "Edit Seq. info" -command "EditInfoSeq"
$mse add command -label "Features Summary" -command "FeatureSummary"
$mse add command -label "Features Editor" -command "ChangeMode feateditor"
$mse add command -label "Sequence VRP" -command "Ordali_Vrp"
$mse add separator
$mse add checkbutton -label "Show/Hide Phylum" -variable Defauts(AffPhy) -command "ColorieNomsSelonPhylum"
......@@ -7792,8 +7841,6 @@ proc AfficheBarreMenus {} {
$mal add command -label "Overview" -command "AfficheOverview"
$mal add command -label "Conservation" -command "ChangeMode conservation" -accelerator "Shift C"
$mal add command -label "Tree Mode" -command "ChangeMode arbres" -accelerator "Shift T"
$mal add command -label "Features Summary" -command "FeatureSummary"
$mal add command -label "Features Editor" -command "ChangeMode feateditor"
$mal add command -label "Annotate snapshot" -command "ChangeMode annotation"
$mal add command -label "Barcode" -command BarcodeAlignment
$mal add separator
......@@ -7961,6 +8008,7 @@ proc FinDemandeTitre {quoi w} {
}
destroy $w
update idletasks
return
}
......@@ -7970,6 +8018,11 @@ proc DemandeTitreEtDescDuMac {} {
global TiDe
set w .tide
if {[winfo exists $w]} {
raise $w
return
}
toplevel $w
wm protocol $w WM_DELETE_WINDOW KillParLaCroix
wm resizable $w 0 0
......
proc AligntSeulContreTous {nm seq} {
global OrdTmpDir
......@@ -29,7 +32,6 @@ proc AligntSeulContreTous {nm seq} {
}
proc CalculeAligntContreGlobal {seqref seqatester mol} {
global Sequences
......@@ -76,7 +78,6 @@ proc CalculeAligntContreGlobal {seqref seqatester mol} {
}
proc CalculeAlignt {seqatester seqref chn mol} {
global Sequences
......
......@@ -481,6 +481,10 @@ proc AfficheBoutonsPCI {} {
set pl2Lbl "length 2 :"
frame $wp.fse
label $wp.fse.ls1 \
-text "Seq. 1" \
-anchor w \
-justify left
ttk::combobox $wp.fse.sq1 \
-background white \
-width $LMx -height 10 \
......@@ -489,6 +493,10 @@ proc AfficheBoutonsPCI {} {
-textvariable nsq1
$wp.fse.sq1 current 0
bind $wp.fse.sq1 <<ComboboxSelected>> {CherchePCI %W}
label $wp.fse.ls2 \
-text "Seq. 2" \
-anchor w \
-justify left
ttk::combobox $wp.fse.sq2 \
-background white \
-width $LMx -height 10 \
......@@ -509,11 +517,13 @@ proc AfficheBoutonsPCI {} {
-textvariable pl2Lbl \
-justify left \
-anchor w
grid $wp.fse.sq1 -row 0 -column 0 -sticky ew
grid $wp.fse.sq2 -row 1 -column 0 -sticky ew
grid $wp.fse.lpci -row 0 -column 1 -padx 5 -sticky ew
grid $wp.fse.lpl1 -row 1 -column 1 -padx 5 -sticky ew
grid $wp.fse.lpl2 -row 2 -column 1 -padx 5 -sticky ew
grid $wp.fse.ls1 -row 0 -column 0 -sticky e -padx 5
grid $wp.fse.sq1 -row 0 -column 1 -sticky ew
grid $wp.fse.ls2 -row 1 -column 0 -sticky e -padx 5
grid $wp.fse.sq2 -row 1 -column 1 -sticky ew
grid $wp.fse.lpci -row 0 -column 2 -padx 5 -sticky ew
grid $wp.fse.lpl1 -row 1 -column 2 -padx 5 -sticky ew
grid $wp.fse.lpl2 -row 2 -column 2 -padx 5 -sticky ew
grid $wp.fse -row 0 -column 2 -sticky nw -padx 5 -pady 5
......@@ -1271,7 +1281,9 @@ proc AfficheBoutonsClusters {} {
-background yellow \
-command [list NouveauClustering nogroups]
grid $ws.fc.ori -row 0 -column 0 -sticky we -padx 5
if {[TypeAli] in {XML ORD}} {
grid $ws.fc.ori -row 0 -column 0 -sticky we -padx 5
}
grid $ws.fc.noc -row 1 -column 0 -sticky ns -padx 5
# Dismiss/New/Overwrite
......
......@@ -54,6 +54,7 @@ proc BonNomPDB {acc} {
} else {
set Ch ""
}
set Id [string toupper $Id]
set nom "PDB_${Id}_$Ch"
......@@ -62,8 +63,8 @@ proc BonNomPDB {acc} {
proc DonneIdDeAccessPDB {id} {
if {[string range [string toupper $id] 0 3] eq "PDB_"} {
set id [string toupper $id]
if {[string range $id 0 3] eq "PDB_"} {
return [string range $id 4 7]
} else {
return [string range $id 0 3]
......
......@@ -2584,7 +2584,8 @@ proc LoadNouveauPDB {IdOrFile {pdbid ""} {init 0} {indb 1}} {
# Obsolete or superseeded
if {$cok != 1} {
lassign $cok what newid
set newid [string toupper $newid]
if {$what eq "superseeded"} {
set cmdId $newid
set newid "::$newid"
......
......@@ -5,11 +5,10 @@ if {! [info exists OrdaliDejaSource] || ! $OrdaliDejaSource} {
set OrdaliDejaSource 1
set OrdSrcDir [file join $OrdaliDir src]
set Lfiles [list ordali_StrucObj.tcl \
set Lfiles [list \
ordali_StrucObj.tcl \
ordali_admin.tcl \
ordali_affiche.tcl \
ordali_agents.tcl \
ordali_aligne.tcl \
ordali_arc2.tcl \
ordali_arcball.tcl \
ordali_barcode.tcl \
......@@ -20,18 +19,12 @@ if {! [info exists OrdaliDejaSource] || ! $OrdaliDejaSource} {
ordali_data.tcl \
ordali_db.tcl \
ordali_doc.tcl \
ordali_fballs.tcl \
ordali_features.tcl \
ordali_graphic3d.tcl \
ordali_image.tcl \
ordali_mail.tcl \
ordali_math.tcl \
ordali_misc.tcl \
ordali_misynpat.tcl \
ordali_mode.tcl \
ordali_montre.tcl \
ordali_ms2ph.tcl \
ordali_o.tcl \
ordali_ordali.tcl \
ordali_outils.tcl \
ordali_pdb.tcl \
......@@ -39,10 +32,7 @@ if {! [info exists OrdaliDejaSource] || ! $OrdaliDejaSource} {
ordali_print.tcl \
ordali_profile.tcl \
ordali_projet.tcl \
ordali_pymol.tcl \
ordali_rasmol.tcl \
ordali_residu.tcl \
ordali_saga.tcl \
ordali_secours.tcl \
ordali_selection.tcl \
ordali_seqlab.tcl \
......@@ -58,9 +48,7 @@ if {! [info exists OrdaliDejaSource] || ! $OrdaliDejaSource} {
ordali_tree.tcl \
ordali_v2.tcl \
ordali_visu3d.tcl \
ordali_vmd.tcl \
ordali_vrp.tcl \
ordali_wave.tcl \
ordali_web.tcl \
ordali_xml.tcl]
......@@ -135,3 +123,21 @@ if {! [info exists OrdaliDejaSource] || ! $OrdaliDejaSource} {
if {0} {
ordali_agents.tcl
ordali_aligne.tcl
ordali_fballs.tcl
ordali_mail.tcl
ordali_misynpat.tcl
ordali_montre.tcl
ordali_ms2ph.etcl
ordali_o.tcl
ordali_pymol.tcl
ordali_rasmol.tcl
ordali_saga.tcl
ordali_vmd.tcl
ordali_wave.tcl
}
......@@ -69,7 +69,7 @@ proc FaitSuperposition {{Init 0}} {
FaireAttendre "Please wait ...\nSuperposing structures ..."
# Met le referent en debut de liste
# put reference on top of list
set i [lsearch $StrucAVoir $molref]
set StrucAVoir [lreplace $StrucAVoir $i $i]
set StrucAVoir [linsert $StrucAVoir 0 $molref]
......@@ -233,7 +233,7 @@ proc AppliqueSuperposition {} {
foreach nmch [lrange $StrucAVoir 1 end] {
set elt [DonneIdDeAccessPDB $nmch]
set chn [DonneChainDeAccessPDB $nmch]
array set TM [$elt GiveVar Rot]
array set TT [$elt GiveVar Trans]
set M [M_T TM]
......@@ -242,9 +242,10 @@ proc AppliqueSuperposition {} {
lassign $T t1 t2 t3
set pdb $elt
$db eval {begin transaction}
set Lr [$db eval {select a.x,a.y,a.z,a.pk_atoms from atoms as a, chains as c, pdb as p where \
p.name=$pdb and \
set dbPDB "root[string toupper $elt]"
$dbPDB eval {begin transaction}
set Lr [$dbPDB eval {select a.x,a.y,a.z,a.pk_atoms from atoms as a, chains as c, pdb as p where \
p.name=$pdb and \
c.pk_pdb=p.pk_pdb and \
c.name=$chn and \
a.pk_chains=c.pk_chains}]
......@@ -253,10 +254,10 @@ proc AppliqueSuperposition {} {
set nx [VMT $x $y $z $aM $t1]
set ny [VMT $x $y $z $bM $t2]
set nz [VMT $x $y $z $cM $t3]
$db eval {update atoms set x=$nx, y=$ny, z=$nz where pk_atoms=$ix}
$dbPDB eval {update atoms set x=$nx, y=$ny, z=$nz where pk_atoms=$ix}
}
$db eval {commit}
$dbPDB eval {commit}
$elt _Dimensions
$elt ResetDrawing
......
......@@ -797,10 +797,15 @@ proc PointerMode {AId} {
proc AppliqueZoom {AId val x y} {
global Abr
if {$val eq "zplus"} {set val 0.1} {set val -0.1}
set Abr($AId,ScaleR) [expr {$val+[set Abr($AId,ScaleR)]}]
if {[set Abr($AId,ScaleR)] < 0.1} {set Abr($AId,ScaleR) 0.1}
if {$val eq "zplus"} {
set Abr($AId,ScaleR) [expr {[set Abr($AId,incrScaleR)] + [set Abr($AId,ScaleR)]}]
} else {
set Abr($AId,ScaleR) [expr {[set Abr($AId,incrScaleR)] - [set Abr($AId,ScaleR)]}]
}
if {[set Abr($AId,ScaleR)] < $Abr($AId,incrScaleR)} {
set Abr($AId,ScaleR) $Abr($AId,incrScaleR)
}
OnReDessineArbre $AId
return
......@@ -814,6 +819,7 @@ proc ZoomMode {AId quoi} {
ChangeCurseur $AId $quoi
set PAD [set Abr($AId,PAD)]
bind $PAD <Button-1> [list AppliqueZoom $AId $quoi %x %y]
bind $PAD <B1-Motion> {}
......@@ -1870,7 +1876,6 @@ proc MontreBootstrap {AId} {
set res ""
catch {set res [info level -1]}
puts "montreboot [set Abr($AId,BootShow)] [set Abr($AId,BootDone)]"
# no bootstrap, do nothing
if {! [set Abr($AId,BootDone)]} {
......@@ -2428,20 +2433,16 @@ proc ReDessineArbre {AId args} {
if {$dy < [set Abr($AId,PADHgt)]} {set dy [set Abr($AId,PADHgt)]}
$PAD configure -scrollregion [list 0 0 $dx $dy]
puts "bootshow in [set Abr($AId,BootShow)]"
if {[set Abr($AId,BootDone)]} {
AfficheBootstrap $AId root
MontreBootstrap $AId
}
#puts "bootshow out [set Abr($AId,BootShow)]"
if {[TypeAli] in {"XML" "ORD"}} {
PeintParPhylum $AId
}
#puts "bootshow out [set Abr($AId,BootShow)]"
PeintParClusters $AId
#puts "bootshow out [set Abr($AId,BootShow)]"
return
}
......@@ -2484,6 +2485,29 @@ proc AjusteScrollRegion AId {
}
proc RecentreArbre {AId} {
global Abr
set PAD [set Abr($AId,PAD)]
set Offset 20
lassign [$PAD bbox all] x1 y1 x2 y2
$PAD move all [expr {-1*$x1 + $Offset}] [expr {-1*$y1 + $Offset}]
lassign [$PAD bbox all] x1 y1 x2 y2
set xm [expr {($x2-$x1) + 2*$Offset}]
set ym [expr {($y2-$y1) + 2*$Offset}]
$PAD configure -scrollregion [list 0 0 $xm $ym] -width $xm -height $ym
set x [expr {int($xm/2)}]
set y [expr {int($ym/2)}]
$PAD xview scroll $x units
$PAD yview scroll $y units
return
}
proc ReAjusteCoordonnees AId {
global Abr
......@@ -2548,7 +2572,7 @@ proc AjusteCoordonneesInit {AId} {
set LongNom [PlusLongNomAff $AId]
if {! [info exists Abr($AId,DMult)]} {
# set mult [expr {($Wdt-2*$LongNom)/[set Abr($AId,Dmax)]}]
# set mult [expr {($Wdt-2*$LongNom)/[set Abr($AId,Dmax)]}]
set mult [expr {($Wdt-2*$LongNom)/[set Abr($AId,rmax)]}]
set Abr($AId,DMult) $mult
}
......@@ -2558,9 +2582,11 @@ proc AjusteCoordonneesInit {AId} {
set Xmax -99999999.
set Ymax -99999999.
set m [set Abr($AId,DMult)]
set m 1.0
puts "ajuste init m= $m"
foreach d [$t nodes] {
set x [expr {[$t get $d xcoord]*$m}]
set y [expr {[$t get $d ycoord]*$m}]
set x [expr {$m * [$t get $d xcoord]}]
set y [expr {$m * [$t get $d ycoord]}]
$t set $d xdes $x
$t set $d ydes $y
......@@ -2736,31 +2762,50 @@ proc AjusteXYCart {AId n mx my {mult 1.}} {
proc ReDessineArbreCart {AId args} {
global Abr
global Abr Xmin Xmax Ymin Ymax
set PAD [set Abr($AId,PAD)]
$PAD delete all
#lulu
# from angular coordinates to (x,y)
set ::iter 0
if {$Abr($AId,firstTimeZoom)} {
set Abr($AId,firstTimeZoom) 0
TransformationCartesienne $AId root
set dx [expr {$Xmax - $Xmin}]
set dy [expr {$Ymax - $Ymin}]
set scaX [expr {[$PAD cget -width]/$dx}]
set scaY [expr {[$PAD cget -height]/$dy}]
if {$scaX > $scaY} {
set Abr($AId,ScaleR) $scaY
set Abr($AId,incrScaleR) [expr {0.2 * $scaY}]
} else {
set Abr($AId,ScaleR) $scaX
set Abr($AId,incrScaleR) [expr {0.2 * $scaX}]
}
}
TransformationCartesienne $AId root
AjusteCoordonneesInit $AId
ScaleArbre $AId $args
#AjusteCoordonneesInit $AId
#ScaleArbre $AId $args
RetraceToutCart $AId root
ReAjusteCoordonnees $AId
#ScaleArbre2 $AId $args
#ReAjusteCoordonnees $AId
RecentreArbre $AId
# $PAD delete all
# RetraceToutCart $AId root
puts "bootshow in [set Abr($AId,BootShow)]"
if {[set Abr($AId,BootDone)]} {
#AfficheBootstrap $AId root
MontreBootstrap $AId
}
puts "bootshow out [set Abr($AId,BootShow)]"
if {[TypeAli] in {"XML" "ORD"}} {
PeintParPhylum $AId
}
puts "bootshow out [set Abr($AId,BootShow)]"
PeintParClusters $AId
return
......@@ -3245,11 +3290,19 @@ proc TransformationCartesienne {AId n} {
set theta [$t get $n theta]
set r [$t get $n r]
set scale $Abr($AId,ScaleR)
set x [expr {$scale * $r * cos($theta)}]
set y [expr {$scale * $r * sin($theta)}]
if {[info exists ::iter] && $::iter < 5} {
puts "x= $x y= $y"
incr ::iter
}
set x [expr {$r*cos($theta)}]
set y [expr {$r*sin($theta)}]
$t set $n xcoord $x
$t set $n ycoord $y
$t set $n xdes $x
$t set $n ydes $y
set Xmin [expr {$Xmin<$x?$Xmin:$x}]
set Ymin [expr {$Ymin<$y?$Ymin:$y}]
......@@ -3460,7 +3513,9 @@ proc InitialiseUnArbre {tree} {
set Abr($AId,FontWght) [set Defauts(FontWghtTree)]
set Abr($AId,NfoisX) 1.
set Abr($AId,NfoisY) 1.2
set Abr($AId,ScaleR) 1.
set Abr($AId,ScaleR) 1.0
set Abr($AId,incrScaleR) 0.5
set Abr($AId,firstTimeZoom) 1
set Abr($AId,Rotate) 0.
set Abr($AId,OffsetX) 5
set Abr($AId,OffsetY) [expr {int([set Abr($AId,NfoisY)]*[lindex [font metrics "TreeFont$AId"] 5])}]
......@@ -3564,7 +3619,6 @@ proc DecortiqueUnArbre {TextePH} {
set t [string map {"\n" ""} $TextePH]
regsub -all {\)I?[0-9\.]+(:|;)} $t "):" t
set t [string map {"\(" "\[CreeArbre " "," " , " ":" " " "\)" "\]"} $t]
#puts "tree = $t"
eval set ArbreOri [string trim $t]
lset ArbreOri 0 root
set TArbre "Tree-Root$AId"
......@@ -3573,9 +3627,6 @@ proc DecortiqueUnArbre {TextePH} {
foreach {k i p} $ArbreOri {
lappend Lk $k
}
puts "Lk [llength $Lk] [llength [lsort -unique $Lk]]"
puts "Lk [lrange $Lk 0 5]"
puts [lsearch -exact $Lk "Tree-1"]
$TArbre deserialize $ArbreOri
......@@ -3620,7 +3671,6 @@ proc RetraceTout {AId n {init 0}} {
set y [$t get $n yO]
set x [SurGrille $x]
set y [SurGrille $y]
# puts [format "Nd xO=%5d yO=%5d %s" $x $y $n]
$PAD create oval [expr {$x-5}] [expr {$y-5}] [expr {$x+5}] [expr {$y+5}] \
-fill red -outline red
......@@ -3629,7 +3679,6 @@ proc RetraceTout {AId n {init 0}} {
set yf [$t get $n yE]
set xf [SurGrille $xf]
set yf [SurGrille $yf]
# puts [format " xE=%5d yE=%5d %s" $xf $yf $n]
DessineLigneCirculaire $AId $n $x $y $xf $yf
set id [$PAD create oval [expr {$xf-5}] [expr {$yf-5}] [expr {$xf+5}] [expr {$yf+5}] \
......@@ -3676,6 +3725,7 @@ proc RetraceToutCart {AId n} {
$PAD create line $x $y $xe $ye \
-width 1 \
-tags [list "DItem" "line-$n"]
RetraceToutCart $AId $e
}
......@@ -3683,35 +3733,80 @@ proc RetraceToutCart {AId n} {
}
proc ScaleArbre2 {AId args} {
global Abr
if {$args != ""} {
lassign [lindex $args 0] xc yc
} else {
set xc ""
}
set t [set Abr(Arbre,$AId)]
set sca [set Abr($AId,ScaleR)]
puts "ScaleA $sca"
set PAD [set Abr($AId,PAD)]
if {$xc eq ""} {
set xc 0. ; set yc 0.
set Le [$t nodes]
foreach e $Le {
#set xc [expr {$xc + [$t get $e xcoord]}]
#set yc [expr {$yc + [$t get $e ycoord]}]
set xc [expr {$xc + [$t get $e xdes]}]
set yc [expr {$yc + [$t get $e ydes]}]
}
puts [format "%d | xc %10.6f yc %10.6f" [llength $Le] $xc $yc]
set xc [expr {round($xc / [llength $Le])}]
set yc [expr {round($yc / [llength $Le])}]
}
$PAD scale all $xc $yc $sca $sca
return
}
proc ScaleArbre {AId args} {
global Abr
if {$args != ""} {lassign [lindex $args 0] xc yc} {set xc ""}
if {$args != ""} {
lassign [lindex $args 0] xc yc
} else {
set xc ""
}
set t [set Abr(Arbre,$AId)]
set m [set Abr($AId,ScaleR)]
set sca [set Abr($AId,ScaleR)]
puts "ScaleA $sca"
set PAD [set Abr($AId,PAD)]
if {$xc eq ""} {
set Le [$t children root]
set Le [$t children -all root]
set xc 0. ; set yc 0.
foreach e $Le {
set xc [expr {$xc + [$t get $e xcoord]}]
set yc [expr {$yc + [$t get $e ycoord]}]
#set xc [expr {$xc + [$t get $e xcoord]}]
#set yc [expr {$yc + [$t get $e ycoord]}]
set xc [expr {$xc + [$t get $e xdes]}]
set yc [expr {$yc + [$t get $e ydes]}]
}
set xc [expr {$xc / [llength $Le]}]
set yc [expr {$yc / [llength $Le]}]
}
#$PAD scale all $xc $yc $sca $sca
#return
foreach e [$t nodes] {
set x [$t get $e xdes]
set y [$t get $e ydes]
set x [expr {$m*($x-$xc)+$xc}]
set y [expr {$m*($y-$yc)+$yc}]
set x [expr {$sca * ($x-$xc) + $xc}]
set y [expr {$sca * ($y-$yc) + $yc}]
$t set $e xdes $x
$t set $e ydes $y
}
return
}
......@@ -4816,7 +4911,7 @@ proc CreeArbre {{a ""} {b ""} {s ""} {c ""} {d ""} args} {
set Id [ReunitBranches $Idg $Idd]
while {[llength $args]} {
puts "args : >>$args<<"
#puts "args : >>$args<<"
# elt 0 est ' , ' ...
set a [lindex $args 1]
set b [lindex $args 2]
......@@ -5273,4 +5368,16 @@ proc tbc {} {
}
proc tclau {} {
ChangeMode arbres
update idletasks
SelectionneToutesColonnes
CalculeUnArbre
return
}
......@@ -682,26 +682,29 @@ proc FenetreVrp {} {
set c $w.vrp.c
set Vrp(WCanvas) $c
scrollbar $w.vrp.vscroll \
-command "$c yview" -width 8
-command "$c yview " \
-width 8
scrollbar $w.vrp.hscroll \
-orient horiz -command "$c xview" -width 8
-orient horiz \
-command "$c xview " \
-width 8
canvas $c \
-scrollregion [list 0 0 $Vrp(Width) $Vrp(Height)] \
-width $Vrp(Width) -height $Vrp(Height) \
-cursor hand2 \
-background white \
-xscrollcommand "$w.vrp.hscroll set" \
-yscrollcommand "$w.vrp.vscroll set"
-scrollregion [list 0 0 $Vrp(Width) $Vrp(Height)] \
-width $Vrp(Width) \
-height $Vrp(Height) \
-cursor hand2 \
-background white \
-xscrollcommand "$w.vrp.hscroll set " \
-yscrollcommand "$w.vrp.vscroll set "
grid $w.vrp.c -row 0 -column 0 -sticky news
grid $w.vrp.vscroll -row 0 -column 1 -sticky ns
grid $w.vrp.hscroll -row 1 -column 0 -sticky ew
grid $w.vrp -row 0 -column 0 -sticky news -padx 5 -pady 5
grid rowconfig $w.vrp 0 -weight 1 -minsize 0
grid columnconfig $w.vrp 0 -weight 0 -minsize 0
grid columnconfig $w.vrp 0 -weight 1 -minsize 0
grid columnconfig $w.vrp 1 -weight 0 -minsize 0
# Frame de controle
set w $w.bot
frame $w
......@@ -710,46 +713,46 @@ proc FenetreVrp {} {
frame $t
set Vrp(WText) $t.txt
text $t.txt \
-xscrollcommand "txtScroll $t" \
-setgrid true \
-height 1 -wrap none \
-background white
-xscrollcommand "txtScroll $t" \
-setgrid true \
-height 1 -wrap none \
-background white
# show residue number begin end