# PROGRAMA PRINCIPAL DE KAREL
###############################################################################
###############################################################################
# PROGRAMA PRINCIPAL DE KAREL
#
# Autor: Ing. CUAUHTEMOC RIVERA LOAIZA
#
# Universidad Michoacana de San Nicolas de Hidalgo
#
# Seccion de Graduados de la Facultad de Ingenieria
# Electrica
#
# Maestria en Sistemas Computacionales
#
# Noviembre 1997 crivera@scfie.eie.umich.mx
###############################################################################
#
# NOTA: Es necesario contar con los archivos klnx_acerca.tcl, klnx_ambiente.tcl,
## klnx_ensa.tcl, klnx_pila.tcl y foto.gif en el mismo directorio en que se encuentra
# el programa principal (klnx.tcl).
#
###############################################################################
catch {destroy .karel}
catch {destroy .programadual }
global memoria obstaculo num_obstaculo num_monedas
global frente karel_x karel_y bolsa pila nva_ins num_nva_ins boton alto
global destacar programa_karel destacar_fuente
set destacar 1
set destacar_fuente 1
set alto 0
set obstaculo(0) "x 0 0 0 0"
set obstaculo(1) "y 0 0 0 0"
set obstaculo(2) "x 0 25 0 0"
set obstaculo(3) "y 25 0 0 0"
set num_nva_ins 0
set num_monedas 0
set bolsa 0
set pila 0
set num_obstaculo 4
global velocidad
set velocidad 800
set boton Avance
source klnx_pila.tcl
source klnx_ensa.tcl
source klnx_ventanas.tcl
#######################################################
## ##
## P * R * O * C * E * D * I * M * I * E * N * T * O * S ##
## ##
#######################################################
#######################################################
## Nombre: BORRADO DE KAREL
##
## Regresa: Nada
## Procedimientos
## externos: convierte_x, convierte_y, contorno_karel
#######################################################
proc borra_karel { x1 y1 } {
set x [ convierte_x $x1 ]
set y [ convierte_y $y1 ]
contorno_karel $x $y white
.karel.ambiente create line [expr $x - 15] $y \
[expr $x + 15] $y -fill gray
.karel.ambiente create line $x [expr $y - 15] \
$x [expr $y + 15] -fill gray
}
#######################################################
## Nombre: CREACION DE KAREL
##
## modo apagado o activo.
## Regresa: Nada.
## Procedimientos
## externos: convierte_x, convierte_y, contorno_karel
#######################################################
proc crea_karel { x1 y1 orientacion color activo} {
set x [ convierte_x $x1 ]
set y [ convierte_y $y1 ]
if {$activo =="on"} { set modo red } {set modo blue }
contorno_karel $x $y $modo
.karel.ambiente create oval [expr $x -4 ] [expr $y -4] \
[expr $x +5 ] [expr $y + 5] -width 2 -fill $color
switch $orientacion {
SUR { .karel.ambiente create line $x [expr $y +5] \
$x [expr $y + 7] -width 3
}
NORTE { .karel.ambiente create line $x [expr $y -5] \
$x [expr $y - 7] -width 3
}
ESTE { .karel.ambiente create line [expr $x +5] $y\
[expr $x + 7] $y -width 3 -fill black
}
OESTE { .karel.ambiente create line [expr $x -5] $y\
[expr $x - 7] $y -width 3
}
}
}
#######################################################
## Nombre: CREACION DEL CIRCULO
## EXTERIOR DE KAREL
##
## activo o apagado.
## Regresa: Nada.
## Procedimientos
## externos: Ninguno.
#######################################################
proc contorno_karel { x y color } {
.karel.ambiente create oval [expr $x -8 ] [expr $y -8] \
[expr $x +9 ] [expr $y +9] -fill $color -outline $color
}
#######################################################
## Nombres: CONVIERTE_X y CONVIERTE_Y
##
## a posiciones reales a utilizar en el canvas
## Procedimientos
## externos: Ninguno.
#######################################################
proc convierte_x { a1 } {
set a 40
for { set i 1 } { $i < $a1} { incr i } {
set a [expr $a +20 ]
}
return $a
}
proc convierte_y { a1 } {
set a 520
for { set i 1 } { $i < $a1} { incr i } {
set a [expr $a -20 ]
}
return $a
}
#######################################################
## Nombre: CREA_PARED
##
## avenida>" punto_a "DE_<calle o avenida>"
## punto_b1 "A" punto_b2
## Regresa: Nada
## Procedimientos
## externos: convierte_X, convierte_y.
#######################################################
proc crea_pared { calle_o_avenida punto_a punto_b1 punto_b2 } {
switch $calle_o_avenida {
avenida { .karel.ambiente create line [expr [convierte_x $punto_a] +10] \
[expr [convierte_y $punto_b1] +10]\
[expr [convierte_x $punto_a] +10] \
[expr [convierte_y $punto_b2] -10] -fill black -width 3 }
calle { .karel.ambiente create line [expr [convierte_x $punto_b1] -10]\
[expr [convierte_y $punto_a] -10] \
[expr [convierte_x $punto_b2] +10] \
[expr [convierte_y $punto_a] -10] -fill black -width 3 }
default { puts "Error!" }
}
}
#######################################################
## Nombre: CREA_MONEDA
##
## Regresa: Nada
## Procedimientos
## externos: convierte_X, convierte_y.
#######################################################
proc crea_moneda { y x } {
set x [convierte_x $x]
set y [convierte_y $y]
.karel.ambiente create oval [expr $x - 3] [expr $y - 3] [expr $x + 3] [expr $y + 3] -fill black
}
#######################################################
## Nombre: CARGA_ARCHIVO
##
## archivo elegido, nombre del archivo, opcion
## con los tipos de archivos a cargar
## Regresa: Nada
## Procedimientos
## externos: tk_getOpenFile,
#######################################################
proc carga_archivo { w archivo opcion} {
global memoria
set tipos {
{"Archivos de ejecutables Karel" {.ok} }
{"Archivos de Texto" {.txt} TEXT}
{"Todos los Archivos" *}
}
if {$opcion == 1 } {
set archivo [tk_getOpenFile -filetypes $tipos -parent $w]}
set avance 0
set f [open $archivo]
$w delete 1.0 end
while {![eof $f]} {
$w insert end [read $f 10000]
}
close $f
if { [array exists memoria] } {
unset memoria }
if { [file readable $archivo] } {
set fileid [open $archivo "r"] }
set cont 0
set i 1
while { $i == 1 } {
gets $fileid data
set memoria($cont) $data
if {[eof $fileid]} {set i 0 }
incr cont
}
muestra_fuente [string trimright $archivo ".ok"]
}
#######################################################
## Nombre: AVANZA_INSTRUCCION
##
## Regresa: Nada
## Procedimientos
## externos: destaca, clasifica
#######################################################
proc avanza_instruccion { renglon avance } {
global destacar destacar_fuente
destaca $avance
if {$renglon != ""} { clasifica $renglon }
set destacar [expr $avance +1]
#set destacar_fuente [expr $avance -1]
}
#######################################################
## Nombre: DESTACA
##
## este sea siempre visible
## Regresa: Nada
## Procedimientos
## externos: Ninguno
#######################################################
proc destaca { numero_linea } {
global destacar
set ventana .programadual.cpd19.03
incr numero_linea
if { $destacar == 1} {
set x "$ventana tag add destaca$destacar \
{$destacar.0 linestart} {$destacar.0 lineend}"
eval $x
$ventana tag configure destaca$destacar -background blue \
-foreground white } { \
$ventana tag configure destaca$destacar -background white \
-foreground black
set x "$ventana tag add destaca$numero_linea \
{$numero_linea.0 linestart} {$numero_linea.0 lineend}"
eval $x
$ventana tag configure destaca$numero_linea -background blue \
-foreground white }
$ventana see $numero_linea.0
}
#######################################################
## Nombre: INSERTA_EN_PILA
##
## uso.
## Regresa: Nada
## Procedimientos
## externos: Ninguno
#######################################################
proc inserta_en_pila { localidad } {
global pila
.pila.frame.text insert end $localidad
.pila.frame.text insert end \n
incr pila
}
#######################################################
## Nombre: QUITA_DE_PILA
##
## "Pila".
## Procedimientos
## externos: Ninguno
#######################################################
proc quita_de_pila { } {
global pila
set a [.pila.frame.text get $pila.0 [expr $pila +1].0 ]
.pila.frame.text delete $pila.0 [expr $pila +1].0
incr pila -1
return $a
}
#######################################################
## Nombre: AVANZA_AUTO
##
## Regresa: Nada
## Procedimientos
## externos: avanza_instruccion
#######################################################
proc avanza_auto { } {
global avance memoria velocidad continua alto
set alto 0
set fin_programa [ array size memoria ]
while { $avance < $fin_programa } {
avanza_instruccion $memoria($avance) $avance
incr avance
after $velocidad { set continua "" }
tkwait variable continua
unset continua
if {$alto == 1 } {break}
}
}
#######################################################
## Nombre: CLASIFICA
##
## Regresa: Nada
## Procedimientos
## externos: crea_ambiente_ensa
#######################################################
proc clasifica { renglon} {
global boton
puts $renglon
set instruccion [split $renglon]
crea_ambiente_ensa $instruccion
set boton Detener
.programadual.but17 configure -bg red -fg white
}
#######################################################
## Nombre: MUESTRA_FUENTE
##
## Regresa: Nada
## Procedimientos
## externos: Ninguno
#######################################################
proc muestra_fuente { archivo } {
global programa_karel
set f [open $archivo.kar ]
while {![eof $f]} {
.programadual.cpd18.03 insert end [read $f 10000]
}
close $f
if { [array exists programa_karel] } {
unset programa_karel }
if { [file readable $archivo.kar] } {
set fileid [open $archivo.kar "r"] }
set cont 0
set i 1
while { $i == 1 } {
gets $fileid data
set programa_karel($cont) $data
if {[eof $fileid]} {set i 0 }
incr cont
}
}
#######################################################
## Nombre: DESTACA ARCHIVO FUENTE
##
## este sea siempre visible
## Regresa: Nada
## Procedimientos
## externos: Ninguno
#######################################################
proc destaca_fuente { numero_renglon } {
global destacar_fuente
set ventanas .programadual.cpd18.03
if { $destacar_fuente == 1} { \
set x "$ventanas tag add neon$destacar_fuente {$destacar_fuente.0 linestart} {$destacar_fuente.0 lineend}"
eval $x
$ventanas tag configure neon$destacar_fuente -background blue -foreground white } { \
$ventanas tag configure neon[expr $destacar_fuente +1] -background white -foreground black
set x "$ventanas tag add neon$numero_renglon {$numero_renglon.0 linestart} {$numero_renglon.0 lineend}"
eval $x
$ventanas tag configure neon$numero_renglon -background blue -foreground white }
$ventanas see $numero_renglon.0
puts $destacar_fuente
set destacar_fuente [expr $numero_renglon - 1]
}
#######################################################
## Nombres: COPIAR_AL_PORTAPAPELES
## CORTAR_AL_PORTAPAPELES
## PEGAR_DEL_PORTAPAPELES
##
## recibe el nombre de la ventana en donde se
## Regresa: Nada
## Procedimientos
## externos: Ninguno
#######################################################
proc COPIAR_AL_PORTAPAPELES { } {
if { [ selection own ] != "" } {
clipboard clear
clipboard append [selection get]
}
}
proc CORTAR_AL_PORTAPAPELES { } {
set owner [ selection own ]
if { $owner != "" } {
clipboard clear
clipboard append [selection get]
$owner delete sel.first sel.last
}
}
proc PEGAR_DEL_PORTAPAPELES { widgetname } {
set clip [selection get -selection CLIPBOARD ]
set owner [ selection own ]
if { $owner != $widgetname } {
set idx [$owner index sel.first ]
$owner delete sel.first sel.last
} { $widgetname insert insert $clip }
}