Entrada sobre Tcl

Formularios en Tcl/Tk

Hay varias maneras de mostrar los datos de nuestro formulario Tcl/Tk. Una de ellas es crear una etiqueta para asignarle el valor del campo entry a su atributo -text, y todo ello lo hará un procedimiento que llamaremos «Enviar». Éste configura el valor -text de la etiqueta .etiqueta obteniendo el valor del contenido escrito en el elemento del formulario.

# Formulario
entry .campo -textvariable "Introduce texto aquí"
button .boton -text Enviar -command { Enviar }
pack .boton .campo

# Etiqueta vacía
label .etiqueta
pack .etiqueta

# Procedimiento
proc Enviar { } {
set texto [.campo get]
.etiqueta configure -text $texto
}

Tcl/Tk y el Wish

Para la mayoría de ejercicios de Tcl/Tk guardamos el código en achivos de texto con la extensión .tcl  en la misma carpeta donde tengo la aplicación. Desarrollando un proyecto guardo los archivos Tcl en una carpeta del mismo nombre que el proyecto, y  creamos «versiones». Por ejemplo, la carpeta formulario_de_prueba podría contener los archivos formulario1.tcl, formluario2.tcl…. 

Para ejecutar un script Tcl prefiero utilizar Wish y el comando source. Sobre todo porque me pongo «pistas» en el código, para probar que el flujo de información es correcto; hago que el ejercicio me devuelva resultados en consola con puts, una forma sencilla de hacer pequeñas comprobaciones. Para depurar los errores es mejor usarel comando catch. Algunas funciones tienen su propio «comportamiento» para manejar los errores (como las de MySQLTcl).

Menú en Tcl/Tk de SpectTcl

Los menús son widgets a menudo imprescindibles para nuestras aplicaciones Tcl. El menú que mostramos a continuación es una simplificación de otro menú, con muchos más elementos, disponible en la librería de ejemplos de SpecTcl: una aplicación hecha en Tcl/Tk para hacer aplicaciones de un modo «visual», proporcionándonos herramientas para generar archivos Tcl muy rápidamente y ahorrándonos la tarea de escribir todo el código de los widgets. Podemos consultar los atributos de un widget y modificarlos de forma sencilla, y ver los cambios sin necesidad de cerrar la aplicación, además de muchas otras cosas.

En otras anotaciones y ejemplos Tcl de este blog hemos usado el comando pack para «dibujar» los elementos en la pantalla. Nótese que en este ejemplo se usa el comando grid.

# Menú Tcl/Tk

# Contenedor del menú
set root "."

# Elemento 1
###############
menubutton .mbOption
-indicatoron 1
-menu ".mbOption.m"
-relief raised
-textvariable mbOption_choice

# Hijo de Elemento 1
menu .mbOption.m
-background green
-tearoff 0

catch {
.mbOption.m configure
-font -*-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*-*
}

# Hijos de Hijo de Elemento 1
.mbOption.m add radiobutton
-variable mbOption_choice
-label Artichoke
-underline 0

.mbOption.m add radiobutton
-variable mbOption_choice
-label {Brussel Sprout}
-underline 0

.mbOption.m add radiobutton
-variable mbOption_choice
-label Carrot
-underline 0

# Elemento 2
###############
menubutton .mbFruits
-menu ".mbFruits.fruitsMen"
-relief raised
-text Fruits

# Hijo de Elemento 2
menu .mbFruits.fruitsMen
-tearoff 0
catch {
.mbFruits.fruitsMen configure
-font -*-Helvetica-Bold-R-Normal-*-*-120-*-*-*-*-*-*
}

# Hijos de Hijo de Elemento 2
.mbFruits.fruitsMen add command
-command {puts Apple}
-label Apple
-underline 0

.mbFruits.fruitsMen add command
-command {puts Banana}
-label Banana
-underline 0

.mbFruits.fruitsMen add command
-command {puts Cucumber}
-label Cucumber
-underline 0

.mbFruits.fruitsMen add command
-command {puts Date}
-label Date
-underline 0

# Para representar el menu, geometry management
grid .mbOption -in $root -row 2 -column 1
grid .mbFruits -in $root -row 2 -column 2

# Comportamiento de la redimensión
grid rowconfigure $root 1 -weight 0 -minsize 30 -pad 0
grid rowconfigure $root 2 -weight 0 -minsize 30 -pad 0
grid columnconfigure $root 1 -weight 0 -minsize 30 -pad 0
grid columnconfigure $root 2 -weight 0 -minsize 30 -pad 0

