# INSTRUCCIONES DE KAREL =PARTE 2=
###############################################################################
###############################################################################
# INSTRUCCIONES 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 Sisitemas Computacionales
#
# Octubre 1997 rvlzch71@scfie.eie.umich.mx
###############################################################################
###############################################################################
proc crea_ambiente { y } {
global frente karel_x karel_y bolsa coloca memoria
global avance nva_ins num_nva_ins num_monedas archivo_karel
set x 0
set coloca 0
while { [lindex $y $x] == "" } { incr x }
switch [lindex $y $x ] {
FIN_DE_AMBIENTE { set avance [ comienza_programa $avance ]
precompila $archivo_karel $avance}
KAREL_ESTA_EN_CALLE { set frente [string tolower [lindex $y [expr $x +5]]]
set karel_y [lindex $y [expr $x + 1]]
set karel_x [lindex $y [expr $x + 3]]
set bolsa [lindex $y [expr $x + 7]]
crea_karel $karel_x $karel_y $frente [existen_monedas $bolsa] on
}
PARED_JUNTO_A_CALLE {crea_pared calle [lindex $y [expr $x+1]]\
[lindex $y [expr $x+3]] [lindex $y [expr $x+5]]
forma_arreglo [lindex $y [expr $x+1]] [lindex $y [expr $x+3]] [lindex $y [expr $x+5]] x}
PARED_JUNTO_A_AVENIDA {crea_pared avenida [lindex $y [expr $x+1]]\
[lindex $y [expr $x+3]] [lindex $y [expr $x+5]]
forma_arreglo [lindex $y [expr $x+1]] [lindex $y [expr $x+3]] [lindex $y [expr $x+5]] y}
HAY { crea_moneda [lindex $y [expr $x+3]] [lindex $y [expr $x+5]]
#posicion_monedas [lindex $y [expr $x+3]] [lindex $y [expr $x+5]]
}
DEFINE_NUEVA_INSTRUCCION { set nva_ins($num_nva_ins) [lindex $y [expr $x + 1]]
incr num_nva_ins}
REPITE { set opcion [bloque_o_no]
puts $opcion
if {$opcion == 0} {
inserta_en_pila $avance
for { set i 0 } { $i < [lindex $y [expr $x +1]] } { incr i } {
crea_ambiente [split $memoria([expr $avance +1])] }
set avance [expr [quita_de_pila] + 1]}
}
SI { set opcion [bloque_o_no]
set cierto_o_falso [pruebas [lindex $y [expr $x +1]]]
puts [lindex $y [expr $x +1]]
puts "hola mundo" }
avanza { borra_karel $karel_x $karel_y
if { $frente == "norte" } { incr karel_y }
if { $frente == "sur" } { incr karel_y -1}
if { $frente == "oeste" } { incr karel_x -1}
if { $frente == "este" } { incr karel_x }
crea_karel $karel_x $karel_y $frente [existen_monedas $bolsa] on
}
recoge_moneda { incr bolsa
crea_karel $karel_x $karel_y $frente black on
elimina_moneda $karel_x $karel_y }
gira_a_la_izquierda { borra_karel $karel_x $karel_y
switch $frente {
sur {set frente este}
oeste { set frente sur}
este { set frente norte}
norte {set frente oeste }
}
crea_karel $karel_x $karel_y $frente [existen_monedas $bolsa] on
}
coloca_moneda { incr bolsa -1
borra_karel $karel_x $karel_y
crea_moneda $karel_y $karel_x
crea_karel $karel_x $karel_y $frente [existen_monedas $bolsa] on
}
apagate { crea_karel $karel_x $karel_y $frente [existen_monedas $bolsa] off
bell
bell
bell }
default {bell }
}
}
## CHECA SI KAREL TIENE MONEDAS
proc existen_monedas { cantidad } {
if {$cantidad == 0 } { set color red } {set color black }
return $color
}
## DEFINICION DE UNA NUEVA INSTRUCCION
proc nueva_instruccion { nombre } {
puts $nombre
}
### FORMACION DEL ARREGLO SOBRE
### LOCALIZACION DE LAS PAREDES
proc forma_arreglo { a b1 b2 eje} {
global obstaculo num_obstaculo
set j ""
switch $eje {
x { append j "x"
append j " $b1"
append j " $a"
append j " $b2"
append j " $a"
}
y { append j "y"
append j " $a"
append j " $b1"
append j " $a"
append j " $b2"
}
}
set obstaculo($num_obstaculo) $j
incr num_obstaculo
puts $j
}
### FORMACION DEL ARREGLO SOBRE
### LOCALIZACION DE LAS PAREDES
proc posicion_monedas { x y } {
global lugar_monedas num_monedas
set lugar_monedas($num_monedas) $x
append lugar_monedas($num_monedas) " $y"
incr num_monedas
}
proc elimina_moneda { x y } {
global lugar_monedas num_monedas
set i 0
set z 0
while { $i < $num_monedas } {
set temp [split $lugar_monedas]
set temp_x [lindex $temp 0]
set temp_y [lindex $temp 1]
if { [expr $temp_x == $x ] && [expr $temp_y == $y]} { set $lugar_monedas($i) "0 0" }
incr i
}
}
#####################################
# DEFINICION DE LAS PRUEBAS
#####################################
proc pruebas { prueba } {
global frente karel_x karel_y
switch $prueba {
frente_despejado { if { [busca_pared $frente] == 0 } { return 1} {return 0} }
frente_bloqueado { if { [busca_pared $frente] == 1 } { return 1} {return 0} }
izquierda_despejada { set orienta [checa_orientacion izquierda $frente]
if { [busca_pared $orienta] == 0 } { return 1} {return 0} }
izquierda_bloqueada { set orienta [checa_orientacion izquierda $frente]
if { [busca_pared $orienta] == 0 } { return 0} {return 1} }
derecha_despejada { set orienta [checa_orientacion derecha $frente]
if { [busca_pared $orienta] == 0 } { return 1} {return 0} }
derecha_bloqueada { set orienta [checa_orientacion derecha $frente]
if { [busca_pared $orienta] == 0 } { return 0} {return 1} }
junto_a_moneda { busca_moneda $karel_x $karel_y }
no_junto_a_moneda { }
hacia_el_norte { if { $frente == "norte"} { return 1} { return 0 } }
no_hacia_el_norte { if { $frente == "norte"} { return 0} { return 1 } }
hacia_el_sur { if { $frente == "sur"} { return 1} { return 0 } }
no_hacia_el_sur { if { $frente == "sur"} { return 0} { return 1 } }
hacia_el_este { if { $frente == "este"} { return 1} { return 0 } }
no_hacia_el_este { if { $frente == "este"} { return 0} { return 1 } }
hacia_el_oeste { if { $frente == "oeste"} { return 1} { return 0 } }
no_hacia_el_oeste { if { $frente == "oeste"} { return 0} { return 1 } }
con_monedas_en_su_bolsa { if { $bolsa > 0 } { return 1} { return 0 } }
sin_monedas_en_su_bolsa { if { $bolsa == 0 } { return 1} { return 0 } }
}
}
proc checa_orientacion { lado orienta } {
if { $lado == "izquierda" } {
switch $orienta {
norte { return oeste}
oeste {return sur }
sur {return este}
este {return norte}
} } {
switch $orienta {
norte { return este}
este {return sur }
sur {return oeste}
oeste {return norte}
} }
}
## VERIFICA LA EXISTENCIA DE UNA PARED
proc busca_pared { orienta } {
global karel_x karel_y obstaculo num_obstaculo
#para el este y oeste
set tempo 0
switch $orienta {
norte { set tempor 1}
sur { set tempor 1}
este { set tempor 0}
oeste { set tempor 0}
}
if { $tempor == 0 } {
for {set i 0} {$i< $num_obstaculo} {incr i} {
set temp [split $obstaculo($i)]
if { [lindex $temp 0] == "y"} {
if { [lindex $temp 1] == $karel_x } {set tempo 1}}
}
}
#para el norte y sur
if { $tempor == 1 } {
for {set i 0} {$i< $num_obstaculo} {incr i} {\
set temp [split $obstaculo($i)]
if { [lindex $temp 0] == "x"} {
if { [lindex $temp 2] == $karel_y } {set tempo 1}}
}
}
return $tempo
}
### VERIFICA SI SE TRATA DE UNA SOLA INSTRUCCION
### O DE UN BLOQUE DE INSTRUCCIONES
proc bloque_o_no { } {
global memoria avance
set cont 0
set temp [split $memoria([expr $avance + 1])]
while { [lindex $temp $cont] == "" } { incr cont }
if { [lindex $temp $cont] == "INICIO" } {return 1} {return 0}
}
## VERIFICA LA EXISTENCIA DE UNA MONEDA
proc busca_moneda { x y } {
global lugar_monedas num_monedas
set i 0
set tempo 0
while { $i < $num_monedas } {
set temp [split $lugar_monedas($i)]
set temp_x [lindex $temp 0]
set temp_y [lindex $temp 1]
if { [expr $temp_x == $x ] && [expr $temp_y == $y]} { set tempo 1 }
incr i
}
return $tempo
}
## PROCEDIMIENTO QUE HACE QUE EL AVANCE SEA HASTA "INICIO_DE_EJECUCION"
proc comienza_programa { x } {
global memoria
set regresa 0
set d [expr [array size memoria] -5]
for { set cont $x } { $cont < $d } { incr cont } {
set a [split $memoria($cont)]
set b 0
while { [lindex $a $b ] == "" } { incr b }
if { [lindex $a $b] == "INICIO_DE_EJECUCION" } { set regresa $cont}
}
return [expr $regresa - 1]
}