klnx_e.tcl

# INSTRUCCIONES DE KAREL =PARTE 1=
###############################################################################
###############################################################################
#		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 Sistemas Computacionales
#
#		Noviembre 1997 	crivera@scfie.eie.umich.mx
###############################################################################
###############################################################################

#######################################################
## 	Nombre: 	CREA_AMBIENTE_ENSA
##
##			para realizar esa tarea.
##	Regresa: 	Nada
##	Procedimientos 
##	externos: 	Procedimientos de posicionamiento de Karel
##			Procedimientos de instrucciones primitivas
##			Procedimientos de saltos
##			Procedimientos de pruebas de Karel
#######################################################
proc crea_ambiente_ensa { y } {
	global frente karel_x karel_y bolsa coloca memoria 
	global avance nva_ins num_nva_ins num_monedas archivo_karel
	
	destaca_fuente [lindex $y 0]
	switch [lindex $y 1] {
			
		k { KAREL_ESTA_EN_CALLE  1  }
		m { HAY_MONEDAS $avance }    
		pa { set avance [PARED_JUNTO_A_AVENIDA $avance] }	
		pc { set avance [PARED_JUNTO_A_CALLE $avance] }

		av { AVANZA }
		gi { GIRA_A_LA_IZQUIERDA }
		rm { RECOGE_MONEDA } 
		cm { COLOCA_MONEDA }		 
		ap { APAGATE }

		jc { SALTO_INCONDICIONAL }
		js { JUMP_TO_SUBROUTINE }
		rs { RETURN_FROM_SUBROUTINE }
		
		fd { set resultado [FRENTE_DESPEJADO]
			if { $resultado == 1 } { incr avance}
		}  
		fb { set resultado [FRENTE_BLOQUEADO ]
			if { $resultado == 1 } { incr avance}		
		}
		id { set resultado [IZQUIERDA_DESPEJADA ]
			if { $resultado == 1 } { incr avance}
		} 
		ib { set resultado [IZQUIERDA_BLOQUEADA ]
			if { $resultado == 1 } { incr avance}
		} 
		dd { set resultado [DERECHA_DESPEJADA ]
			if { $resultado == 1 } { incr avance}
		}
		db { set resultado [DERECHA_BLOQUEADA ]
			if { $resultado == 1 } { incr avance}
		}
		jm { set resultado [JUNTO_A_MONEDA ]
			if { $resultado == 1 } { incr avance}
		}
		njm { set resultado [NO_JUNTO_A_MONEDA ]
			if { $resultado == 1 } { incr avance}
		}
		hn { set resultado [HACIA_EL_NORTE ]
			if { $resultado == 1 } { incr avance}
		}
		nhn { set resultado [NO_HACIA_EL_NORTE ]
			if { $resultado == 1 } { incr avance}
		}
		hs { set resultado [HACIA_EL_SUR ]
			if { $resultado == 1 } { incr avance}
		}		
		nhs { set resultado [NO_HACIA_EL_SUR ]
			if { $resultado == 1 } { incr avance}
		}
		he { set resultado [HACIA_EL_ESTE ]
			if { $resultado == 1 } { incr avance}
		}
		nhe { set resultado [NO_HACIA_EL_ESTE ]
			if { $resultado == 1 } { incr avance}
		}
		ho { set resultado [HACIA_EL_OESTE ]
			if { $resultado == 1 } { incr avance}
		}
		nho { set resultado [NO_HACIA_EL_OESTE ]
			if { $resultado == 1 } { incr avance}
		}
		din { set resultado [CON_MONEDAS_EN_SU_BOLSA ]
			if { $resultado == 1 } { incr avance}
		}
		smb { set resultado [SIN_MONEDAS_EN_SU_BOLSA ]
			if { $resultado == 1 } { incr avance}
		}
	}
} 

	#######################################################
	##										##
	##	        P * R * O * C * E * D * I * M * I * E * N * T * O * S 		##
	##	        P  *  R  *  I  *  N  *  C  *  I  *  P  *  A  *  L  *  E  *  S		##
	##										##
	#######################################################


###############################################################################
## 	INSTRUCCIONES DE POSICIONAMIENTO DE KAREL
###############################################################################
proc KAREL_ESTA_EN_CALLE { inicio } {
	global memoria avance frente karel_x karel_y bolsa
	
	set karel_y [lindex [split $memoria($inicio)] 1]
	incr inicio
	set karel_x [lindex [split $memoria($inicio)] 1]
	incr inicio
	set frente [lindex [split $memoria($inicio)] 1]
	incr inicio
	set bolsa [lindex [split $memoria($inicio)] 1]
	crea_karel $karel_x $karel_y $frente [existen_monedas $bolsa] on
	set avance $inicio
}

