;;; Fichier bataille00.drs / 3 mars 2000

(define (melange l n)
  (if (or (null? l) (= n 0)) l
      (melange (insert (car l) (cdr l)) (- n 1))))
 
(define (insert el l)
  (let ((n (random (length l))))
    (append (nthcar l (- n 1)) (list el) (nthcdr l n))))

(define val '(2 3 4 5 6 7 8 9 10 v d r 1))

(define (jeu-de-cartes)
  (append (associe 'carreau) (associe 'pique) (associe 'trefle) (associe 'coeur)))

(define (associe couleur)
  (map (lambda (x) (list x couleur)) val))

(define (distribue l)
  (let ((n (/ (length l) 2))) (list (nthcar l (- n 1)) (nthcdr l n))))

(define (bataille)
  (let* ((j1 (saisie 1)) (j2 (saisie 2))
         (donne (distribue (melange (jeu-de-cartes) 50)))
         (d1 (car donne)) (d2 (cadr donne)))
    (affichage-gain j1 j2 d1 d2)
    (boucle j1 j2 d1 d2 0)))

(define (boucle j1 j2 d1 d2 k)
  (if (or (null? (nthcdr d1 k)) (null? (nthcdr d2 k))) (conclusion j1 j2 d1 d2)
      (begin (affichage j1 j2 d1 d2 k)
             (cond ((or (eq? (read) 'q) (null? d1) (null? d2)) 
                    (conclusion j1 j2 d1 d2))
                   ((egal? (nth d1 k) (nth d2 k))
                    (display "bataille!") (newline)
                    (boucle j1 j2 d1 d2 (+ k 2)))
                   ((sup? (nth d1 k) (nth d2 k))
                    (tour-suivant j1 j2 (ramasse d1 d2 k) (nthcdr d2 (+ k 1))))
                   (else (tour-suivant j1 j2 (nthcdr d1 (+ k 1)) (ramasse d2 d1 k)))))))

(define (tour-suivant j1 j2 d1 d2)
  (affichage-gain j1 j2 d1 d2) (boucle j1 j2 d1 d2 0))

(define (ramasse d1 d2 k)
  (append (nthcdr d1 (+ k 1)) (nthcar d1 k) (nthcar d2 k)))

(define (affichage j1 j2 d1 d2 k)
  (affichage-cartes j1 (nthcar d1 k))
  (affichage-cartes j2 (nthcar d2 k))
  (display "suite ? "))

(define (affichage-cartes j1 liste-cartes)
  (define (aux l)
    (cond ((null? l) (newline))
          (else (display (car l)) (aux (cdr l)))))
  (display j1) (display " : ") (aux liste-cartes))

(define (affichage-gain j1 j2 d1 d2)
  (newline) (printf " ~a a ~a cartes, ~a a ~a cartes" j1 (length d1) j2 (length d2))
  (newline) (newline))

(define (saisie i) (printf "nom du joueur ~a ? " i) (read))

(define (sup? c1 c2) 
  (> (length (member (car c2) val))
     (length (member (car c1) val))))

(define (egal? c1 c2) (eq? (car c1) (car c2)))

(define (conclusion j1 j2 d1 d2)
  (if (= (length d1) (length d2)) (display "egalite!")
      (printf " ~a a gagne!" (if (> (length d1) (length d2)) j1 j2))))

(define (nth l n) (if (= n 0) (car l) (nth (cdr l) (- n 1))))

(define (nthcar l n) (if (< n 0) () (cons (car l) (nthcar (cdr l) (- n 1)))))

(define (nthcdr l n) (if (or (= n 0) (null? l)) l (nthcdr (cdr l) (- n 1))))