;;; Fichier mot.drs / 1er mai 2001

(define w (make-object frame% "le mot mysterieux"))
(define f (make-object font% 36 'roman 'normal 'normal #f))
(send w set-label-font f)
(send w set-control-font f)
(define m (make-object text-field% "mot caché" w void))
(define t1 (make-object text-field% " 1er essai:" w void))
(define (action1 ob ev) (action t1 t2))
(define b1 (make-object button% "ok" w action1))

(define t2 (make-object text-field% "2eme essai:" w void))
(define (action2 ob ev) (action t2 t3))
(define b2 (make-object button% "ok" w action2))

(define t3 (make-object text-field% "3eme essai:" w void))
(define (action3 ob ev) (action t3 ()))
(define b3 (make-object button% "ok" w action3))

(send w show #t)
(send m set-value "*****")
(send t1 focus)

(define l '("corde" "corps" "belle" "croix" "conte" "doute" "blanc" "boite" "carte" "quete" "queue" "casse" "route" "soupe"))

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

(define mot-cache (nth (random (length l)) l))

(define (action t tsuivant) 
  (let* ((z1 (send t get-value))
        (res (compare mot-cache z1)))
    (send m set-value res)
    (fin mot-cache z1 t tsuivant)))

(define (compare x1 x2)
  (let ((l1 (string->list x1)) (l2 (string->list x2)))
    (list->string (list (devoile (nth 0 l1) (nth 0 l2))
                        (devoile (nth 1 l1) (nth 1 l2))
                        (devoile (nth 2 l1) (nth 2 l2))
                        (devoile (nth 3 l1) (nth 3 l2))
                        (devoile (nth 4 l1) (nth 4 l2))))))

(define (devoile char1 char2) (if (eq? char1 char2) char1 #\*))

(define (fin mot-cache z1 t tsuivant)
  (cond ((equal? mot-cache z1) 
         (send m set-value (string-append mot-cache "         GAGNE!")))
        ((equal? t t3) 
         (send m set-value (string-append mot-cache "        PERDU!")))
        (else (send tsuivant focus))))