proc HAY_MONEDAS {inicio} {
	global memoria avance 
	set inicio [expr $inicio +2]
	set x [lindex [split $memoria($inicio)] 1]
	incr inicio
	set y [lindex [split $memoria($inicio)] 1]
	crea_moneda $x $y
	posicion_monedas $x $y
	set avance $inicio
}

###############################################################################
## 	INSTRUCCION DE CREACION DE AMBIENTE
###############################################################################
proc PARED_JUNTO_A_AVENIDA {  renglon } {
	global memoria 
	for {set i 0} { $i < 3 } {incr i } {
		incr renglon
		set temp$i [lindex [split $memoria($renglon)] 1] }
	crea_pared avenida $temp0 $temp1 $temp2 
	forma_arreglo $temp0 $temp1 $temp2 y
	return $renglon
}

proc PARED_JUNTO_A_CALLE { renglon } {
	global memoria
		for {set i 0} { $i < 3 } {incr i } {
		incr renglon
		set temp$i [lindex [split $memoria($renglon)] 1] }
	crea_pared calle $temp0 $temp1 $temp2 
	forma_arreglo $temp0 $temp1 $temp2  x
	return $renglon
}


###############################################################################
## 	INSTRUCCIONES PRIMITIVAS
###############################################################################
proc AVANZA { } { 
	global frente karel_x karel_y bolsa 

	if { [busca_moneda $karel_x $karel_y] == 1 } { set temp 1} {set temp 0}
	set y $karel_x
	set z $karel_y
	set x [JUNTO_A_MONEDA]
	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
	if {$x==1} { crea_moneda $z $y }
}
#
proc GIRA_A_LA_IZQUIERDA { } { 
	global frente karel_x karel_y bolsa 

	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
}

proc RECOGE_MONEDA { } { 
	global frente karel_x karel_y bolsa 

	incr bolsa
	crea_karel $karel_x $karel_y $frente black on
	elimina_moneda $karel_x $karel_y 
}

proc COLOCA_MONEDA { } { 
	global frente karel_x karel_y bolsa
	
	incr bolsa -1
	borra_karel $karel_x $karel_y 
	crea_moneda $karel_y $karel_x
	posicion_monedas $karel_y $karel_x
	crea_karel $karel_x $karel_y $frente [existen_monedas $bolsa] on
}

proc APAGATE { } {
	global frente karel_x karel_y bolsa alto

	crea_karel $karel_x $karel_y $frente [existen_monedas $bolsa] off
	set alto 1
	bell
	bell
	bell 
}

###############################################################################
## 	INSTRUCCIONES DE SALTOS
###############################################################################
proc SALTO_INCONDICIONAL { } {
	global avance memoria

	set temp [lindex [split $memoria($avance) ] 2]
	set avance [comienza_ejecucion $temp]
}

proc JUMP_TO_SUBROUTINE { } {
	global avance memoria
	inserta_en_pila [expr $avance +1]
	set temp [lindex [split $memoria($avance) ] 2]
	set avance [comienza_ejecucion $temp]
}

proc RETURN_FROM_SUBROUTINE { } {
	global avance
	set avance [expr [quita_de_pila] -1]
}

###############################################################################
## 	PRUEBAS DE KAREL
###############################################################################
proc FRENTE_DESPEJADO { } {
	global frente
	if { [busca_pared $frente] == 0 } { return 1} {return 0} 
}

proc FRENTE_BLOQUEADO { } {
	global frente
	if { [busca_pared $frente] == 0 } { return 0} {return 1} 
}

proc IZQUIERDA_DESPEJADA { } {
	global frente
	set orienta [checa_orientacion izquierda $frente] 
	if { [busca_pared $orienta] == 0 } { return 1} {return 0}	
}

proc IZQUIERDA_BLOQUEADA { } {
	global frente
	set orienta [checa_orientacion izquierda $frente] 
	if { [busca_pared $orienta] == 0 } { return 0} {return 1}	
}

proc DERECHA_DESPEJADA { } {
	global frente
	set orienta [checa_orientacion derecha $frente] 
	if { [busca_pared $orienta] == 0 } { return 1} {return 0}	
}

proc DERECHA_BLOQUEADA { } {
	global frente
	set orienta [checa_orientacion derecha $frente] 
	if { [busca_pared $orienta] == 0 } { return 0} {return 1}	
}

proc JUNTO_A_MONEDA { } {
	global karel_x karel_y 
	if { [busca_moneda $karel_x $karel_y ]  == 1 } { return 1} {return 0}
	
}	

proc NO_JUNTO_A_MONEDA { } {
	global karel_x karel_y 
	if { [busca_moneda $karel_x $karel_y ]  == 1 } { return 0} {return 1}
}

proc HACIA_EL_NORTE { } {
	global frente
	if { $frente == "NORTE"} { return 1} { return 0 }
}

proc NO_HACIA_EL_NORTE {  } {
	global frente
	if { $frente == "NORTE"} { return 0} { return 1 }
}

