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

biotext ok, bugs fixes

parent fd81f56c
...@@ -111,7 +111,7 @@ bind Biotext <Shift-BackSpace> { ...@@ -111,7 +111,7 @@ bind Biotext <Shift-BackSpace> {
proc ::tk::biotext::cursor {w x y} { proc ::tk::biotext::cursor {w x y} {
lassign [split [$w cursor] .] r c lassign [split [$w cursor] .] r c
set n [::tk::biotext::bufferNTimes "empty"] set n [::tk::biotext::bufferNTimes "empty"]
$w see [incr r [expr {$y*$n}]].[incr c [expr {$x*$n}]] $w see [expr {$r + $y*$n}].[expr {$c + $x*$n}]
update idletasks update idletasks
return return
......
#!/usr/local/bin/wish #!/usr/local/bin/wish
set OrdaliDir /home/moumou/ordali package require platform
source /home/ripp/gscope/gscope_outils.tcl switch [::platform::generic] {
source /home/moumou/ordali/src/ordali_source.tcl "macosx-x86_64" {
load /home/moumou/ordali/Extensions/biotext0.1/test/libbiotext0.1.so set OrdaliDir /Users/Luc/moumou/ordali
source /home/moumou/ordali/Extensions/biotext0.1/biotext.tcl set lib libbiotext0.1.dylib
}
"linux-x86_64" {
set OrdaliDir /home/moumou/ordali
set lib "libbiotext0.1.so"
}
"win32-x86_64" {
set OrdaliDir o:/ordali/
set lib "biotext01.dll"
}
}
puts "OrdaliDir $OrdaliDir"
source [file join $OrdaliDir src LesProcsDeGscope.tcl]
source [file join $OrdaliDir src ordali_source.tcl]
load [file join [pwd] test $lib]
source [file join $OrdaliDir Extensions biotext0.1 biotext.tcl]
proc TailleFonte {incr} { proc TailleFonte {incr} {
puts "\nTAILLE-FONT" ; flush stdout puts "\nTAILLE-FONT $incr\n" ; flush stdout
set size [font configure SeqFont -size] set size [font configure SeqFont -size]
incr size $incr incr size $incr
# keep font sizes sane... # keep font sizes sane...
if {$size >= 6 && $size <= 32} { if {$size < 6} {
font configure SeqFont -size $size set size 6
}
if {$size > 32} {
set size 32
} }
update idletasks
font configure SeqFont -size $size
update idletasks
return return
} }
proc CoupleY {args} { proc CoupleYExa {args} {
.f.b yview {*}$args .f.b yview {*}$args
.f.t yview {*}$args .f.t yview {*}$args
...@@ -107,7 +128,7 @@ A white darkviolet ...@@ -107,7 +128,7 @@ A white darkviolet
U white darkviolet U white darkviolet
C white darkviolet C white darkviolet
X black dimgrey X black dimgrey
. black dimgrey . black grey
0 black white 0 black white
1 black white 1 black white
2 black white 2 black white
...@@ -128,7 +149,7 @@ foreach l [split $Lignes \n] { ...@@ -128,7 +149,7 @@ foreach l [split $Lignes \n] {
} }
########################## ##########################
font create SeqFont -family "Courier" -size 8 font create SeqFont -family "Courier" -size 12
frame .f -background blue frame .f -background blue
grid .f -row 0 -column 0 -sticky news grid .f -row 0 -column 0 -sticky news
...@@ -152,6 +173,7 @@ biotext .f.b \ ...@@ -152,6 +173,7 @@ biotext .f.b \
-font SeqFont \ -font SeqFont \
-bd 0 \ -bd 0 \
-relief flat \ -relief flat \
-setgrid 1 \
-yscrollcommand ".f.sv set " \ -yscrollcommand ".f.sv set " \
-xscrollcommand ".f.sh set " \ -xscrollcommand ".f.sh set " \
-foreground black \ -foreground black \
...@@ -163,12 +185,13 @@ scrollbar .f.sh \ ...@@ -163,12 +185,13 @@ scrollbar .f.sh \
-command ".f.b xview " -command ".f.b xview "
scrollbar .f.sv \ scrollbar .f.sv \
-bg blue \ -bg blue \
-command "CoupleY " -command "CoupleYExa "
grid .f.t -row 0 -column 0 -sticky ns grid .f.t -row 0 -column 0 -sticky ns
grid .f.b -row 0 -column 1 -sticky news grid .f.b -row 0 -column 1 -sticky news
grid .f.sv -row 0 -column 2 -sticky ns grid .f.sv -row 0 -column 2 -sticky ns -padx 5
grid .f.sh -row 1 -column 1 -sticky ew -pady 5 grid .f.sh -row 1 -column 1 -sticky ew -pady 5
grid columnconfig .f 1 -weight 1 grid columnconfig .f 1 -weight 1
grid rowconfig .f 0 -weight 1 grid rowconfig .f 0 -weight 1
...@@ -176,6 +199,8 @@ grid rowconfig .f 0 -weight 1 ...@@ -176,6 +199,8 @@ grid rowconfig .f 0 -weight 1
if {[llength $argv] > 0} { if {[llength $argv] > 0} {
set tfa [lindex $argv end] set tfa [lindex $argv end]
puts "fasta : $tfa" puts "fasta : $tfa"
} else {
set tfa diaa.tfa
} }
LitLeTFA $tfa Ltmp Tseq LitLeTFA $tfa Ltmp Tseq
set Lseq [list] ; set Lnom [list] set Lseq [list] ; set Lnom [list]
...@@ -189,7 +214,7 @@ puts "[llength $Lnom] seqs [string length [lindex $Lseq 0]] aminoacids" ...@@ -189,7 +214,7 @@ puts "[llength $Lnom] seqs [string length [lindex $Lseq 0]] aminoacids"
.f.b sequences $Lseq .f.b sequences $Lseq
.f.b mapping $Lmapbw .f.b mapping $Lmap
.f.b map on .f.b map on
.f.b configure -state normal .f.b configure -state normal
...@@ -197,17 +222,25 @@ puts "[llength $Lnom] seqs [string length [lindex $Lseq 0]] aminoacids" ...@@ -197,17 +222,25 @@ puts "[llength $Lnom] seqs [string length [lindex $Lseq 0]] aminoacids"
.f.t insert end "[join $Lnom \n]" .f.t insert end "[join $Lnom \n]"
.f.t configure -state disabled .f.t configure -state disabled
bind . <Control-4> {.f.b xview scroll -10 units ; break} if {$::tcl_platform(platform) ne "unix"} {
bind . <Control-5> {.f.b xview scroll 10 units ; break} bind VScr <Control-MouseWheel> {+.f.b xview scroll [expr {-%D/120}] units ; break}
bind . <4> {CoupleY scroll -1 units ; break} bind VScr <MouseWheel> {CoupleYExa scroll [expr {-%D/120}] units ; break}
bind . <5> {CoupleY scroll 1 units ; break} } else {
bind VScr <Control-4> {+.f.b xview scroll -10 units ; break}
bind VScr <Control-5> {+.f.b xview scroll 10 units ; break}
bind VScr <4> {+CoupleYExa scroll -1 units ; break}
bind VScr <5> {+CoupleYExa scroll 1 units ; break}
}
bindtags .f.t [linsert [bindtags .f.t] 1 VScr]
bindtags .f.b [linsert [bindtags .f.b] 1 VScr]
puts "bindtags [bindtags .f.b]"
set Toggle(Scores) 0 set Toggle(Scores) 0
bind . <Control-KP_Add> [list TailleFonte +2] bind .f.b <Control-KP_Add> [list TailleFonte +2]
bind . <Control-plus> [list TailleFonte +2] bind .f.b <Control-plus> [list TailleFonte +2]
bind . <Control-equal> [list TailleFonte +2] bind .f.b <Control-equal> [list TailleFonte +2]
bind . <Control-minus> [list TailleFonte -2] bind .f.b <Control-minus> [list TailleFonte -2]
bind . <Control-KP_Subtract> [list TailleFonte -2] bind .f.b <Control-KP_Subtract> [list TailleFonte -2]
.f.t configure -state disabled .f.t configure -state disabled
puts "\nbiotext : [.f.b configure -font]" puts "\nbiotext : [.f.b configure -font]"
...@@ -216,4 +249,20 @@ puts "SeqFont : [font configure SeqFont -size]\n" ...@@ -216,4 +249,20 @@ puts "SeqFont : [font configure SeqFont -size]\n"
foreach cf {pady spacing1} { foreach cf {pady spacing1} {
puts "$cf [.f.t cget -$cf]" puts "$cf [.f.t cget -$cf]"
} }
#exit
.f.b configure -state normal
puts "\nTags toto :"
.f.b tag configure toto -foreground yellow -background black
.f.b tag add toto 1.2 1.12
.f.b tag add toto 2.5 2.15
.f.b tag add toto 3.8 3.18
.f.b tag add toto 4.4 4.14
.f.b tag add toto 10.10 20.30
.f.b tag state 0
puts "Tags done ...\n"
OrdaliDir /home/moumou/ordali
font : <SeqFont> 15 7 15<
config : width -1 23 height -1 10
config : width -1 23 height -1 10
geom : width in -1 height in -1
geom : width out 161 height out 150
geom : nR 10 nC 23 bdi 0
fasta : diaa.tfa fasta : diaa.tfa
400 seqs 1200 aminoacids 402 seqs 6000 aminoacids
IJLMVRKFYWDBEZQPGHNSTAUCX.0123456789 font : <SeqFont> 15 7 15<
config : width 161 23 height 150 10
config : width 161 23 height 150 10
geom : width in -1 height in -1
geom : width out 161 height out 150
geom : nR 10 nC 23 bdi 0
bindtags .f.b VScr Biotext . all
font : FontSize bef 8 biotext : -font font Font {Courier 12} SeqFont
font : <Courier 12> 15 7 16< text : -font font Font TkFixedFont SeqFont
font : FontSize aft 15 SeqFont : 12
font : FontSize bef 15 pady 0
font : <SeqFont> 10 5 11< spacing1 0
font : FontSize aft 10 font : <SeqFont> 15 7 15<
config : width -1 60 height -1 20 config : width 161 23 height 150 10
config : width -1 60 height -1 20 config : width 161 23 height 150 10
geom : width in -1 height in -1 geom : width in -1 height in -1
geom : width out 304 height out 224 geom : width out 161 height out 150
geom : nR 20 nC 60 bdi 4 geom : nR 10 nC 23 bdi 0
event : width 304 304 height 224 224
geom : width in 304 height in 224 Tags toto :
geom : width out 304 height out 224 Tags done ...
geom : nR 20 nC 60 bdi 4
EVENT : width 161 161 height 150 150
font : FontSize bef 10 geom : width in 161 height in 150
font : <SeqFont> 10 5 11< geom : width out 161 height out 150
font : FontSize aft 10 geom : nR 10 nC 23 bdi 0
startXC 0finXC 60 wc 5
startYC 0 finYC 20 hc 11 font : <SeqFont> 15 7 15<
event : width 724 304 height 409 224
geom : width in 724 height in 409
geom : width out 724 height out 409
geom : nR 36 nC 144 bdi 4
font : FontSize bef 10
font : <SeqFont> 10 5 11<
font : FontSize aft 10
startXC 0finXC 144 wc 5
startYC 0 finYC 36 hc 11
startXC 0finXC 144 wc 5
startYC 0 finYC 36 hc 11
...@@ -248,13 +248,14 @@ proc CreeOrdalieStarpack {{plat ""}} { ...@@ -248,13 +248,14 @@ proc CreeOrdalieStarpack {{plat ""}} {
if {$plat eq ""} { if {$plat eq ""} {
package require platform package require platform
set plat [::platform::generic] set plat [::platform::generic]
cd [file join $::OrdaliDir Build $plat]
} }
# output runtime tclkit : # output runtime tclkit :
# may be different for CROSS - BUILDING # may be different for CROSS - BUILDING
set platout $plat set platout $plat
set plat [::platform::generic] set plat [::platform::generic]
file copy [file join .. TclKits sdx.kit] sdx.kit file copy -force [file join .. TclKits sdx.kit] sdx.kit
# copy tclkit for building # copy tclkit for building
set fkit [glob [file join .. TclKits "tclkit-${plat}*"]] set fkit [glob [file join .. TclKits "tclkit-${plat}*"]]
......
...@@ -223,13 +223,13 @@ proc FenetreAjoutePDB {} { ...@@ -223,13 +223,13 @@ proc FenetreAjoutePDB {} {
grid columnconfig $wf 1 -weight 1 grid columnconfig $wf 1 -weight 1
set WAP(File) "" set WAP(File) ""
label $wf.lbl -text "File : " \ label $wf.lbl -text "File : " \
-relief flat -relief flat
entry $wf.ent \ entry $wf.ent \
-background white \ -background white \
-textvariable WAP(File) -textvariable WAP(File)
button $wf.but -text "Browse" \ button $wf.but -text "Browse" \
-background cyan \ -background cyan \
-command "set WAP(File) \[DemandeEtOuvreFichier PDB\]" -command "set WAP(File) \[DemandeEtOuvreFichier PDB\]"
grid $wf.lbl -row 0 -column 0 -sticky w grid $wf.lbl -row 0 -column 0 -sticky w
grid $wf.ent -row 0 -column 1 -sticky ew grid $wf.ent -row 0 -column 1 -sticky ew
grid $wf.but -row 0 -column 2 -sticky ew grid $wf.but -row 0 -column 2 -sticky ew
...@@ -270,8 +270,8 @@ proc FenetreAjoutePDB {} { ...@@ -270,8 +270,8 @@ proc FenetreAjoutePDB {} {
frame $wb frame $wb
button $wb.dis \ button $wb.dis \
-text "Cancel" \ -text "Cancel" \
-background red \ -background red \
-command [list AjoutePDB dismiss] -command [list AjoutePDB dismiss]
button $wb.ok \ button $wb.ok \
-text " OK " \ -text " OK " \
-background green1 \ -background green1 \
...@@ -2846,6 +2846,10 @@ proc BtnDeLaFeature {f} { ...@@ -2846,6 +2846,10 @@ proc BtnDeLaFeature {f} {
proc LesBoutonsEnfonces {{quoi "features"}} { proc LesBoutonsEnfonces {{quoi "features"}} {
global FrmBtnFea global FrmBtnFea
if {! [winfo exists $FrmBtnFea]} {
return [list]
}
set Lb {} set Lb {}
foreach c [winfo children $FrmBtnFea] { foreach c [winfo children $FrmBtnFea] {
if {[EtatDuBouton $c]} { if {[EtatDuBouton $c]} {
...@@ -3334,11 +3338,11 @@ proc SummaryPCI {} { ...@@ -3334,11 +3338,11 @@ proc SummaryPCI {} {
grid $top.fgr -row 1 -column 0 -padx 5 -pady 5 grid $top.fgr -row 1 -column 0 -padx 5 -pady 5
button $top.bok \ button $top.bok \
-text " OK " \ -text " OK " \
-bg green1 \ -bg green1 \
-command [list destroy $top] -command [list destroy $top]
grid $top.bok -row 2 -column 0 -pady {15 5} grid $top.bok -row 2 -column 0 -pady {15 5}
FenetreAuCentre $top FenetreAuCentre $top
tkwait window $top tkwait window $top
...@@ -4489,7 +4493,7 @@ proc MontreLesStrSecDetaillees {} { ...@@ -4489,7 +4493,7 @@ proc MontreLesStrSecDetaillees {} {
grid $w.lesseq.fpos.vposs -row 0 -column 3 -padx 0 grid $w.lesseq.fpos.vposs -row 0 -column 3 -padx 0
text $w.lesseq.textnomseq \ text $w.lesseq.textnomseq \
-relief sunken \ -relief flat \
-bd 0 \ -bd 0 \
-cursor left_ptr \ -cursor left_ptr \
-font SeqFont \ -font SeqFont \
...@@ -4497,7 +4501,8 @@ proc MontreLesStrSecDetaillees {} { ...@@ -4497,7 +4501,8 @@ proc MontreLesStrSecDetaillees {} {
-wrap none \ -wrap none \
-width 15 \ -width 15 \
-foreground black \ -foreground black \
-background white -background white \
-setgrid 1
text $w.lesseq.regle \ text $w.lesseq.regle \
-bd 2 \ -bd 2 \
...@@ -6454,10 +6459,15 @@ proc MetAJourDessinOverview {Id w {f None} {etat 1}} { ...@@ -6454,10 +6459,15 @@ proc MetAJourDessinOverview {Id w {f None} {etat 1}} {
# Determine Overview ACTIVE # Determine Overview ACTIVE
set ni [list] set ni [list]
foreach i $Li { foreach i $Li {
if {[set Ovw(O$i,Mac)] != [MacCourant]} {continue} if {[set Ovw(O$i,Mac)] == [MacCourant]} {
lappend ni $i lappend ni $i
}
}
if {$ni == {}} {
return
} else {
set Li $ni
} }
if {$ni == {}} {return} {set Li $ni}
if {$f eq "automatic"} { if {$f eq "automatic"} {
DessineFeatureSurOverview $Li "" "None" $etat $DeBtn DessineFeatureSurOverview $Li "" "None" $etat $DeBtn
...@@ -8316,7 +8326,7 @@ proc AfficheFrameSequences {} { ...@@ -8316,7 +8326,7 @@ proc AfficheFrameSequences {} {
set FrmSequence "$w.lessequences" set FrmSequence "$w.lessequences"
frame $FrmSequence frame $FrmSequence
grid $FrmSequence -row 2 -column 0 -sticky news -padx 5 grid $FrmSequence -row 2 -column 0 -sticky news -padx 5
# #
# widgets to display names of sequences, and # widgets to display names of sequences, and
# sequences, with their scrollbars # sequences, with their scrollbars
...@@ -8340,8 +8350,8 @@ proc AfficheFrameSequences {} { ...@@ -8340,8 +8350,8 @@ proc AfficheFrameSequences {} {
} }
text $w.lessequences.textnomseq \ text $w.lessequences.textnomseq \
-relief sunken \ -relief flat \
-bd 2 \ -bd 0 \
-font SeqFont \ -font SeqFont \
-cursor left_ptr \ -cursor left_ptr \
-yscrollcommand [list .ordali.lessequences.scrolly set] \ -yscrollcommand [list .ordali.lessequences.scrolly set] \
...@@ -8349,36 +8359,39 @@ proc AfficheFrameSequences {} { ...@@ -8349,36 +8359,39 @@ proc AfficheFrameSequences {} {
-height $Defauts(seqHeight) \ -height $Defauts(seqHeight) \
-width $WdtNom \ -width $WdtNom \
-wrap none \ -wrap none \
-foreground white \ -foreground black \
-background black \ -background white \
-selectforeground black \ -selectforeground black \
-selectbackground white \ -selectbackground white \
-inactiveselectbackground white \ -inactiveselectbackground white \
-state disabled \ -state disabled \
-selectborderwidth 0 \ -selectborderwidth 0 \
-autoseparators 0 \ -autoseparators 0 \
-undo 1 \ -undo 0 \
-highlightthickness 0 -highlightthickness 0 \
-setgrid 1 \
-pady 0
# Sequences : biotext widget for seqlab , # Sequences : biotext widget for seqlab ,
# text widget otherwise # text widget otherwise
biotext $FrmSequence.biotextsequence \ biotext $FrmSequence.biotextsequence \
-font Seqfont \ -font SeqFont \
-yscrollcommand FromScrollYBiotext2Names \ -yscrollcommand FromScrollYBiotext2Names \
-xscrollcommand [list .ordali.lessequences.scrollxseq set] \ -xscrollcommand [list .ordali.lessequences.scrollxseq set] \
-height $Defauts(seqHeight) \ -height $Defauts(seqHeight) \
-width $Defauts(seqWidth) \ -width $Defauts(seqWidth) \
-relief sunken \ -relief flat \
-class Biotext \ -class Biotext \
-bd 0 -bd 0 \
-setgrid 1
text $w.lessequences.textsequence \ text $w.lessequences.textsequence \
-xscrollcommand [list .ordali.lessequences.scrollxseq set] \ -xscrollcommand [list .ordali.lessequences.scrollxseq set] \
-yscrollcommand [list .ordali.lessequences.scrolly set] \ -yscrollcommand [list .ordali.lessequences.scrolly set] \
-relief sunken \ -relief flat \
-height $Defauts(seqHeight) \ -height $Defauts(seqHeight) \
-width $Defauts(seqWidth) \ -width $Defauts(seqWidth) \
-bd 2 \ -bd 0 \
-cursor left_ptr \ -cursor left_ptr \
-font SeqFont \ -font SeqFont \
-wrap none \ -wrap none \
...@@ -8389,12 +8402,15 @@ proc AfficheFrameSequences {} { ...@@ -8389,12 +8402,15 @@ proc AfficheFrameSequences {} {
-insertbackground yellow \ -insertbackground yellow \
-selectborderwidth 0 \ -selectborderwidth 0 \
-autoseparators 0 \ -autoseparators 0 \
-undo 1 \ -undo 0 \
-highlightthickness 0 -highlightthickness 0 \
-pady 0 \
-setgrid 1
# position ruler # position ruler
text $w.lessequences.regle \ text $w.lessequences.regle \
-bd 0 \ -bd 0 \
-relief flat \
-state disabled \ -state disabled \
-font SeqFont \ -font SeqFont \
-cursor left_ptr \ -cursor left_ptr \
......
proc transpa {} {
LoadTkAndPackages
image create photo ori -file torus_180.png
set h [image height ori] ; set w [image width ori]
puts "w $w h $h"
set col {0 0 0}
for {set x 0} {$x < $w} {incr x} {
for {set y 0} {$y < $h} {incr y} {
if {[ori get $x $y] == $col} {
ori transparency set $x $y 1
}
}
}
ori write new.png
exit
}
proc mapuce {} { proc mapuce {} {
LoadTkAndPackages LoadTkAndPackages
...@@ -11870,6 +11896,19 @@ proc dfast {} { ...@@ -11870,6 +11896,19 @@ proc dfast {} {
proc aatest {} { proc aatest {} {
set Laa [split "ACDEFGHIKLMNPQRSTVWY" ""] set Laa [split "ACDEFGHIKLMNPQRSTVWY" ""]
set o [open diaa.tfa w] set o [open diaa.tfa w]
set length 1000
set seq1 "" ; set seq2 ""
set j 0 ; set k 0
while {$j < 6*$length} {
append seq1 "[lindex $Laa $k]."
append seq2 ".[lindex $Laa $k]"
incr j 2 ; incr k
if {$k == [llength $Laa]} {set k 0}
}
puts $o ">seqTest-1\n$seq1"
puts $o ">seqTest-2\n$seq2"
foreach a $Laa { foreach a $Laa {
foreach b $Laa { foreach b $Laa {
set nom "$a$b$a$b" set nom "$a$b$a$b"
...@@ -11883,5 +11922,223 @@ proc aatest {} { ...@@ -11883,5 +11922,223 @@ proc aatest {} {