rendered paste body;; Partie données durables et objets
;;Objet joueur
(define joueur
(lambda (id billes_gagnées couleur) ;;le nom du joueur doit être le même que celui sur lequel on applique l'objet
(let
(
(gagne_bille!
(lambda (value)
(set! billes_gagnées (append billes_gagnées (list value)))
)
)
)
(lambda (msg)
(cond
((eq? msg 'id) id)
((eq? msg 'billes_gagnées) billes_gagnées)
((eq? msg 'point) (length billes_gagnées))
((eq? msg 'gagne_bille!) gagne_bille!)
((eq? msg 'couleur) couleur)
((eq? msg 'a_gagné?) (>= (length billes_gagnées) 6) )
)
)
)
)
)
(define (id joueur) (joueur 'id))
(define (billes_gagnées joueur) (joueur 'billes_gagnées))
(define (point joueur) (joueur 'point))
(define (gagne_bille! joueur value) ((joueur 'gagne_bille!) value))
(define (couleur joueur) (joueur 'couleur))
(define (a_gagné? joueur) (joueur 'a_gagné?))
;;Objet partie
(define partie
(lambda (liste_joueurs joueur_en_cours plateau état deb_sel fin_sel liste_directions canvas gagnant)
(let*
(
(joueur_suivant!
(lambda ()
(cond
(
(equal? (car liste_joueurs) joueur_en_cours)
(set! joueur_en_cours (cadr liste_joueurs))
)
(
(equal? (cadr liste_joueurs) joueur_en_cours)
(if
(= (length liste_joueurs) 3)
(set! joueur_en_cours (caddr liste_joueurs))
(set! joueur_en_cours (car liste_joueurs))
)
)
(
(equal? (caddr liste_joueurs) joueur_en_cours)
(set! joueur_en_cours (car liste_joueurs))
)
)
)
)
(debug_état
(lambda (état)
(cond
((= état 1) (printf "attente de choix des préférences"))
((= état 2) (printf "attente de début de sélection"))
((= état 3) (printf "attente de choix de direction"))
((= état 4) (printf "fin de partie"))
)
)
)
(changer_état!
(lambda (value)
(set! état value)
(if
canvas
(send canvas on-paint)
)
)
)
(début_sélection!
(lambda (position)
(set! deb_sel position)
)
)
(fin_sélection!
(lambda (position)
(set! fin_sel position)
(if
(ligne_valide? plateau (créer_ligne deb_sel fin_sel) (couleur joueur_en_cours) )
(and
(set! liste_directions (directions_autorisées plateau (créer_ligne deb_sel fin_sel)))
(if
(> (length liste_directions) 0)
(changer_état! 3)
)
)
)
)
)
(jouer!
(lambda (direction)
(if
(position_dans_liste? direction liste_directions)
(let
(
(plateau_et_tombée (appliquer_mouvement plateau (créer_ligne deb_sel fin_sel) direction))
)
(set! plateau (car plateau_et_tombée))
(if
(cadr plateau_et_tombée) ;; si une bille est tombée
(gagne_bille! joueur_en_cours (cadr plateau_et_tombée)) ;; la donner au joueur en cours
)
(if
(a_gagné? joueur_en_cours)
(begin
(set! gagnant joueur_en_cours)
(changer_état! 4) ;; s'il a gagné ...
)
(and ;; s'il a pas gagné, au suivant
(joueur_suivant!)
(changer_état! 2)
)
)
)
(changer_état! 2)
)
)
)
(str_liste_joueurs
(lambda (liste)
(letrec
(
(concat
(lambda (num)
(printf "~a " (string-append "joueur" (number->string num)))
)
)
)
(map concat (map id liste))
)
)
)
(assigner_canvas!
(lambda (uncanvas)
(set! canvas uncanvas)
)
)
)
(lambda (msg)
(cond
((eq? msg 'liste_joueurs) liste_joueurs)
((eq? msg 'joueur_en_cours) joueur_en_cours)
((eq? msg 'joueur_suivant!) joueur_suivant!)
((eq? msg 'plateau) plateau)
((eq? msg 'état) état)
((eq? msg 'changer_état!) changer_état!)
((eq? msg 'debug_état) debug_état)
((eq? msg 'début_sélection!) début_sélection!)
((eq? msg 'fin_sélection!) fin_sélection!)
((eq? msg 'liste_directions) liste_directions)
((eq? msg 'jouer!) jouer!)
((eq? msg 'sélection) (créer_ligne deb_sel fin_sel))
((eq? msg 'str_liste_joueurs) str_liste_joueurs)
((eq? msg 'assigner_canvas!) assigner_canvas!)
((eq? msg 'canvas) canvas)
((eq? msg 'gagnant) gagnant)
)
)
)
)
)
(define (liste_joueurs partie) (partie 'liste_joueurs))
(define (joueur_en_cours partie) (partie 'joueur_en_cours))
(define (joueur_suivant! partie) ((partie 'joueur_suivant!)))
(define (plateau partie) (partie 'plateau))
(define (état partie) (partie 'état))
(define (changer_état! partie valeur) ((partie 'changer_état!) valeur))
(define (debug_état partie) ((partie 'debug_état) (partie 'état)))
(define (début_sélection! partie position) ((partie 'début_sélection!) position))
(define (fin_sélection! partie position) ((partie 'fin_sélection!) position))
(define (liste_directions partie) (partie 'liste_directions))
(define (jouer! partie direction) ((partie 'jouer!) direction))
(define (sélection partie) (partie 'sélection))
(define (str_liste_joueurs partie) ((partie 'str_liste_joueurs) (liste_joueurs partie)))
(define (assigner_canvas! partie canvas) ((partie 'assigner_canvas!) canvas))
(define (canvas partie) (partie 'canvas))
(define (gagnant partie) (partie 'gagnant))
;; Fonction d'aide pour créer une partie à 2
(define partie_à_2
(lambda (couleur1 couleur2)
(let
(
(joueur1 (joueur 1 (list) couleur1))
(joueur2 (joueur 2 (list) couleur2))
(filtre
(lambda (valeur)
(cond
((equal? valeur 1) couleur1)
((equal? valeur 2) couleur2)
(else valeur)
)
)
)
)
(partie (list joueur1 joueur2) joueur1 (double_map filtre plateau2) 2 (pos -1 -1) (pos -1 -1) (list) #f joueur1)
)
)
)
;; Fonction d'aide pour créer une partie à 3
(define partie_à_3
(lambda (couleur1 couleur2 couleur3)
(let
(
(joueur1 (joueur 1 (list) couleur1))
(joueur2 (joueur 2 (list) couleur2))
(joueur3 (joueur 3 (list) couleur3))
(filtre
(lambda (valeur)
(cond
((equal? valeur 1) couleur1)
((equal? valeur 2) couleur2)
((equal? valeur 3) couleur3)
(else valeur)
)
)
)
)
(partie (list joueur1 joueur2 joueur3) joueur1 (double_map filtre plateau3) 2 (pos -1 -1) (pos -1 -1) (list) #f joueur1)
)
)
)
;; Fonction de sauvegarde dans un fichier savepart.sav
;; On ne peut choisir le fichier ni le dossier ou il est
;; inscrit
(define sauvegarder
(lambda (lapartie)
(with-output-to-file
"./savepart.sav"
(lambda ()
(let
(
(écrire_joueur
(lambda (joueur) ;;rien
(printf " (joueur~a (joueur ~a '~a ~a))~n" (id joueur) (id joueur) (billes_gagnées joueur) (couleur joueur) )
)
)
)
(begin
(printf"(define sauvegarde~n (lambda ()~n (let~n (~n")
(map écrire_joueur (liste_joueurs lapartie))
(printf " (plateau '~a)~n )~n (partie (list " (plateau lapartie))
(str_liste_joueurs lapartie)
(printf ") ~a plateau ~a '~a '~a '~a #f ~a)~n )~n )~n)~n"
(string-append "joueur" (number->string (id (joueur_en_cours lapartie))))
(état lapartie)
(début (sélection lapartie))
(fin (sélection lapartie))
(liste_directions lapartie)
(string-append "joueur" (number->string (id (gagnant lapartie))))
)
)
)
)
'replace
)
)
)