proc HACIA_EL_SUR { } {
	global frente
	if { $frente == "SUR"} { return 1} { return 0 }
}

proc NO_HACIA_EL_SUR { } {
	global frente
	if { $frente == "SUR"} { return 0} { return 1 }
}

proc HACIA_EL_ESTE { } {
	global frente
	if { $frente == "ESTE"} { return 1} { return 0 }
}

proc NO_HACIA_EL_ESTE { } {
	global frente
	if { $frente == "ESTE"} { return 0} { return 1 }
}

proc HACIA_EL_OESTE { } {
	global frente
	if { $frente == "OESTE"} { return 1} { return 0 }
}

proc NO_HACIA_EL_OESTE { } {
	global frente
	if { $frente == "OESTE"} { return 0} { return 1 }
}

proc CON_MONEDAS_EN_SU_BOLSA { } {
	global bolsa	
	if { $bolsa > 0 } { return 1} { return 0 }  
}

proc SIN_MONEDAS_EN_SU_BOLSA { } {
	global bolsa	
	 if { $bolsa == 0 } { return 1} { return 0 }  
}


	#######################################################
	##										##
	##	        P * R * O * C * E * D * I * M * I * E * N * T * O * S 		##
	##	        A  *  D  *  I  *  C  *  I  *  O  *  N  *  A  *  L  *  E  *  S		##
	##										##
	#######################################################


#######################################################
## 	Nombre: 	EXISTEN_MONEDAS
##
##			indicar la existencia o ausencia de monedas en 
##			su bolsa
##	Regresa: 	Rojo (sin monedas) o negro (con monedas)
##	Procedimientos 
##	externos: 	Ninguno 
#######################################################
proc existen_monedas { cantidad } {
	if {$cantidad == 0 } { set color red } {set color black }
	return $color
}

#######################################################
## 	Nombre: 	FORMA_ARREGLO
##
##			pared.
## 			de la pared
##	Regresa: 	Nada
##	Procedimientos 
##	externos: 	Ninguno 
#######################################################
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
}

#######################################################
## 	Nombre: 	POSICION_MONEDAS
##
##			encuentra la moneda
## 			de las monedas
##	Regresa: 	Nada
##	Procedimientos 
##	externos: 	Ninguno 
#######################################################
proc posicion_monedas {  y x} {
	global lugar_monedas num_monedas

	set lugar_monedas($num_monedas) $x
	append lugar_monedas($num_monedas) " $y"
	incr num_monedas
}

#######################################################
## 	Nombre: 	ELIMINA_MONEDA
##
##	Regresa: 	Nada
##	Procedimientos 
##	externos: 	Ninguno 
#######################################################
proc elimina_moneda { x y } {
	global lugar_monedas num_monedas
	set i 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 lugar_monedas($i) "0 0"}
		
		incr i
	}
}

#######################################################
## 	Nombre: 	CHECA_ORIENTACION
##
##			o a la derecha
##	Procedimientos 
##	externos: 	Ninguno 
#######################################################
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}
		} }
}

#######################################################
## 	Nombre: 	BUSCA_PARED
##
##	Regresa: 	1 si la pared existe, 0 en caso contrario
##	Procedimientos 
##	externos: 	Ninguno 
#######################################################	
proc busca_pared { orienta  } {
	global karel_x karel_y obstaculo num_obstaculo

	set tempo 0
	if { $orienta == "ESTE" } {
		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 }  
			}
		}
	}

	if { $orienta == "OESTE" } {
		for {set i 0} {$i< $num_obstaculo} {incr i} {
			set temp [split $obstaculo($i)]
			if { [lindex $temp 0] == "y"} {
			 	if { [lindex $temp 1] == [expr $karel_x -1] } { set tempo 1 }  
			}
		}
	}

	if { $orienta == "NORTE" } {
		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 }  
			}
		}
	}

	if { $orienta == "SUR" } {
		for {set i 0} {$i< $num_obstaculo} {incr i} {
			set temp [split $obstaculo($i)]
			if { [lindex $temp 0] == "x"} {
				 if { [lindex $temp 2] == [expr $karel_y -1] } { set tempo 1 }  
			}
		}
	}
	return $tempo
}

#######################################################
## 	Nombre: 	BUSCA_MONEDA
##
##			de una moneda
##	Regresa: 	1 si la moneda existe, 0 en caso contrario
##	Procedimientos 
##	externos: 	Ninguno 
#######################################################
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
}

#######################################################
## 	Nombre: 	COMIENZA_EJECUCION
##
##			UNICAMENTE la palabra dada 
##	Procedimientos 
##	externos: 	Ninguno 
#######################################################
proc comienza_ejecucion { limite } {
	global memoria

	set regresa 0
	set cont 0
	while {$regresa == 0} {
		set a [split $memoria($cont)]
		if { [lindex $a 1] == $limite } { set regresa $cont }
		incr cont
	}
	return [expr $regresa -1]
 }