biotext ok, bugs fixes

Extensions/biotext0.1/biotext.tcl

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

 #!/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

+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

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

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

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