"Parseo" de paginas html y el demo "oreilly-oscon2001"

El parseo de paginas web (de html puro) puede resultar muy util en muchos casos, el cambio de formato, el computo de datos, la creacion de graficas, etc, puede significar un ahorro de tiempo significativo.

En esta ocasion, quiero presentarles un demo que me parece de lo mas interesante, este viene instalado por defecto en la version de ActiveState llamada "baterias incluidas"

Para definir el punto de partida, veamos que version de Tcl tengo instalada en esta PC (con windows):

% info tclversion
8.4
% info patchlevel
8.4.20

Desde luego, eso tambien se puede saber desde que ves el prompt completo de la consola (lo cual quite' de la interaccion anterior por motivos de claridad):

(ActiveState ActiveTcl 8.4.20.0) 1 %

El demo "oreilly-oscon", se encuentra localizado en:
C:\Tcl\demos\Tcllib\oreilly-oscon2001
si es que instalaste Tcl/Tk en las opciones por defecto que te da el instalador.

En esa carpeta, se tienen los siguientes archivos:
oscon
osconwrap
README
sessions_friday.html
sessions_thursday.html
sessions_wednesday.html

Primeramente, agregue' extensiones a los primeros 3 archivos para facilitar la asociacion con mi editor preferido (PSPad). quedaron asi:
oscon.tcl
osconwrap.txt
README.txt
sessions_friday.html
sessions_thursday.html
sessions_wednesday.html

El README.txt especifica:
* que depende de 6 librerias
  * tcllib htmlparse
  * tcllib struct matrix
  * tcllib struct tree
  * tcllib csv
  * tcllib report
  * tcllib log
* que genera 6 archivos (2 txt, 2 csv y 2 html) + 2 ps si se cuenta con "a2ps"
* que los archivos html fuente estan incluidos en este mismo directorio para evitar que el script deje de funcionar debido a que la pagina ya no este disponible, o esta haya cambiado de formato.

Debido a algunos cambios a partir de la version 2.0 de la libreria struct::tree,
http://tcllib.sourceforge.net/doc/struct_tree.html#SECTid82038b8
es necesario hacer algunas correcciones al script oscon. (el cual ahora lo tengo con extension tcl)

En resumen, los cambios son:
1) el comando de creacion de la estructura de arbol, tenia (por alguna razon que desconozco), lo siguiente:
::struct::tree::tree t
Es necesario dejarlo asi:
::struct::tree t
 
2) Hay que eliminar la opcion -key de los comandos "t get..."      

Esta es la lista de cambios (ya como deben quedar esas lineas):
#cambio #1
::struct::tree t
--
#cambio #2
set day  [escape [t get $day data]]
--
#cambio #3
set start [cvtdate [escape [t get [walkf $sess {0 0}] data]]]
#cambio #4
set track [string trim [escape [t get [walkf $sess {1 0}] data]]]
#cambio #5
set loc   [escape [t get [walkf $sess {1 1 0}] data]]
--
#cambio #6
set time    [escape [t get $talk data]]
--
#cambio #7
set title   [escape [t get [walkf $talk {0 0 0}] data]]
#cambio #8
set speaker [escape [t get [walkf $talk {0 2}] data]]
--
#cambio #9
set  tp  [$t get $n type]
--
#cambio #10
log::log debug "[textutil::strRepeat " " $d]$idx $tp ([$t get $n data]...)"
--
#change #11
log::log debug "[textutil::strRepeat " " $d]$idx $tp ([string range [$t get $n data] 0 20]...)"

Ahora si, ya podemos lanzar el programa tal como se especifica en el archivo README.txt:

tclsh oscon.tcl wed sessions_wednesday.html

Al finalizar la ejecucion del script, los siguientes archivos seran creados:
wed.main.csv
wed.main.html
wed.main.ps
wed.main.txt
wed.sched.csv
wed.sched.html
wed.sched.ps
wed.sched.txt

Checalos, y comparalos contra la fuente (sessions_wednesday.html), para que veas lo que se puede hacer en termino de "parseo" y reformateo de la informacion.

Interesante, verdad?

Loteria parte 2

Una vez que se tienen las 54 imagenes correspondientas a las cartas de loteria, segun se describe en el post de ayer, estamos listos para probar este script el cual consiste en una "barajador" virtual para nuestros juegos de loteria con familiares y amigos.



El codigo siguiente, se basa principalmente en esta pagina del "Tcl wiki":
http://wiki.tcl.tk/9888

# --------------------------------
#
# loteria
# heavily based on http://wiki.tcl.tk/9888
# --------------------------------
console show
package require Tk
package require Img  
if {$tcl_platform(platform) == "unix"} {
  sdltk textinput off
  borg spinner on;borg toast "Shuffling..."
}
package require struct
package require htmlparse
package require http
  
set onLine 0

