;;	Mundo de bloques
;;
;;	Elena Arregui Urzola
;;	Mariano Mediavilla Gomez
;;	Raquel Miguel

 
(deftemplate objeto
   (slot nombre)
   (slot tiene-debajo (default SUELO))
   (slot tiene-encima (default NADA)))

(deftemplate objetivo
   (slot objeto-debajo)
   (slot objeto-encima))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; El estado inicial es A en el suelo, B sobre A y C sobre B. 
;;

(defrule inicio " Se ejecuta al hacer (reset) (run) "
  =>
   (assert (objeto (nombre SUELO)))
   (assert (objeto (nombre A) (tiene-debajo SUELO) (tiene-encima B)))
   (assert (objeto (nombre B) (tiene-debajo A) (tiene-encima C)))   
   (assert (objeto (nombre C) (tiene-debajo B)))
   (store CAMINO "")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; La situacion: tenemos como objetivo poner el bloque-2 sobre el bloque-1 (ninguno de los dos
;; tiene nada encima). Habra que eliminar los objetos tal y como estaban e introducirlos con
;; el movimiento hecho. En esta regla, el bloque-2 esta encima del bloque-4, luego hay que
;; introducir un hecho nuevo que refleje que el bloque-4 ya no tiene nada encima.
;;
(defrule mover-bloque-sobre-bloque-a
   ?objetivo <- (objetivo (objeto-debajo ?bloque-1&:(neq ?bloque-1 SUELO)) (objeto-encima ?bloque-2&:(neq ?bloque-2 SUELO)))   
   ?hecho-1 <- (objeto (nombre ?bloque-1&:(neq ?bloque-1 ?bloque-2)) (tiene-debajo ?objeto-3) (tiene-encima NADA))   
   ?hecho-2 <- (objeto (nombre ?bloque-2&:(neq ?bloque-2 SUELO)) (tiene-debajo ?bloque-4&:(neq ?bloque-4 SUELO)) (tiene-encima NADA))
   ?hecho-3 <- (objeto (nombre ?bloque-4)  (tiene-debajo ?objeto-5) (tiene-encima ?bloque-2)) 
 =>
   (retract ?objetivo ?hecho-1 ?hecho-2 ?hecho-3)
   (assert (objeto (nombre ?bloque-1) (tiene-debajo ?objeto-3) (tiene-encima ?bloque-2)))   
   (assert (objeto (nombre ?bloque-2) (tiene-debajo ?bloque-1) (tiene-encima NADA)))
   (assert (objeto (nombre ?bloque-4) (tiene-debajo ?objeto-5) (tiene-encima NADA)))   
   (bind ?camino (new java.lang.String))
   (bind ?camino (new java.lang.String(call ?camino concat (fetch CAMINO))))
   (bind ?camino (new java.lang.String(call ?camino concat ?bloque-2) ))
   (bind ?camino (new java.lang.String(call ?camino concat " movido encima del ")))
   (bind ?camino (new java.lang.String(call ?camino concat ?bloque-1)))
   (bind ?camino (new java.lang.String(call ?camino concat ";")))
   (store CAMINO (call ?camino toString))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; La situacion: tenemos como objetivo poner el bloque-2 sobre el bloque-1 (ninguno de los dos
;; tiene nada encima). Habra que eliminar los objetos tal y como estaban e introducirlos con
;; el movimiento hecho. En esta regla, el bloque-2 esta encima del suelo, luego no hay que
;; introducir ningun hecho adicional.
;;

(defrule mover-bloque-sobre-bloque-b
   ?objetivo <- (objetivo (objeto-debajo ?bloque-1&:(neq ?bloque-1 SUELO)) (objeto-encima ?bloque-2&:(neq ?bloque-2 SUELO)))   
   ?hecho-1 <- (objeto (nombre ?bloque-1&:(neq ?bloque-1 ?bloque-2)) (tiene-debajo ?objeto-3) (tiene-encima NADA))   
   ?hecho-2 <- (objeto (nombre ?bloque-2&:(neq ?bloque-2 SUELO)) (tiene-debajo SUELO) (tiene-encima NADA))
 =>
   (retract ?objetivo ?hecho-1 ?hecho-2 )
   (assert (objeto (nombre ?bloque-1) (tiene-debajo ?objeto-3) (tiene-encima ?bloque-2)))   
   (assert (objeto (nombre ?bloque-2) (tiene-debajo ?bloque-1) (tiene-encima NADA)))
   (bind ?camino (new java.lang.String))
   (bind ?camino (new java.lang.String(call ?camino concat (fetch CAMINO))))
   (bind ?camino (new java.lang.String(call ?camino concat ?bloque-2) ))
   (bind ?camino (new java.lang.String(call ?camino concat " movido encima del ")))
   (bind ?camino (new java.lang.String(call ?camino concat ?bloque-1)))
   (bind ?camino (call ?camino concat ";"))
   (store CAMINO (call ?camino toString))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; La situacion: tenemos como objetivo poner el bloque-2 sobre el suelo . 
;; Habra que eliminar el objeto tal y como estaban e introducirlo con
;; el movimiento hecho. En esta regla, el bloque-2 esta encima del bloque-4, luego no hay que
;; introducir un hecho nuevo que refleje que el bloque-4 ya no tiene nada encima.
;;
(defrule mover-bloque-al-suelo-a
   ?objetivo <- (objetivo (objeto-debajo SUELO) (objeto-encima ?bloque-2&:(neq ?bloque-2 SUELO)))   
   ?hecho-2 <- (objeto (nombre ?bloque-2&:(neq ?bloque-2 SUELO)) (tiene-debajo ?bloque-4&:(neq ?bloque-4 SUELO)) (tiene-encima NADA))
   ?hecho-3 <- (objeto (nombre ?bloque-4)  (tiene-debajo ?objeto-5) (tiene-encima ?bloque-2)) 
 =>
   (retract ?objetivo ?hecho-2 ?hecho-3)
   (assert (objeto (nombre ?bloque-2) (tiene-debajo SUELO) (tiene-encima NADA)))
   (assert (objeto (nombre ?bloque-4) (tiene-debajo ?objeto-5) (tiene-encima NADA)))   
   (bind ?camino (new java.lang.String))
   (bind ?camino (new java.lang.String(call ?camino concat (fetch CAMINO))))
   (bind ?camino (new java.lang.String(call ?camino concat ?bloque-2)))
   (bind ?camino (new java.lang.String(call ?camino concat " movido encima del suelo;")))
   (store CAMINO (call ?camino toString))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; La situacion: tenemos como objetivo poner el bloque-1 sobre algo (?), pero el bloque-1
;; tiene encima el bloque-2. Lo que habra que hacer es quitar el bloque-2 de encima del bloque-1
;; y ese es el objetivo que se introduce.
;;
;;

(defrule libera-bloque-movible
   (objetivo (objeto-debajo ?bloque-3) (objeto-encima ?bloque-1&:(neq ?bloque-1 SUELO)))
   (objeto (nombre ?bloque-1) (tiene-debajo ?bloque-4&:(neq ?bloque-4 ?bloque-3)) (tiene-encima ?bloque-2&:(neq ?bloque-2 NADA)))
 =>
   (assert (objetivo (objeto-debajo SUELO) (objeto-encima ?bloque-2))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; La situacion: tenemos como objetivo poner un bloque sobre el objeto-1, pero el objeto-1
;; tiene encima el bloque-2. Lo que habra que hacer es quitar el bloque-2 de encima del objeto-1
;; y ese es el objetivo que se introduce.
;;
(defrule libera-bloque-soporte
   (objetivo (objeto-debajo ?objeto-1) (objeto-encima ?bloque-1&:(neq ?bloque-1 SUELO)))
   (objeto (nombre ?objeto-1) (tiene-debajo ?) (tiene-encima ?bloque-2&:(neq ?bloque-2 NADA)))	
   (objeto (nombre ?bloque-1) (tiene-debajo ?bloque-3&:(neq ?bloque-3 ?objeto-1)))
 =>
   (assert (objetivo (objeto-debajo SUELO) (objeto-encima ?bloque-2))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; La situacion: tenemos un objetivo que ya esta cumplido. Lo que hay que hacer es eliminarlo
;; de la memoria de trabajo	
;;
(defrule cumplido
	?objetivo<-(objetivo (objeto-debajo ?objeto-1) (objeto-encima ?objeto-2))
	(objeto (nombre ?objeto-1) (tiene-encima ?objeto-2))
	=>
	(retract ?objetivo)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; La situacion: objetivo colocar el suelo sobre algún sitio. Es un objetivo imposible por
;; lo que no hacemos nada, y simplemente lo eliminamos 
;;
(defrule error
	?objetivo<-(objetivo (objeto-debajo ?objeto-1) (objeto-encima SUELO))
	=>
	(retract ?objetivo)
)