; ********************************************************
;  ICSE
;  blocchi.clp
;  2012, ndm
; ********************************************************
; Si vuole implementare un sistema a regole per la 
; risoluzione di un problema del mondo dei blocchi.
; Supponiamo di avere la seguente configurazione iniziale
;
;  A  D
;  B  E
;  C  F
;
; e di voler mettere il blocco C su blocco F.
; ********************************************************

(deftemplate sopra-a "Indica che un blocco è su un altro"
   (slot sopra)
   (slot sotto))

(deftemplate obiettivo "Descrive un obiettivo"
   (slot sposta)
   (slot sopra-a))
   
(defrule sposta "Sposta un blocco libero su un altro blocco libero"
   ?obiettivo <- (obiettivo (sposta ?blocco1) (sopra-a ?blocco2))
   (blocco ?blocco1)
   (blocco ?blocco2)
   (sopra-a (sopra niente) (sotto ?blocco1))
   ?pila1 <- (sopra-a (sopra ?blocco1) (sotto ?blocco3))
   ?pila2 <- (sopra-a (sopra niente) (sotto ?blocco2))
   =>
   (retract ?obiettivo ?pila1 ?pila2)
   (assert (sopra-a (sopra ?blocco1) (sotto ?blocco2))
           (sopra-a (sopra niente) (sotto ?blocco3)))
   (printout t "Sposta " ?blocco1 " sopra a " ?blocco2 "." crlf))

(defrule sposta-sul-piano "Sposta un blocco libero sul piano"
   ?obiettivo <- (obiettivo (sposta ?blocco1) (sopra-a piano))
   (blocco ?blocco1)
   (sopra-a (sopra niente) (sotto ?blocco1))
   ?pila <- (sopra-a (sopra ?blocco1) (sotto ?blocco2))
   =>
   (retract ?obiettivo ?pila)
   (assert (sopra-a (sopra ?blocco1) (sotto piano))
           (sopra-a (sopra niente) (sotto ?blocco2)))
   (printout t "Sposta " ?blocco1 " sul piano." crlf))

(defrule libera-blocco-partenza 
	"Stabilisce l'obiettivo di liberare il blocco di partenza"
   (obiettivo (sposta ?blocco1) (sopra-a ?))  ; Si noti il wild card.
   (blocco ?blocco1)
   (sopra-a (sopra ?blocco2) (sotto ?blocco1))
   (blocco ?blocco2)
   =>
   (assert (obiettivo (sposta ?blocco2) (sopra-a piano))))

(defrule libera-blocco-arrivo
	 "Stabilisce l'obiettivo di liberare il blocco d'arrivo"
   (obiettivo (sposta ?) (sopra-a ?blocco1))  ; Di nuovo il wild card.
   (blocco ?blocco1)
   (sopra-a (sopra ?blocco2) (sotto ?blocco1))
   (blocco ?blocco2)
   =>
   (assert (obiettivo (sposta ?blocco2) (sopra-a piano))))

(deffacts stato-iniziale "A/B/C, D/E/F, e vogliamo mettere C su F."
   (blocco A)
   (blocco B)
   (blocco C)
   (blocco D)
   (blocco E)
   (blocco F)
   (sopra-a (sopra niente) (sotto A))
   (sopra-a (sopra A) (sotto B))
   (sopra-a (sopra B) (sotto C))
   (sopra-a (sopra C) (sotto piano))
   (sopra-a (sopra niente) (sotto D))
   (sopra-a (sopra D) (sotto E))
   (sopra-a (sopra E) (sotto F))
   (sopra-a (sopra F) (sotto piano))
   (obiettivo (sposta C) (sopra-a F)))