;; 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
    )
  )
)