# Opción seleccionada por defecto del Elemento 1
uplevel #0 set mbOption_choice Banana

Las listas en Tcl. Estructuras de datos.

Las listas son la estructura base de Tcl. Dos ejemplos de uso de listas a continuación, donde explicamos qué hace cada comando y comentamos en el código la respuesta de la consola.

Ejemplo 1: Creamos una lista con el comando list (hay más fomas de crear listas), que contiene 3 palabras. Mostramos su longitud con el comando llength. Mostramos el elemento de índice 1 de la lista con el comando lindex. Creamos una variable que contiene una palabra. Unimos esa variable a la lista como su último elemento, con el comando append, también devuelve la cadena modificada.

set Listauno [list "hola" "que" "tal"]
# devuelve hola que tal
llength $Listauno  
# devuelve 3
lindex $Listauno 1 
# devuelve que
set estas "estas"
 # devuelve estas
lappend Listauno $estas 
# devuelve hola que tal estas
llength $Listauno  
# devuelve 4

Ejemplo 2:Igual que el anterior, sólo que partimos de una lista vacía. Útil en algunos casos.

set Listados [list]
llength $Listados  
# devuelve 0
set algo "algo" 
# devuelve algo
lappend Listados $algo
 # devuelve algo
llength $Listados  
# devuelve 1
%

MySQLTcl: instalación e introducción

Instalación de MySQLTcl

Cómo instalar la aplicación MySQLTcl para poder manejar bases de datos con el lenguaje MySQL con nuestros scripts Tcl. Esta instalación es en Windows XP y XAMPP. Puede que sea necesario consultar: XAMPP, instalar un servidor local. Para saber más (o casi todo) sobre MySQL, MySQL con clase.

– Descargar MySQLTcly los archivos DLL (binarios) de la página del proyecto y descomprimir los archivo descargados en la carpeta /lib de la instalación de Tcl (si se instaló Tcl en C:/Tcl, los archivos deberán estar en C:/Tcl/lib). Todo lo necesario en la página del proyecto: http://www.xdobry.de/mysqltcl/

– Para comprobar que todo ha ido bien basta con abrir el Wish y teclear
package require mysqltcl
y nos devolverá la versión de MySQLTcl.

Introducción a MySQLTcl

Conexión

Aquí sólo les dejo el código necesario para conectarse a MySQLTcl, con alguna modificación por mi parte.

# paquete necesario
package require mysqltcl
# variable global de la conexión
global mysqlstatus
# valores de mysql
set port {3306}
set host {127.0.0.1}
set user {root}
set password {password}
set db {tcl_fact4}


# Capturamos el error (si lo hubiera) de la conexion mysql
# catch devuelte 1 si hay error en mysqlconnect
# En ese caso mostramos el comando que falló y el nº del error mysql


if [catch {mysqlconnect -host $host -port $port -user $user -password $password -db $db} mysql_handler] {
puts $mysqlstatus(command)
puts "error mysql nº"
puts $mysqlstatus(code)
}


# cerrar la conexion
mysqlclose $mysql_handler

Realizar consultas

En el enlace de más arriba también se explica cómo realizar consultas MySQL como select, update, insert… Algunos ejemplos de funciones básicas:

# hacer un select ordenado por el campo "id"
mysqlsel $mysql_handler {select campo1,campo2,...  from tabla order by id asc} -list
# insert
mysqlexec $mysql_handler {insert into tabla (campo1, campo2) values ('valor1','valor2')}
# delete
mysqlexec $mysql_handler {delete from empresas where id = 6}
# create table
set nuevatabla "CREATE TABLE nuevatabla (
ID INTEGER PRIMARY KEY,
type INT NOT NULL,
Nombre TEXT,)"
set creandonuevatabla [::mysql::exec $mysql_handler $nuevatabla]

Compilar script Tcl en un archivo .exe

Extracto y adaptación del texto titulado «How to compile a Tcl script and an icons directory into an exe (in Windows)» en el texto completo en inglés.

En el ejemplo, tenemos un archivo llamado Ejemplo.tcl con el código de nuestra aplicación y un icono mi_icono.ico situado en C:Ejemplo. No olvidar hacer las adaptaciones necesarias. Estas instrucciones funcionan en Windows.

