(defvar *state* '((red-riding-hood (alive t) (place mum-home))
(wolf (alive t) (place wood))
(granny (alive t) (place granny-home))
(hunter (alive t) (place hunter-home))))
(defun set-value (person property val state)
"Fonction permettant de mettre à jour la valeur
d'une propriété d'un protagoniste dans l'état du monde"
(setf (cadr (assoc property (cdr (assoc person state)))) val))
(defun get-value (person property state)
(cadr (assoc property (cdr (assoc person state)))))
(defun apply-effect (effect person value state)
"Fonction qui applique un seul changement de valeur dans
l'état du monde après une action"
(format t "~%APPLY EFFECT : ~s ~s ~s" effect person value)
(cond
((equal effect 'moved)
(set-value person 'place value state))
((equal effect 'eaten)
(progn
(set-value person 'alive nil state)
(set-value person 'place 'wolf-belly state)))
((equal effect 'killed)
(set-value person 'alive nil state))
((equal effect 'risen)
(if value
(set-value person 'alive t state)))))
;; Appels de la fonction apply-effect à l'intérieur du main
; (print (apply-effect 'moved 'wolf 'granny-home *state*))
; (print *state*)
; (apply-effect 'eaten 'granny nil *state*)
; (print *state*)
; (apply-effect 'moved 'hunter 'granny-home *state*)
;(print *state*)
; (apply-effect 'killed 'wolf nil *state*)
; (print *state*)
; (apply-effect 'risen 'granny t *state*)
; (print *state*)
;; Fonction pour obtenir la valeur d'une propriété pour une personne dans l'état
(defun rules (actor action &optional person cc state)
"Fonction qui applique les effets des actions ou des dialogues."
(cond
;; Action "kill"
((equal action 'kill)
(apply-effect 'killed person cc state) ; Applique l'effet killed
(when (equal person 'wolf) ; Si la personne tuée est le loup
;; Vérifie si le chaperon rouge est dans le ventre du loup
(when (equal (get-value 'red-riding-hood 'place state) 'wolf-belly)
(apply-effect 'risen 'red-riding-hood t state)
(apply-effect 'moved 'red-riding-hood 'granny-home state)) ; Déplace le chaperon rouge
;; Vérifie si la grand-mère est dans le ventre du loup
(when (equal (get-value 'granny 'place state) 'wolf-belly)
(apply-effect 'risen 'granny t state)
(apply-effect 'moved 'granny 'granny-home state)))) ; Déplace la grand-mère
;; Action "eat"
((equal action 'eat)
(apply-effect 'eaten person nil state) ; Applique l'effet eaten sur la personne
(apply-effect 'moved person 'wolf-belly state)) ; Déplace la personne dans le ventre du loup
((equal action 'move)
(apply-effect 'moved actor cc state))
((equal action 'greet)
(format t "Dialogue: ~a says hello to ~a." actor person))
((equal action 'give)
(format t "Dialogue: ~a gives an item to ~a." actor person))
((equal action 'tell)
(format t "Dialogue: ~a tells something to ~a." actor person))))
(defvar *states* '((RED-RIDING-HOOD (ALIVE T) (PLACE MUM-HOME))
(WOLF (ALIVE T) (PLACE GRANNY-HOME))
(GRANNY (ALIVE T) (PLACE GRANNY-HOME)) (HUNTER (ALIVE T) (PLACE WOOD))))
(rules 'wolf 'eat 'granny 'granny-home *states*)
(print *states*)
(defun apply-change-scene (change state)
"Fonction qui applique les règles pour effectuer la transition entre les scènes
et met à jour l'état du monde."
(format t "~%---------------------- apply change scene ------------------")
(format t "~% Transition de scène : ~s" change)
(format t "~% Etat actuel : ~s" state)
(cond
((equal change '(s2 s3))
(progn
(format t "~% Scène : Le loup se déplace chez la grand-mère.")
(rules 'wolf 'move 'granny-home state)
(format t "~% Dialogue : Le loup et la grand-mère discutent.")
(rules 'wolf 'greet 'granny state)
(format t "~% Action : Le loup mange la grand-mère.")
(rules 'wolf 'eat 'granny state)
))
((equal change '(s3 s4))
(progn
(format t "~% Scène : Le loup prend la place de la grand-mère.")
(rules 'wolf 'move 'granny-home state)
))
((equal change '(s4 s5))
(progn
(format t "~% Scène : Le loup mange le Petit Chaperon Rouge.")
(rules 'wolf 'eat 'red-riding-hood state)
))
((equal change '(s5 s6))
(progn
(format t "~% Scène : Le loup fait une sieste dans la forêt.")
(rules 'wolf 'move 'wood state)
))
((equal change '(s5 s7))
(progn
(format t "~% Scène : Le chasseur tue le loup.")
(rules 'hunter 'kill 'wolf state)
(format t "~% Action : Le chasseur sauve les personnages dans le ventre du loup.")
;; Vérifie si des personnages doivent être ressuscités
(rules 'wolf 'release 'granny state)
(rules 'wolf 'release 'red-riding-hood state)
))
((equal change '(s6 s7))
(progn
(format t "~% Scène : Le chasseur tue le loup dans la forêt.")
(rules 'hunter 'kill 'wolf state)
(format t "~% Action : Libération de personnages.")
(rules 'wolf 'release 'granny state)
(rules 'wolf 'release 'red-riding-hood state)
))
((equal change '(s7 s8))
(progn
(format t "~% Scène : Le Petit Chaperon Rouge donne un gâteau à sa grand-mère.")
(rules 'red-riding-hood 'give 'granny state)
))
((equal change '(s8 outcome))
(format t "~% Fin de l'histoire : Le Petit Chaperon Rouge et sa grand-mère sont sauvés."))
((equal change '(s3 island))
(format t "~% Fin alternative : Le loup mange la grand-mère et s'endort."))
(t (format t "~% Transition non reconnue pour cette scène : ~s" change))
)
(format t "~%---------------------- Fin de la transition ------------------")
)
(defun successeursValides( scene story chemin )
(let (( ( cdr (assoc scene story)) successeurs ) (successeurs-valides nil))
( dolist( x successeurs successeurs-valides)
(if (not member x chemin ) ( push x successeurs-valides)))
))
(defun generate_scenario (etat sortie story
state
&optional (scenario nil))
"Fonction qui cherche un scénario qui mène à l'outcome et
qui en cas d'impasse (island) remonte jusquà une scène
qui a des successeurs valides
et qui repart de l'état du monde de cette scène"
(
format
t
"~%========= Explore =========~%Etat ~s state : ~s"
etat
state
)
;; Insères ton code
;; La fonction devra afficher
;; - Le scénario avec la sauvegardes des scènes et leur état du monde (sc
;; - Les transitions (etat X vers Y),
y
compris les retours en arrière
;; (
format
t
"~%De ~s je vais en ~s"
...
;; (
format
t
"~%De ~s je vais en ~s"
...
)
;; Par exemple l
'appel suivant pourrait renvoyer le scénario suivant
? (generate-scenario '
initialNode
'outcome *story* *states*))
((INITIALSCENE ((RED-RIDING-HOOD (ALIVE T) (PLACE MUM-HOME)) (WOLF (ALIVE T)
(S1 ((RED-RIDING-HOOD (ALIVE T) (PLACE WOOD)) (WOLF (ALIVE T) (PLACE WOOD))
(S5 ((RED-RIDING-HOOD (ALIVE NIL) (PLACE WOLF-BELLY)) (WOLF (ALIVE T) (PLACE
(S7 ((RED-RIDING-HOOD (ALIVE T) (PLACE WOOD)) (WOLF (ALIVE NIL) (PLACE WOOD)
(OUTCOME ((RED-RIDING-HOOD (ALIVE T) (PLACE WOOD)) (WOLF (ALIVE NIL) (PLACE
(defun generate_scenario (etat sortie story
state
&optional (scenario nil))
( push ( list etat state) scenario)
( if (equal etat 'outcome) scenario
( let ((successers_valides etat chemin story) scenes_suivantes ) (sol nil)
( while (and scenes_suivantes ) ( not sol)
( progn
(format t "~%De ~s je vais en ~s" etat (car scenes_suivantes) )
( apply-change-scene etat (car scenes_suivantes) )
( if ( equal (car scenes_sivantes) island )
( ( format t "~%De ~s je retourne en ~s" island (car scenes_suivantes) )
( apply-change-scene island (car scenes_suivantes) )
( setq sol (generate -scenario (car scenes_suivantes) sortie story state) )
( if (not sol ) ( format t "~%De ~s je retourne ~s " ( (pop scenes-suivantes) etat ) )
(pop scenes_suivantes) )) sol)
)
)
)
)
(defun generate-scenario (etat sortie story state &optional (scenario nil))
"Fonction qui cherche un scénario qui mène à l'outcome et
qui, en cas d'impasse (island), remonte jusqu'à une scène
ayant des successeurs valides et repart de l'état du monde de cette scène."
(format t "~%========= Explore =========~%Etat ~s state : ~s" etat state)
(push (list etat state) scenario) ; couple (etat state)
(if (equal etat sortie)
scenario
;; Sinon, chercher les successeurs valides
(let ((successeurs-scenes (successeurs-valides etat story scenario)) ; Obtenir les scènes successeurs valides
(solution nil)) ; Solution trouvée ou non
(while (and successeurs-scenes (not solution))
(let ((scene-suivante (car successeurs-scenes))) ; Prendre la première scène
(format t "~%De ~s je vais en ~s" etat scene-suivante)
;; Appliquer le changement de scène
(apply-change-scene scene-suivante state)
;; Si la scène actuelle est une impasse (island)
(if (equal scene-suivante 'island)
(progn
(format t "~%De ~s je retourne à ~s" 'island etat)
(apply-change-scene etat state)
(setq solution
(generate-scenario etat sortie story state scenario)))
(setq solution
(generate-scenario scene-suivante sortie story state scenario)))
(if (not solution)
(progn
(format t "~%De ~s je retourne à ~s" scene-suivante etat)
(pop successeurs-scenes)))))
solution)))
