Skip to content

GitLab

O
ordalie
Commit 9cff94aa authored by luc.moulinier's avatar luc.moulinier
Browse files
Options

biotext ok, bugs fixes

parent fd81f56c
Hide whitespace changes
Inline Side-by-side
Showing with 451 additions and 110 deletions
Extensions/biotext0.1/biotext.tcl
View file @ 9cff94aa
......@@ -111,7 +111,7 @@ bind Biotext <Shift-BackSpace> {
proc ::tk::biotext::cursor {w x y} {
lassign [split [$w cursor] .] r c
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
return
......
Extensions/biotext0.1/example.tcl
View file @ 9cff94aa
#!/usr/local/bin/wish
set OrdaliDir /home/moumou/ordali
source /home/ripp/gscope/gscope_outils.tcl
source /home/moumou/ordali/src/ordali_source.tcl
load /home/moumou/ordali/Extensions/biotext0.1/test/libbiotext0.1.so
source /home/moumou/ordali/Extensions/biotext0.1/biotext.tcl
package require platform
switch [::platform::generic] {
"macosx-x86_64" {
set OrdaliDir /Users/Luc/moumou/ordali
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} {
puts "\nTAILLE-FONT" ; flush stdout
puts "\nTAILLE-FONT $incr\n" ; flush stdout
set size [font configure SeqFont -size]
incr size $incr
# keep font sizes sane...
if {$size >= 6 && $size <= 32} {
font configure SeqFont -size $size
if {$size < 6} {
set size 6
}
if {$size > 32} {
set size 32
}
update idletasks
font configure SeqFont -size $size
update idletasks
return
}
proc CoupleY {args} {
proc CoupleYExa {args} {
.f.b yview {*}$args
.f.t yview {*}$args
......@@ -107,7 +128,7 @@ A white darkviolet
U white darkviolet
C white darkviolet
X black dimgrey
. black dimgrey
. black grey
0 black white
1 black white
2 black white
......@@ -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
grid .f -row 0 -column 0 -sticky news
......@@ -152,6 +173,7 @@ biotext .f.b \
-font SeqFont \
-bd 0 \
-relief flat \
-setgrid 1 \
-yscrollcommand ".f.sv set " \
-xscrollcommand ".f.sh set " \
-foreground black \
......@@ -163,12 +185,13 @@ scrollbar .f.sh \
-command ".f.b xview "
scrollbar .f.sv \
-bg blue \
-command "CoupleY "
-command "CoupleYExa "
grid .f.t -row 0 -column 0 -sticky ns
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 columnconfig .f 1 -weight 1
grid rowconfig .f 0 -weight 1
......@@ -176,6 +199,8 @@ grid rowconfig .f 0 -weight 1
if {[llength $argv] > 0} {
set tfa [lindex $argv end]
puts "fasta : $tfa"
} else {
set tfa diaa.tfa
}
LitLeTFA $tfa Ltmp Tseq
set Lseq [list] ; set Lnom [list]
......@@ -189,7 +214,7 @@ puts "[llength $Lnom] seqs [string length [lindex $Lseq 0]] aminoacids"
.f.b sequences $Lseq
.f.b mapping $Lmapbw
.f.b mapping $Lmap
.f.b map on
.f.b configure -state normal
......@@ -197,17 +222,25 @@ puts "[llength $Lnom] seqs [string length [lindex $Lseq 0]] aminoacids"
.f.t insert end "[join $Lnom \n]"
.f.t configure -state disabled
bind . <Control-4> {.f.b xview scroll -10 units ; break}
bind . <Control-5> {.f.b xview scroll 10 units ; break}
bind . <4> {CoupleY scroll -1 units ; break}
bind . <5> {CoupleY scroll 1 units ; break}
if {$::tcl_platform(platform) ne "unix"} {
bind VScr <Control-MouseWheel> {+.f.b xview scroll [expr {-%D/120}] units ; break}
bind VScr <MouseWheel> {CoupleYExa scroll [expr {-%D/120}] 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
bind . <Control-KP_Add> [list TailleFonte +2]
bind . <Control-plus> [list TailleFonte +2]
bind . <Control-equal> [list TailleFonte +2]
bind . <Control-minus> [list TailleFonte -2]
bind . <Control-KP_Subtract> [list TailleFonte -2]
bind .f.b <Control-KP_Add> [list TailleFonte +2]
bind .f.b <Control-plus> [list TailleFonte +2]
bind .f.b <Control-equal> [list TailleFonte +2]
bind .f.b <Control-minus> [list TailleFonte -2]
bind .f.b <Control-KP_Subtract> [list TailleFonte -2]
.f.t configure -state disabled
puts "\nbiotext : [.f.b configure -font]"
......@@ -216,4 +249,20 @@ puts "SeqFont : [font configure SeqFont -size]\n"
foreach cf {pady spacing1} {
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"
Extensions/biotext0.1/log
View file @ 9cff94aa
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
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
font : <Courier 12> 15 7 16<
font : FontSize aft 15
biotext : -font font Font {Courier 12} SeqFont
text : -font font Font TkFixedFont SeqFont
SeqFont : 12
font : FontSize bef 15
font : <SeqFont> 10 5 11<
font : FontSize aft 10
config : width -1 60 height -1 20
config : width -1 60 height -1 20
pady 0
spacing1 0
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 304 height out 224
geom : nR 20 nC 60 bdi 4
event : width 304 304 height 224 224
geom : width in 304 height in 224
geom : width out 304 height out 224
geom : nR 20 nC 60 bdi 4
font : FontSize bef 10
font : <SeqFont> 10 5 11<
font : FontSize aft 10
startXC 0finXC 60 wc 5
startYC 0 finYC 20 hc 11
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
geom : width out 161 height out 150
geom : nR 10 nC 23 bdi 0
Tags toto :
Tags done ...
EVENT : width 161 161 height 150 150
geom : width in 161 height in 150
geom : width out 161 height out 150
geom : nR 10 nC 23 bdi 0
font : <SeqFont> 15 7 15<
src/ordali_admin.tcl
View file @ 9cff94aa
......@@ -248,13 +248,14 @@ proc CreeOrdalieStarpack {{plat ""}} {
if {$plat eq ""} {
package require platform
set plat [::platform::generic]
cd [file join $::OrdaliDir Build $plat]
}
# output runtime tclkit :
# may be different for CROSS - BUILDING
set platout $plat
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
set fkit [glob [file join .. TclKits "tclkit-${plat}*"]]
......
src/ordali_affiche.tcl
View file @ 9cff94aa
......@@ -223,13 +223,13 @@ proc FenetreAjoutePDB {} {
grid columnconfig $wf 1 -weight 1
set WAP(File) ""
label $wf.lbl -text "File : " \
-relief flat
-relief flat
entry $wf.ent \
-background white \
-textvariable WAP(File)
-background white \
-textvariable WAP(File)
button $wf.but -text "Browse" \
-background cyan \
-command "set WAP(File) \[DemandeEtOuvreFichier PDB\]"
-background cyan \
-command "set WAP(File) \[DemandeEtOuvreFichier PDB\]"
grid $wf.lbl -row 0 -column 0 -sticky w
grid $wf.ent -row 0 -column 1 -sticky ew
grid $wf.but -row 0 -column 2 -sticky ew
......@@ -270,8 +270,8 @@ proc FenetreAjoutePDB {} {
frame $wb
button $wb.dis \
-text "Cancel" \
-background red \
-command [list AjoutePDB dismiss]
-background red \
-command [list AjoutePDB dismiss]
button $wb.ok \
-text " OK " \
-background green1 \
......@@ -2846,6 +2846,10 @@ proc BtnDeLaFeature {f} {
proc LesBoutonsEnfonces {{quoi "features"}} {
global FrmBtnFea
if {! [winfo exists $FrmBtnFea]} {
return [list]
}
set Lb {}
foreach c [winfo children $FrmBtnFea] {
if {[EtatDuBouton $c]} {
......@@ -3334,11 +3338,11 @@ proc SummaryPCI {} {
grid $top.fgr -row 1 -column 0 -padx 5 -pady 5
button $top.bok \
-text " OK " \
-bg green1 \
-command [list destroy $top]
-text " OK " \
-bg green1 \
-command [list destroy $top]
grid $top.bok -row 2 -column 0 -pady {15 5}
FenetreAuCentre $top
tkwait window $top
......@@ -4489,7 +4493,7 @@ proc MontreLesStrSecDetaillees {} {
grid $w.lesseq.fpos.vposs -row 0 -column 3 -padx 0
text $w.lesseq.textnomseq \
-relief sunken \
-relief flat \
-bd 0 \
-cursor left_ptr \
-font SeqFont \
......@@ -4497,7 +4501,8 @@ proc MontreLesStrSecDetaillees {} {
-wrap none \
-width 15 \
-foreground black \
-background white
-background white \
-setgrid 1
text $w.lesseq.regle \
-bd 2 \
......@@ -6454,10 +6459,15 @@ proc MetAJourDessinOverview {Id w {f None} {etat 1}} {
# Determine Overview ACTIVE
set ni [list]
foreach i $Li {
if {[set Ovw(O$i,Mac)] != [MacCourant]} {continue}
lappend ni $i
if {[set Ovw(O$i,Mac)] == [MacCourant]} {
lappend ni $i
}
}
if {$ni == {}} {
return
} else {
set Li $ni
}
if {$ni == {}} {return} {set Li $ni}
if {$f eq "automatic"} {
DessineFeatureSurOverview $Li "" "None" $etat $DeBtn
......@@ -8316,7 +8326,7 @@ proc AfficheFrameSequences {} {
set FrmSequence "$w.lessequences"
frame $FrmSequence
grid $FrmSequence -row 2 -column 0 -sticky news -padx 5
#
# widgets to display names of sequences, and
# sequences, with their scrollbars
......@@ -8340,8 +8350,8 @@ proc AfficheFrameSequences {} {
}
text $w.lessequences.textnomseq \
-relief sunken \
-bd 2 \
-relief flat \
-bd 0 \
-font SeqFont \
-cursor left_ptr \
-yscrollcommand [list .ordali.lessequences.scrolly set] \
......@@ -8349,36 +8359,39 @@ proc AfficheFrameSequences {} {
-height $Defauts(seqHeight) \
-width $WdtNom \
-wrap none \
-foreground white \
-background black \
-foreground black \
-background white \
-selectforeground black \
-selectbackground white \
-inactiveselectbackground white \
-state disabled \
-selectborderwidth 0 \
-autoseparators 0 \
-undo 1 \
-highlightthickness 0
-undo 0 \
-highlightthickness 0 \
-setgrid 1 \
-pady 0
# Sequences : biotext widget for seqlab ,
# text widget otherwise
biotext $FrmSequence.biotextsequence \
-font Seqfont \
-font SeqFont \
-yscrollcommand FromScrollYBiotext2Names \
-xscrollcommand [list .ordali.lessequences.scrollxseq set] \
-height $Defauts(seqHeight) \
-width $Defauts(seqWidth) \
-relief sunken \
-relief flat \
-class Biotext \
-bd 0
-bd 0 \
-setgrid 1
text $w.lessequences.textsequence \
-xscrollcommand [list .ordali.lessequences.scrollxseq set] \
-yscrollcommand [list .ordali.lessequences.scrolly set] \
-relief sunken \
-relief flat \
-height $Defauts(seqHeight) \
-width $Defauts(seqWidth) \
-bd 2 \
-bd 0 \
-cursor left_ptr \
-font SeqFont \
-wrap none \
......@@ -8389,12 +8402,15 @@ proc AfficheFrameSequences {} {
-insertbackground yellow \
-selectborderwidth 0 \
-autoseparators 0 \
-undo 1 \
-highlightthickness 0
-undo 0 \
-highlightthickness 0 \
-pady 0 \
-setgrid 1
# position ruler
text $w.lessequences.regle \
-bd 0 \
-relief flat \
-state disabled \
-font SeqFont \
-cursor left_ptr \
......
src/ordali_misc.tcl
View file @ 9cff94aa
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 {} {
LoadTkAndPackages
......@@ -11870,6 +11896,19 @@ proc dfast {} {
proc aatest {} {
set Laa [split "ACDEFGHIKLMNPQRSTVWY" ""]
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 b $Laa {
set nom "$a$b$a$b"
......@@ -11883,5 +11922,223 @@ proc aatest {} {
exit
}
proc InitGUILLO {} {
global GLLO COK Cnext Next Save LLO
LoadTkAndPackages
. configure -background black
grid columnconfig . 0 -weight 1
font create LFont -family Courier -size 38 -weight bold
set wdt [PlusLongEltDe $LLO(ListOf,Header)]
label .loutil \
-bg black -fg white \
-relief raised -bd 2 \
-font LFont -justify left -anchor w \
-textvariable GLLO(labOutil)
label .lkey \
-width $wdt \
-bg black -fg white \
-relief raised -bd 2 \
-font LFont -justify left -anchor w \
-textvariable GLLO(labKey)
entry .eval \
-bg black -fg white \
-relief groove -bd 2 \
-font LFont -justify left\
-textvariable GLLO(entVal)
frame .f \
-bg black
button .f.bok \
-text " OK " \
-fg white -bg "#770077" \
-font LFont \
-command {set ::COK 1 ; focus .eval}
button .f.bnx \
-text " Next " \
-fg white -bg "#555555" \
-font LFont \
-command {set COK 1 ; set Next 1 ; focus .eval}
button .f.bsv \
-text " Save " \
-fg white -bg "#007700" \
-font LFont \
-command {SaveTxl liste_tmp.csv ::LLO "," ; focus .eval}
grid .f.bok -row 0 -column 0 -sticky w
grid .f.bnx -row 0 -column 1 -padx 10
grid .f.bsv -row 0 -column 2 -sticky e
grid columnconfig .f all -weight 1
frame .f2 \
-background black
button .f2.bnw \
-text " New " \
-fg white -bg "#224488" \
-font LFont \
-command {NewItemLLO}
button .f2.bxt \
-text " Exit " \
-fg white -bg "#884422" \
-font LFont \
-command {SaveTxl liste_tmp.csv ::LLO ","; exit}
grid .f2.bnw -row 0 -column 0 -sticky w -padx 10
grid .f2.bxt -row 0 -column 1 -sticky e -padx 10
grid columnconfig .f2 all -weight 1
grid .loutil -row 0 -column 0 -pady {10 20} -sticky ew -padx 10
grid .lkey -row 1 -column 0 -sticky ew -padx 10
grid .eval -row 2 -column 0 -sticky ew -pady {10 20} -padx 10
grid .f -row 3 -column 0 -sticky ew -padx 10 -pady {20 5}
grid .f2 -row 4 -column 0 -sticky ew -padx 10 -pady {5 20}
focus .eval
bind all <Return> {.f.bok invoke ; focus .eval ; break}
FenetreAuCentre .
return
}
proc NewItemLLO {} {
global GLLO LLO
set Li [lsort -integer $LLO(ListOf,Index)]
set i [expr {[lindex $Li end] + 1}]
set ::COK 0 ; set ::Next 0
set GLLO(labOutil) "Nouvel Outil"
foreach h $LLO(ListOf,Header) {
set GLLO(labKey) $h
set GLLO(entVal) ""
vwait ::COK
if {$::Next} {
set ::Next 0
continue
}
set LLO($i,$h) $GLLO(entVal)
}
SaveTxl liste_tmp.csv LLO ","
lappend LLO(ListOf,Index) $i
return
}
proc SaveTxl {{file ""} aT {sep "\t"}} {
# aT doit venir de la proc : LoadTxl (gscope_atelier)
# et contient les cles : ListOf,Index et ListOf,Header
#
upvar $aT Tb
set Lout {}
set Lh $Tb(ListOf,Header)
set Ltmp {}
foreach h $Lh {
regsub -all "_" $h " " h
if {[string first " " $h] > -1} {
set h "\"$h\""
}
lappend Ltmp $h
}
lappend Lout [join $Ltmp $sep]
foreach i $Tb(ListOf,Index) {
set Ltmp {}
foreach key $Tb(ListOf,Header) {
regsub -all "_" $Tb($i,$key) " " val
if {[string first " " $val] > -1} {
# il y a des espaces,
set val "\"$val\""
}
lappend Ltmp $val
}
lappend Lout [join $Ltmp $sep]
}
if {$file eq ""} {
return $Lout
}
set o [open $file w]
puts $o [join $Lout \n]