Para este ejemplo se necesita descargar el programa freewrap.exe, y copiarlo en el directorio donde está el archivo Tcl, para tener dentro de la carpeta /Ejemplo los archivos Ejemplo.tcl, mi_icono.ico y freewrap.exe

En «Inicio/Ejecutar», escribe «cmd» y pulsa «Enter» para abrir la consola de comandos. Escribe lo siguiente:

cd Ejemplo
freewrap Ejemplo.tcl -i tu_icono.ico

Por si no tenemos icono, el fragmento -i tu_icono.ico es opcional. Los iconos deben tener las siguientes características:

– 16×16 16 colors
– 32×32 16 colors
– 32×32 2 colors

Elije la puerta correcta – Tcl y matemáticas

En un concurso de televisión se le ofrece al concursante la posibilidad de elegir una entre 3 puertas para quedarse lo que hay tras ella. El presentador le informa de que sólo una de ellas tiene un buen regalo (un apartamento en Torrevieja, un coche…), mientras que las otras dos están vacías. El concursante opta por una y el presentador (que conoce exactamente dónde está el regalo) abre lo que hay detrás de una de las otras dos puertas no elegidas por el concursante, donde no está el regalo. Luego le ofrece al concursante la opción de cambiar su decisión inicial eligiendo la otra puerta aún no abierta. ¿Qué debe hacer el concursante? Es decir, ¿debe cambiar de parecer sobre la puerta que eligió originalmente, o no?

El siguiente fragmento de código simula un concurso repetido 600 veces, donde se analiza qué pasaría sí el jugador cambiase o no de opinión.

# Ponemos unos contadores a cero
set sc 0
set nc 0
# Concursaremos i veces, en este ejemplo 600
for {set i 0} {$i < 600} {incr i} {
# Ponemos un premio detrás de una puerta, escogemos un numero entero aleatorio entre 0 y 2
set premio [expr [expr round([expr [expr rand()]*10])]%3]
# El jugador escoge su puerta, escogemos un numero entero aleatorio entre 0 y 2
set eleccion [expr [expr round([expr [expr rand()]*10])]%3]
# El presentador abre una de las otras dos puertas, donde no está el premio
# Si coincide la elección del jugador con el premio,
# aumentamos en 1 un contador inicial, y en ese caso no debería  cambiar de opinión.
# En caso contrario, aumentamos el 1 el otro contador.
if {$premio==$eleccion} {
set nc [expr $nc+1]
} else {
set sc [expr $sc+1]
}
set total [expr $sc+$nc]
}
# Porcentaje de aciertos cambiando y sin cambiar
set asc [expr [expr 100*$sc]/$total]
set anc [expr [expr $nc*100]/$total]
# Resultado
concat "La probabilidad de ganar cambiando de parecer es de aprox. un " $asc "%, y sin cambiar de parecer de un " $anc"%."

El siguiente código genera un procedimiento con dos argumentos: el número de puertas y el número de veces que se concursa. Sólo hay que hacer algunos cambios en el código anterior.

proc concurso {numeropuertas veces} {
# Ponemos unos contadores a cero
set sc 0
set nc 0
# Concursaremos i veces, establecidas como argumento del procedimiento
for {set i 0} {$i < $veces} {incr i} {
# Ponemos un premio detrás de una puerta
set premio [expr [expr round([expr [expr rand()]*10])]%$numeropuertas]
# El jugador escoge su puerta
set eleccion [expr [expr round([expr [expr rand()]*10])]%$numeropuertas]
# El presentador abre una de las otras puertas, donde no está el premio
# Si coincide la elección del jugador con el premio,
# aumentamos en 1 un contador inicial, y en ese caso no debería cambiar de opinión.
# En caso contrario, aumentamos el 1 el otro contador.
if {$premio==$eleccion} {
set nc [expr $nc+1]
} else {
set sc [expr $sc+1]
}
set total [expr $sc+$nc]
}
# Porcentaje de aciertos cambiando y sin cambiar
set asc [expr [expr 100*$sc]/$total]
set anc [expr [expr $nc*100]/$total]
# Resultado
concat La probabilidad de ganar cambiando de parecer es de aprox. un $asc%, y sin cambiar de parecer de un $anc% (con $numeropuertas puertas, repetido $veces veces).
}

Lo único que se necesita para resolver el problema es escribir un código similar al siguiente, después de crear el procedimiento:

concurso 3 100

Podemos jugar más veces para garantizar un resultado más «fiable», o incluso con más de tres puertas.