Tcl (Tool Command Language) è, in origine, uno strumento per controllare l'esecuzione di attività batch, su computer e nasce verso la fine del 1987 ad opera di John Ousterhout dell'Università della California a Berkeley.
Le variabili elementari non sono tipizzate,
la tipizzazione è insita nell'utilzzo, in particolare string introduce varie operazioni su stringhe di
caratteri ed expr su espressioni numeriche:
set string 33
puts "Ci sono [string length $string] caratteri
in \"$string\""
set x [expr $string / 11]
puts "$string / 11 e'
$x"
La cui esecuzione produce:
Ci sono 2 caratteri in
"33"
33 / 11 e' 3
Dall'esempio emerge il carattere di linguaggio a liste, racchiuse da [ e ], e la caratteristica funzionale principale cioè il meccanismo di sostituzione delle variabili: l'interprete di Tcl analizza il comando effettuando delle sostituzioni:
§ le variabili, se precedute da $, sono sostituite dal loro valore (ma \$ è usato per impedire la sostituzione e \ come ultimo carattere della linea, fa ignorare il ritorno a capo, di fatto agisce da segno di continuazione dell'istruzione),
§ quanto è racchiuso in parentesi quadre, in genere delle istruzioni, è valutato
Tcl ha due strutture di dati complesse, le già incontrate liste e gli array associativi. Le prime sono prolisse da utilizzare, i secondi hanno gli usuali vantaggi di queste strutture.
Le parentesi graffe, essendo anche dei delimitatori di blocco di istruzioni, inibiscono la sostituzione delle variabili, a meno che non siano già dentro una stringa delimitata (% è il prompt della shell wish di Tcl, # è il carattere di commento, è preceduto dal separatore di istruzioni " ;" :
% set Z " Condor " ;# Condor nella variabile Z% puts {$Z: }$Z:
% puts $Z
Condor
La sintassi non sempre è unitaria, per scorrere una matrice associativa occorre trattarla come un file: inizio della lettura, lettura, test di fine ed eventuale chiusura, a meno di non utilizzare la lista delle chiavi, molto elegante, ma consumatrice di risorse. Qui di seguito due frammenti con la scansione di una lista e di un array.
# stampa gli elementi della lista listobj
foreach itm $listobj {puts $flID "$itm"} # stampa gli elementi dell'array array_oby foreach itm [lsort [array names array_obj]] { # array names lista gli indici puts $flID "$itm $array_obj($itm)"}
Tcl è estensibile, ci sono estensioni che gli forniscono funzionalità Object Oriented (XOTcl, incr Tcl), ma forse la più diffusa estensione è Tk per gestire interfacce grafiche; Tk è portabile e disponibile in diversi ambienti (Ruby , Tkinter di Python ). Il programma che segue genera il grafico della Figura 2‑3 (Ruby)
# Tcl 8.3.2 Tk 8.3.2
#
# Tree.tcl
#
# Il programma lgge da file una lista con livello del nodo, progressivo e nome
# e genera il grafico delle dipendenze
# come parametri riceve il nome del file, il titolo del grafico e
# la disposizione (o per orizzontale, v (il default) per verticale)
proc CreaNodo {x y nome} { global nodoX nodoY ;# array con coordinate
global vert ;# orientamento (-1 = verticale)
.c create oval [expr $x-5] [expr $y-5] [expr $x+5] [expr $y+5] \
-outline magenta -fill magenta
set xlabel [expr $x - 40]
set ylabel [expr $y]
if {$vert < 0} {set xlabel [expr $x + 40]; set ylabel $y}
.c create text $xlabel $ylabel -text $nome -fill magenta -font fnt
# genero array con coordinate del nodo
set nodoX($nome) $x
set nodoY($nome) $y
}
proc CollegaNodi {daNodo aNodo} { # Crea collegamento fra nodi
global nodoX nodoY
set linea [.c create line $nodoX($daNodo) $nodoY($daNodo) \
$nodoX($aNodo) $nodoY($aNodo) -fill blue]
.c lower $linea ;# nasconde la linea sotto i nodi
}
set lArea 650
set hArea 650
canvas .c -width [expr $lArea + 50] -height [expr $hArea + 50] ;# finestra grafica
pack .c
set titolo [lindex $argv 1] ;# prelevo secondo elemento del vettore argv
set vert [string first [string range [lindex $argv 2] 0 0] "oO"] ;# verifico se o(rizzontale)
.c create text [expr $lArea/2] 25 -text $titolo -font 12 -fill red
font create fnt -size 10 -family Courier ;# creo font Courier 10
set NodoPrec 0
set passo 120 ;# profondità successive
set Margine 80
set largNodo "0 0 0 0 0 0 0" ;# lista ampiezza nodi
set lst_nodi {} ;# lista righe lette# lettura dati
set flid [open [lindex $argv 0] r]
while {[eof $flid] == 0} {gets $flid row;
if {[string length $row] > 0} {lappend lst_nodi $row }
}
close $flid
# prepara array con numero figli
set num_el [llength $lst_nodi]
for {set i 0} {$i < $num_el} {incr i} {set counter 0
set Level [string range [lindex $lst_nodi $i] 0 1];
for {set j [expr $i + 1]} {$j <= $num_el} {incr j} {
if {[string range [lindex $lst_nodi $j] 0 1] == $Level} break;
if {[string range [lindex $lst_nodi $j] 0 1] == [expr $Level + 1]} {incr counter}
}
set Nome [string range [lindex $lst_nodi $i] 6 [expr [string length [lindex $lst_nodi $i]]-1]]
if {$counter == 0} {set counter 2}
set array_fil($Nome) $counter
}
foreach row $lst_nodi {set Nodo [string range $row 0 1];
set subNodo [string range $row 3 4];
set Nome [string range $row 6 [expr [string length $row]-1]];
if {$Nodo == 0} {
if {$vert < 0} {
set px [expr - 10 + $lArea / 2]
set py $Margine
} else {
set py [expr $lArea / 2]
set px $Margine
}
CreaNodo $px $py $Nome;
set array_livelli(0) $Nome ;# array con i nomi di livello
set largNodo [lreplace $largNodo 0 0 $lArea]
} else {
if {$Nodo > $NodoPrec} {
set largNodo [lreplace $largNodo $Nodo $Nodo \
[expr [lindex $largNodo [expr $Nodo - 1]] /$array_fil($array_livelli([expr $Nodo - 1]))]]
}
set var [lindex $largNodo $Nodo]
if {$vert < 0} {
set px [expr $var * $subNodo - 1.5 * $var + \
[expr $nodoX($array_livelli([expr $Nodo - 1]))]];
set py [expr $Nodo * $passo + $Margine]
} else {
set py [expr $var * $subNodo - 1.5 * $var + \
[expr $nodoY($array_livelli([expr $Nodo - 1]))]];
set px [expr $Nodo * $passo + $Margine]
}
CreaNodo $px $py $Nome
CollegaNodi $Nome $array_livelli([expr $Nodo - 1]);
}
set array_livelli([expr $Nodo]) $Nome;
set NodoPrec $Nodo;
}
set flImg [lindex $argv 0]
.c postscript -file "$flImg.eps" -height [expr $hArea + 50] -width $lArea