no display name and no $DISPLAY environment variable
    while executing
"load /enadisk/commun/linux/local/ActiveTcl-8.6.11/lib/libtk8.6.so Tk"
    ("package ifneeded Tk 8.6.11" script)
    invoked from within
"package require Tk"
    (in namespace eval "::request" script line 3)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)
OUTPUT BUFFER:
#!/usr/local/bin/wish

package require Tk

set LignesCoul ">seqlab
I white magenta
L white magenta
M white magenta
V white magenta
ILMV white magenta
R white blue
K white blue
RK white blue
F white red
Y white red
W white red
FYW white red
D white forestgreen
E white forestgreen
DE white forestgreen
Q white green
P white black
G black orange
H black cyan
N black cyan
HN white cyan
S white darkviolet
T white darkviolet
A white darkviolet
C white darkviolet
STAC white darkviolet
SPC white darkslategrey
"

###################################
# Configure tags for 20 amino acids
# + physicochemical groups
# almost taken from ordali
proc ConfTag {} {
    global CT wt LignesCoul

    foreach c [lrange [split $LignesCoul "\n"] 1 end] {
	foreach {n f b} $c {}
	set CT($n) [list $f $b]
    }

    return
}

#################
# Data generation
# 
# Junk data or read a TFA file given as argument
proc JunkData {} {
    global data Long Haut    

    set l "A.CC......P...PQ.G..I.KL.....D....N.F..."
    set rep [expr {int($Long/40)}]
    set dt [string repeat $l $rep]
    set data "$dt\n"
    for {set i 1} {$i < $Haut} {incr i} {
	set s [string range $dt $i end]
	append s "[string range $dt 0 [expr {$i-1}]]\n"
	append data $s
    }
#    set data "[string repeat $dt $Haut]"
    set Long [string length $dt]

    return $data
}

##############################
# Window and attached commands
#
# trash window test ... no grid , nothing ...

proc Remplissage {} {
    global TabC data wt

    set i 0
    set j 0
    set FonteMetrics  [font metrics "Courier 10"]
    set HauteurLettre [lindex $FonteMetrics 5]
    set LargeurLettre [font measure "Courier 10" "Z"]
    set ltot [expr $LargeurLettre*500]
    set htot [expr $HauteurLettre*500]
    $wt configure -scrollregion [list 0 0 $ltot $htot]

    set Lc [split $data ""]
    foreach c $Lc {
	if {$c eq "\n"} {
	    incr j $HauteurLettre
	    set i 0
	    continue
	}
	if {$c eq "."} {set tc SPC} {set tc $c}
	set TabC($i,$j) [$wt create text $i $j \
		-anchor n -justify center \
		-text $c -font "Courier 10 bold" \
		-tags Tag$tc ]
	incr i $LargeurLettre
    }
    update idletasks

    return
}

proc InitWindow {} {
    global Long Haut wt wx wy data

    set wt .f3.t
    set wx .f3.sx
    set wy .f3.sy

    frame .f3 
    canvas .f3.t -background "#303030303030" \
	    -yscrollcommand "$wy set" \
	    -xscrollcommand "$wx set" \
	    -height 250 -width 500
    scrollbar .f3.sy -command "$wt yview"
    scrollbar .f3.sx -command "$wt xview" -orient horizontal

    grid .f3.t .f3.sy -sticky ns
    grid .f3.sx -sticky we
    pack .f3 -side top

    Remplissage

    bind $wt <4> "$wt yview scroll -2 units"
    bind $wt <5> "$wt yview scroll  2 units"
    
    update idletasks

    return
}

proc TagAll {} {
    global wt CT

    foreach t [array names CT] {
	if {$t eq "SPC"} {continue}
	set Li [$wt find withtag "Tag$t"]
	if {$Li == {} } {continue}
	lassign [set CT($t)] f b
	foreach i $Li {
	    set bb [$wt bbox $i]
	    if {! [info exists vu($t)]} {
		set vu($t) 1
		puts "$t :: $bb"
	    }
	    lassign $bb x1 y1 x2 y2
	    set R [$wt create rectangle \
		    [expr {$x1+1}] $y1 [expr {$x2-2}] [expr {$y2-1}] \
		    -fill $b -outline $b]
	    $wt lower $R
	}
	$wt itemconfig Tag$t -fill $f
    }

    return
    set i 0
    foreach s [split $data "\n"] {
	incr i
	foreach freg $Lfreg g $Lgaa {
	    set lv [regexp -all -inline -indices -- $freg $s]
	    set lt {}
	    foreach e $lv {
		foreach {d f} $e {}
		lappend lt $i.$d $i.[expr {$f+1}]
	    }
	    if {$lt != {}} {eval [list $wt tag add Tag$g] $lt}
	}
    }
    update idletasks	
    
    return
}

proc DerouleX {} {
    global wt
    set f 0.0
    while {$f <= 1.0} {
	$wt xview moveto $f
	update idletasks
	set f [expr {$f+0.1}]
    }
    
    return
}

proc DerouleY {} {
    global wt
    set f 0.0
    while {$f < 1.0} {
	$wt yview moveto $f
	update idletasks
	set f [expr {$f+0.1}]
    }

    return
}

proc InitXY {q} {
    global wt
    
    $wt xview moveto 0.0
    $wt yview moveto 0.0
    update idletasks

    foreach {ymin xmin} [split [$wt index @0,0] .] {}
    foreach {ymax xmax} [split [$wt index @[winfo width $wt],[winfo height $wt]] .] {}
    if {$q eq "x"} {$wt xview moveto 0.1} {$wt yview moveto 0.1}
    update idletasks
    foreach {yscr xscr} [split [$wt index @[winfo width $wt],[winfo height $wt]] .] {}

    if {$q eq "x"} {
	set ydep $ymin
	set yfin $ymax
	set xdep $xmax
	set xfin $xscr
    } else {
	set ydep $ymax
	set yfin $yscr
	set xdep $xmin
	set xfin [expr {$xmax+1}]
    }
    puts "xdep=$xdep xfin=$xfin ydep=$ydep yfin=$yfin"
    set i $ydep
    set nt 0
    while {$i <= $yfin} {
	set lt [$wt dump -tag -text $i.$xdep $i.$xfin]
	foreach {k v x} $lt {
	    switch $k {
		"text" {
		    set n [expr {[string length $v] - [regsub -all {\.} $v "" tmp]}]
		    incr nt $n
		}
		"tagon" {
		    if {! [info exists tag($v)]} {set tag($v) 0}
		    incr tag($v)
		}
		"tagoff" {}
	    }
	}
	incr i
    }

    puts "$nt caracteres"
    puts "[llength [array names tag]] tags differents"
    set ttot 0
    foreach g [array names tag] {
	puts "\t[set tag($g)] pour $g"
	incr ttot [set tag($g)]
    }

    return
}


#################################

set Long 500
set Haut 500
set data [JunkData]

InitWindow
puts "Length $Long Height $Haut"
ConfTag 

puts "\n Tagging"
puts "[time {TagAll} ]"

puts "\n Stats"
puts "10% scroll X means"
#InitXY x
puts "10% scroll Y means"
#InitXY y

puts "\n X scroll"
$wt xview moveto 0.0
$wt yview moveto 0.0
update idletasks
puts "[time {DerouleX} ]"

puts "\n Y scroll"
$wt xview moveto 0.0
$wt yview moveto 0.0
update idletasks
puts "[time {DerouleY} ]"

#exit
########### la fin des haricots ##############