;;;; Fichier Awele.drs / 29 mars 1999

;;; REGLE DE l'AWELE
;;; 2 lignes de 6 cases (4 graines par case), numerotees de 0 a 5:
;;; joueur Nord: 5 4 3 2 1 0
;;; joueur Sud:  0 1 2 3 4 5
;;; Coup = distribuer une case de son camp graine par graine vers la droite,
;;; en bouclant en sens trigo (camp adverse, retour dans son camp, etc.) 
;;; Prise si arret sur case adverse de 2 ou 3 graines =
;;; prendre toutes les cases adverses contigues de 2 ou 3 graines qui ont ete visitees

(define (awele) (boucle "Nord" "Sud" '(4 4 4 4 4 4) '(4 4 4 4 4 4) 0 0))

(define (boucle j1 j2 l1 l2 g1 g2)
  (affiche-jeu j1 j2 l1 l2 g1 g2)
  (let ((position1 (saisie j1)))
    (if (eq? position1 'q) (affiche-gagnant j1 j2 g1 g2)
	(let* ((res (joue position1 l1 l2 g1))
	       (newl1 (car res))
	       (newl2 (cadr res))
	       (newg1 (caddr res)))
	  (boucle j2 j1 newl2 newl1 g2 newg1)))))

(define (affiche-gagnant j1 j2 g1 g2)
  (display "le gagnant est :") (display (cond ((> g1 g2) j1) ((< g1 g2) j2) (else "exaequo"))))

(define (affiche-jeu j1 j2 l1 l2 g1 g2)
  (cond ((equal? j1 "Sud") (affiche-jeu j2 j1 l2 l1 g2 g1))
	(else (newline)
	      (display j1) (display "=") (display g1) (newline)
	      (map (lambda (x) (display x) (display " ")) (reverse l1)) (newline)
	      (map (lambda (x) (display x) (display " ")) l2) (newline)
	      (display j2) (display "=") (display g2) (newline))))

;;; Saisie d'une position pour j1 (de 0 a 5 dans le sens gauche-droite)

(define (saisie j1)
  (newline) (display "position pour ") (display j1) (display " ? ") (read))


;;; Jouer un coup:
;;; 1- distribution des graines dans son camp vers la droite
;;; 2- prolongement en sens contraire dans le camp adverse s'il reste des graines, 
;;;   (avec eventuellement prise si arret sur case de 2 ou 3 graines)
;;; 3- prolongement dans son propre camp s'il reste des graines, 
;;; avec boucle sur 2 et 3
;;; La fonction (joue n1 l1 l2 g1) ramene un triplet avec les 2 nouvelles lignes des joueurs
;;; et le nouveau gain du joueur qui a joue
  
(define (joue n1 l1 l2 g1)
  (let* ((res (vide n1 l1))
	 (x (car res))
	 (newl1 (cadr res)))
    (if (= x 0) 
	(list newl1 l2 g1)
	(tourne x newl1 l2 g1))))

(define (tourne x l1 l2 g1)
  (let* ((res (distribue-avec-prise x l2))
	 (x2 (car res))
	 (gain (cadr res))
	 (newl2 (caddr res)))
    (if (= x2 0) 
	(list l1 newl2 (+ g1 gain))
	(let* ((res (distribue x2 l1))
	       (x1 (car res))
	       (newl1 (cadr res)))
	  (if (= x1 0) 
	      (list newl1 newl2 g1)
	      (tourne x1 newl1 newl2 g1))))))

(define (vide n l)
  (define (aux n l debut-ligne)
    (cond ((= n 0) 
	   (let* ((restmp (distribue (car l) (cdr l)))
		  (x (car restmp))
		  (fin-ligne (cadr restmp)))
	     (list x (append (reverse debut-ligne) (list 0) fin-ligne))))
	   (else (aux (- n 1) (cdr l) (cons (car l) debut-ligne)))))
  (aux n l ()))

(define (distribue x l)
  (define (aux x l res)
    (cond ((null? l) (list x (reverse res)))
	  ((= x 0) (list 0 (append (reverse res) l)))
	  (else (aux (- x 1) (cdr l) (cons (+ (car l) 1) res)))))
  (aux x l ()))

(define (distribue-avec-prise x l)
  (define (aux x l res)
    (cond ((null? l) (list x 0 (reverse res)))
	  ((= x 0)
	   (let* ((restmp (prise res))
		  (gain (car restmp))
		  (newres (cadr restmp)))
	     (list 0 gain (append (reverse newres) l))))   
	  (else (aux (- x 1) (cdr l) (cons (+ (car l) 1) res)))))
  (aux x l ()))

(define (prise l)
  (define (aux l gain res)
    (cond ((or (null? l) (not (member (car l) '(2 3)))) (list gain (append (reverse res) l)))
	  (else (aux (cdr l) (+ (car l) gain) (cons 0 res)))))
  (aux l 0 ()))