;;; Fichier navale02.drs / 29 mars 2002

(define g
  '((- - - - - - - - - -)
    (- - - - - - - - o -)
    (- - - - - - - - o -)
    (- - - - - - - - o -)
    (- - - - - o o - o -)
    (- - - - - - - - - -)
    (- - o o o - - - - -)
    (- - - - - - - - - -)
    (- o o o o o - - o -)
    (- - - - - - - - - -)))

(define (dessine-coup g1 g2)
  (newline) (display "    1 2 3 4 5 6 7 8 9 10   1 2 3 4 5 6 7 8 9 10") (newline)
  (let aux ((g1 g1) (g2 g2) (lettres '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J")))
    (cond ((or (null? g1) (null? g2)) (display ""))
          (else (display (car lettres)) (display "   ") (dessine-ligne (car g1)) (display "   ") 
                (dessine-ligne-ordi (car g2)) (newline)
                (aux (cdr g1) (cdr g2) (cdr lettres))))))

(define (dessine-ligne l)
  (cond ((null? l) ())
        (else (display (car l)) (display " ") (dessine-ligne (cdr l)))))

(define (dessine-ligne-ordi l)
  (cond ((null? l) ())
        (else (display (if (or (equal? (car l) 'r) (equal? (car l) 't)) (car l) '-)) (display " ")
              (dessine-ligne-ordi (cdr l)))))

                                    
;;; Choix des coups:

(define (coup-ordi g)
  (let* ((X (list-ref '(A B C D E F G H I J) (random 10))) (k (+ 1 (random 10)))
         (c (quoi g X k)))
    (cond ((or(equal? 'O c)(equal? '- c)) 
           (display (format  "L'ordinateur joue: ~a~a" X k)) (newline) (list X k))
          (else (coup-ordi g)))))


(define (choix-coup g)
  (let essai ()
    (let ((caseg (saisie-case)))
      (cond ((null? caseg) (display "cliquez sur une case de la grille de droite ou sur stop") (essai))
	    ((equal? 'Q caseg) 'stop)
	    ((member (quoi g (car caseg)(cadr caseg))(list 'R 'T))
	     (display "cliquez sur une case non jouee")(essai))
	    (else caseg)))))

(define (saisie-case)
  (display "Saisir lettre (Q pour quitter): ") 
  (let ((x (read)))
    (if (equal? x 'Q) x
        (begin (display "Saisir chiffre: ") (list x (read))))))

(define (quoi g X k)
  (define (quoi-ligne l k)
    (cond ((null? l) ())
          ((= k 1) (car l))
          (else (quoi-ligne (cdr l) (- k 1)))))
  (cond ((null? g) ())
        ((equal? X 'A) (quoi-ligne (car g) k))
        (else (quoi (cdr g) (prec X) k))))

;;; Modifier la grille en conséquence du coup:

(define (modif g2 coup)
  (let* ((X (car coup))
         (k (cadr coup))
         (v (quoi g2 X k)))
    (cond((equal? v 'O)(change g2 X k 'T))  ; O=bateau  T= coule R=rien
         (else (change g2 X k 'R)))))

(define (change g X k val)
  (define (change-ligne l k)
    (cond ((null? l) ())
          ((= k 1) (cons val (cdr l)))
          (else (cons (car l) (change-ligne (cdr l) (- k 1))))))
  (cond ((null? g) ())
        ((equal? X 'A) (cons (change-ligne (car g) k) (cdr g)))
        (else (cons (car g) (change (cdr g) (prec X) k val)))))

(define (prec X)
  (let ((l (member X '(J I H G F E D C B A)))) (if (null? (cdr l)) () (cadr l))))

;;; Fin du jeu:

(define (fini? g) (= 0 (compter 'O g)))

(define (compter z g)
  (let aux ((nbre 0) (l1 (cdr g)) (l2 (car g)))
    (cond ((and (null? l1) (null? l2)) nbre)
          ((null? l2)(aux nbre (cdr l1) (car l1)))
          (else (aux (if (equal? z (car l2)) (+ nbre 1) nbre) l1 (cdr l2))))))

(define (fin-de-partie)  (display "arret de la partie par abandon du joueur "))

(define (gagnant j)
  (display (format "le joueur ~a a gagne cette partie" 
	   (if (equal? j 'ordi) "ordinateur" "humain"))))

;;; La boucle de jeu:

(define (batnav)
  (define (boucle g1 g2); j1 est le joueur dont c'est le tour 
    (dessine-coup g1 g2)
    (let* ((coup2 (choix-coup g2)))
      (cond ((equal? 'stop coup2) (fin-de-partie))
            (else (let* ((coup1 (coup-ordi g1))(g2 (modif g2 coup2)) (g1 (modif g1 coup1)))
                    (cond ((fini? g2) (gagnant 'h))
                          ((fini? g1) (gagnant 'ordi))
                          (else (boucle g1 g2))))))))
  (boucle g (grille-ordi)))


(define (grille-ordi)
  '((- - - - - - o - - -)
    (- o o o o - - - o -)
    (- - - - - - - - o -)
    (- o - - - - - - o -)
    (- o - - - - - - o -)
    (- o - - - - - - o -)
    (- - - - - - o - - -)
    (- - - - - - o - - -)
    (- - - - - - - - - -)
    (- - - - - - - - - -)))