proc iota2 n {
global onLine   
::struct::tree t
  
set url "http://www.random.org/sequences/?min=1&max=54&col=1&format=html&rnd=new"
set http  [::http::geturl $url]
set html  [::http::data $http]

    
htmlparse::2tree $html t
htmlparse::removeVisualFluff t
htmlparse::removeFormDefs t
  
 if { [catch {walk {1 4 1 0}} base] } {
   tk_messageBox -message "Web Page not available 1"
   set onLine 0
   t destroy
   reset
   return
 }
if {$base == ""} {
   tk_messageBox -message "Web Page not available 2"
   set onLine 0
   t destroy
   reset
   return

}
#set base [walk {1 4 1 0}]
set listado [t get $base data]
puts "type(tag): [t get $base type]\n"
set ctr 0
foreach card $listado {
 puts "[incr ctr]: $card"
}
t destroy
return $listado
}
  
proc walkf {n p} {
    foreach idx $p {
        if {$n == ""} {break}
        set n [lindex [t children $n] $idx]
    }
    return $n
}
  
proc walk {p} {
    return [walkf root $p]
}

# -------------
# parameters
# -------------
proc randomColor {} {format #%06x [expr {int(rand() * 0xFFFFFF)}]}

#  name      color       file 
for {set i 1} {$i < 55} {incr i} {
  set ctr [format "%02d" $i]
  lappend parms [list flower$i [randomColor] lote$ctr.jpg]
}

proc reset {} {
  global las54 onLine tcl_platform
  .name config -text ""
  if {$tcl_platform(platform) == "unix"} {borg spinner on;borg toast "Shuffling..."}
  #set las54 [iota1 54]
  if $onLine {
   set las54 [iota2 54]
  } else {
   set las54 [iota1 54]
  }

 foreach i $::list { .0 itemconf $i -state hidden }
 for {set i 1} {$i < 55} {incr i} {
  .$i itemconf 1 -state hidden
}
.btn configure -state normal
.ckOnLine configure -state normal
if {$tcl_platform(platform) == "unix"} {borg spinner off;borg toast "Ready..."}
}

proc dala {} {
  global las54 onLine
  .ckOnLine configure -state disabled
  if $onLine {
   puts "on-line"
   set i [ldrawOL las54]
  } else {
   set i [ldraw las54]
  }
  
  bind .$i <1> [list select $i]
  set quedan [llength $las54]
  .name config -text [expr {54 - $quedan}]
  if {$quedan == 0} {
     .btn configure -state disabled
  }
  select $i
}

proc iota1 n {
   set res {}
   for {set i 1} {$i<=$n} {incr i} {lappend res $i}
   set res
}

proc ldraw _list {
   puts "local"
   upvar 1 $_list list
   set pos [expr {int(rand()*[llength $list])}]
   K [lindex $list $pos] [set list [lreplace $list $pos $pos]]
}

proc ldrawOL _list {
   puts "on-line"
   upvar 1 $_list list
   set pos 0
   K [lindex $list $pos] [set list [lreplace $list $pos $pos]]
}


proc K {a b} {set a}

  if $onLine {
   set las54 [iota2 54]
  } else {
   set las54 [iota1 54]
  }

# -------------
# nmage/bimage packages
# -------------

# create a canvas with n images
proc nmage {w args} \
{
  # take size from the first image
  set image [lindex $args 0]
  set ww [image width $image]
  set hh [image height $image]
  # center coordinates
  set x [expr {$ww / 2}]
  set y [expr {$hh / 2}]
  # create canvas
  puts "creating canvas $w"
  canvas $w -width $ww -height $hh -highlightt 0
  # create the images
  foreach image $args {
   set id [$w create image $x $y -anchor center -image $image -state hidden]
   puts "creating $w > $id"
  }
}
# create a canvas with a mini image
proc bimage {n} \
{
  # take size from the full image
  set image $::names($n)
  set ww [image width $image]
  set hh [image height $image]
  # create the mini image from the full image
  foreach {type factor} {mini 4} \
  {
    set ww2 [expr {$ww / $factor}]
    set hh2 [expr {$hh / $factor}]
    image create photo ${type}$n -width $ww2 -height $hh2
    ${type}$n copy $image -subsample $factor
  }
  # create a canvas with the mini image
  nmage .$n mini$n
}

# -------------
# mechanism
# -------------

# called on n-th choice (click on canvas)
proc select {n} \
{
  # select the little image
  #foreach i $::list { choose $i $n }
  .$n itemconf 1 -state normal
  .0 raise $n
  .0 itemconf $n -state normal
  if 0 {
    foreach i $::list { .0 itemconf $i -state hidden }
    .0 itemconf $n -state normal
  }
  # show its name
  # .name config -text $::names($n)
  # set background color
  set color $::colors($n)
  foreach w {. .name .0} { $w config -bg $color }
  foreach i $::list { .$i config -bg $color }
}
# choose between the mini & the micro image
proc choose {i n} \
{
  set a 1; set b 2
  if {$i == $n} { set a 2; set b 1 }
  puts "b = $b"
  .$i itemconf $b -state normal
}

# -------------
# create images from files
# -------------

set i 0
foreach item $parms \
{ 
  foreach {name color file} $item break
  lappend list [incr i] 
  set names($i) $name
  set colors($i) $color
  set files($i) $file
}
foreach i $list { image create photo $names($i) -file $files($i) }

# -------------
# create widgets
# -------------

# the canvas with the full size images
foreach i $list { lappend images $names($i) }
eval [linsert $images 0 nmage .0]
# the label with the name
label .name -font {Times -24}
# the selection canvas


# -------------
# place & display widgets
# -------------
button .btn -text Next -command dala
grid .btn -row 1 -column 0 -sticky nswe
button .btnReset -text Reset -command reset
checkbutton .ckOnLine -text "On-Line" -variable onLine -onvalue 1 -offvalue 0
grid .btnReset -row 6 -column 5 -columnspan 3 -sticky nsew
grid .ckOnLine -row 6 -column 8 -columnspan 3
grid .name -row 0 -column 0
grid .0    -row 2 -column 0 -rowspan 5
 
for {set i 1} {$i < 55} {incr i} {
  set row [format "%0.0f" [expr {ceil ($i/10.0)}]]
  set col [format "%0.0f" [expr {((($i/10.0) - $row) + 1) * 10}]]
  bimage $i
  grid .$i -row $row -column $col
  #bind .$i <1> [list select $i]
}
# -------------
# do it!
# -------------

wm title . loteria!
after idle {
  if {$tcl_platform(platform) == "unix"} {borg spinner off;borg toast "Ready..."}
}

Loteria parte 1

El primer paso para tener lista nuestra "baraja virtual" de loteria mexicana, es obtener las 54 imagenes de las cartas.

Desde luego, este codigo puede ser ejecutado desde tu Android Tablet, si cuentas con Androwish.

Al finalizar la ejecucion de este script, se tendran 54 imagenes:

(desde lote01.jpg, hasta lote54.jpg), en el mismo directorio donde este ubicado este script:

  console show  
  #package require Tk  
  package require http  
  #package require base64  
  package require Img  
  set um [http::geturl http://loteria.elsewhere.org/miniatura/]  
  set b [split [http::data $um] "\n"]  
  for {set i 1} {$i<55} {incr i} {  
    if {$i < 10} {  
     set ctr "0$i"  
    } else {  
     set ctr $i  
    }  
    set ln [lsearch -inline -glob $b "*miniatura-${ctr}_298*"]  
    puts $ln  
    regexp {^.*src=\"([^"]+)\".*$} $ln --> picurl  
    http::cleanup $um  
    set um [http::geturl http://loteria.elsewhere.org$picurl]  
    set filename "lote$ctr.jpg"  
    set fd [open [file join [lindex $argv 0] $filename] w]  
    fconfigure $fd -translation binary -encoding binary  
    puts $fd [http::data $um]  
    close $fd  
    http::cleanup $um  
  }  

Tcl/Tk en Android !

Androwish es...Tcl/Tk en Android!
La version mas reciente puede ser descargada de:
http://www.androwish.org


Tuve la oportunidad de contribuir con el icono de la aplicacion, de hecho, mi hija llevo la idea a Illustrator y de ahi a la persona que esta detras de todo este esfuerzo para que nosotros podamos disfrutar y aprovechar Tcl/Tk en Android.

He probado un par de programas que corren bien con Androwish:
Logo: http://wiki.tcl.tk/39563
Flow Colors: http://wiki.tcl.tk/39820

Tambien, hice mi propia "baraja" de loteria mexicana la cual publicare en este mismo espacio en los siguientes dias.

comando clock

comando clock

Este comando es util para los calculos y operaciones con fechas.

Primeramente, clock seconds, devuelve un entero que representa la cantidad de segundos transcurridos desde la fecha actual en el sistema, contra una fecha de referencia, la cual es una convencion situada alrededor de 1/1/1970.

% clock seconds
1398566136

Para obtener dicha cantidad de segundos de una fecha especifica, se usa el subcomando scan:
% clock scan 4/26/2014
1398488400

En la direccion contraria, para obtener una fecha, a partir de la cantidad de segundos, se usa el subcomando format:
% clock format 1398488400
Sat Apr 26 12:00:00 AM Central Daylight Time (Mexico) 2014

Una de las opciones mas usadas del comando "clock format" es precisamente el tambien llamado "format", con el cual, uno puede especificar el formato que espera en el resultado.
% clock format 1398488400 -format "%Y/%m/%d"
2014/04/26

Por cierto, cual es la fecha de referencia mencionada arriba?
pues lo podemos saber asi:

% clock format 0
Wed Dec 31 6:00:00 PM Central Standard Time (Mexico) 1969

radiobutton's

Hoy quise ponerle botones de opcion (radio buttons) a una de mis aplicaciones.

partiendo del listado de opciones:

set listado {texto1 val1 texto2 val2 texto3 val3}

Ahora hay que ir tomando cada par de llave-valor y crear (y empacar) los botones:

foreach {caption valor} $listado { 

   radiobutton .opt$valor -text $caption -value $valor

   pack .opt$valor

}