;;; David João Fragueiro Afonso - 68365 // Ricardo Miguel Vieira Botas Carvalho - 67071 // Grupo - 84

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TAI LISTA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; REP.INTERNA: Estrutura de pares encadeados, em que cada   ;;;;;;;;
;;;;;;;; par guarda, na primeira posicao, um elemento e, na        ;;;;;;;;
;;;;;;;; segunda posicao, a lista com os restantes elementos; Uma  ;;;;;;;;
;;;;;;;; lista vazia e' representada por null.                     ;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; OPERACOES BASICAS

;;; Construtores
;;;
;;; nova-lista : {} -> lista
;;; nova-lista() tem como valor uma lista sem elementos.
(define (nova-lista)
  ())

;;; insere : elemento x lista -> lista
;;; insere(elem, lst) tem como valor a lista que resulta de inserir o
;;; elemento elem na primeira posicao da lista lst.
(define (insere elem lst)
  (cons elem lst))

;;; Selectores
;;;
;;; primeiro : lista -> elemento
;;; primeiro(lst) tem como valor o elemento que se encontra na primeira
;;; posicao da lista lst. Se a lista nao tiver elementos, o valor desta
;;; operacao e' indefinido.
(define (primeiro lst)
  (if (null? lst)
      (error "primeiro: a lista nao tem elementos")
      (car lst)))

;;; resto : lista -> lista
;;; resto(lst) tem como valor a lista que resulta de remover o primeiro
;;; elemento da lista lst. Se a lista nao tiver elementos, o valor
;;; desta operacao  e' indefinido.
(define (resto lst)
  (if (null? lst)
      (error "resto: a lista nao tem elementos")
      (cdr lst)))

;;; Reconhecedores
;;;
;;; lista? : universal -> logico
;;; lista?(arg) tem o valor verdadeiro se arg  e' uma lista e tem o valor
;;; falso em caso contrario.
(define (lista? x)
  (cond ((null? x) #t)
        ((pair? x) (lista? (cdr x)))
        (else #f)))

;;; lista-vazia? : lista -> logico
;;; lista-vazia?(lst) tem o valor verdadeiro se a lista lst  e' a lista
;;; vazia e tem o valor falso em caso contrario.
(define (lista-vazia? lst)
  (null? lst))

;;; Testes
;;;
;;; listas=? : lista x lista x predicado -> logico
;;; listas=?(lst1, lst2, pred) tem o valor verdadeiro se a lista lst1 e'
;;; igual a lista lst2, comparando os seus elementos com pred, e tem o
;;; valor falso em caso contrario.
(define (listas=? lst1 lst2 elem=?)
  (cond ((null? lst1) (null? lst2))
        ((null? lst2) #f)
        ((elem=? (car lst1) (car lst2))
         (listas=? (cdr lst1) (cdr lst2) elem=?))
        (else #f)))


;;;; OPERACOES ALTO NIVEL

;;; comprimento : lista -> inteiro
;;; comprimento(lst) tem como valor o inteiro que corresponde ao numero
;;; de elementos da lista lst.
(define (comprimento lst)
  (if (lista-vazia? lst)
      0
      (+ 1 (comprimento (resto lst)))))

;;; membro? : universal x lista x predicado -> logico
;;; membro?(el lst elem=?) tem o valor verdadeiro se el for um elemento
;;; da lista lst e falso em caso contrario.  Usa o predicado elem=? para
;;; comparar elementos.
(define (membro? el lst elem=?)
  (cond ((lista-vazia? lst) #f)
        ((elem=? el (primeiro lst)) #t)
        (else (membro? el (resto lst) elem=?))))

;;; todos-satisfazem? : lista x predicado -> logico
;;; todos-satisfazem?(lst pred) tem o falor verdadeiro se todos os elementos
;;; da lista lst satisfazem o predicado pred e falso em caso contrario.
(define (todos-satisfazem? lst pred)
  (cond ((lista-vazia? lst) #t)
        ((pred (primeiro lst)) (todos-satisfazem? (resto lst) pred))
        (else #f)))

;;; elemento-pos-n-lst : lista x inteiro -> universal
;;; elemento-pos-n-lst(lst n) tem como valor o elemento que se encontra na
;;; posicao n da lista lst; a posicao do primeiro elemento da lista e' 1.
;;; Se o indice estiver fora da lista, o valor desta operacao  e' indefinido.
(define (elemento-pos-n-lst lst n)
  (define (elemento-n-aux lst n)
    (cond ((lista-vazia? lst)
           (error "elemento-pos-n-lst: a lista nao tem elementos suficientes"))
          ((= n 1) (primeiro lst))
          (else (elemento-n-aux (resto lst) (- n 1)))))

  (if (and (lista? lst) (integer? n) (>= n 1))
      (elemento-n-aux lst n)
      (error "elemento-n: argumentos deviam ser lista e inteiro >= 1")))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TAI PINO-CHAVE ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; REP.INTERNA: Um dos simbolos: red aqua brown orange yellow lime. ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; OPERACOES BASICAS

;;; Reconhecedor
;;;
;;; pino-chave? : universal -> logico
;;; pino-chave?(arg) tem o valor verdadeiro, se arg e um pino-chave,
;;; e tem o valor falso, em caso contrario.
(define (pino-chave? x)
  (membro? x '(red aqua brown orange yellow lime white) eq?))

;;; Transformador
;;;
;;; pino-chave->string : pino-chave -> string
;;; pino-chave->string(pc) devolve a string
;;;  "|pino-chave%<nome do simbolo>|"
(define (pino-chave->string pc)
  (string-append "|pino-chave%"
                 (symbol->string pc)
                 "|"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TAI SEQ-PINOS-CHAVE ;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; REP.INTERNA: Uma lista com 4 elementos      ;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; OPERACOES BASICAS

;;; Construtor
;;;
;;; cria-seq-pinos-chave : pino-chave x pino-chave x
;;;                        pino-chave x pino-chave -> seq-pinos-chave
;;; cria-seq-pinos-chave(p1,p2,p3,p4) tem como valor uma seq-pinos-chave com
;;; elementos p1,p2,p3,p4, por esta ordem.
(define (cria-seq-pinos-chave p1 p2 p3 p4)
  (let ((seq (list p1 p2 p3 p4)))
    (if (todos-satisfazem? seq pino-chave?)
        seq
        (error "cria-seq-pinos-chave: os argumentos devem ser do tipo pino-chave"))))

;;; Selector
;;;
;;; elemento-i-seq-pinos-chave: seq-pinos-chave x {1,2,3,4} -> pino-chave
;;; elemento-i-seq-pinos-chave(s,i) tem como valor o elemento que se
;;; encontra na posicao i de s.
(define (elemento-i-seq-pinos-chave s i)
  (elemento-pos-n-lst s i))

;;; Reconhecedor
;;;
;;; seq-pinos-chave? : universal -> logico
;;; seq-pinos-chave?(arg) tem o valor verdadeiro, se arg e uma seq-pinos-chave,
;;; e tem o valor falso, em caso contrario.
(define (seq-pinos-chave? x)
  (and (lista? x)
       (= (comprimento x) 4)
       (todos-satisfazem? x pino-chave?)))

;;; Teste
;;;
;;; seq-pinos-chave=? : seq-pinos-chave x seq-pinos-chave -> logico
;;; seq-pinos-chave=?(s1, s2) tem o valor verdadeiro, se s1 e s2 sao
;;; seq-pinos-chave iguais, e tem o valor falso, em caso contrario.
(define (seq-pinos-chave=? s1 s2)
  (listas=? s1 s2 eq?))

;;; Transformador
;;;
;;; seq-pinos-chave->string : seq-pinos-chave -> string
;;; seq-pinos-chave->string(s) devolve a string
;;;  "|seq-pinos-chave%<pino-chave 1>% ... %<pino-chave 4>|"
(define (seq-pinos-chave->string s)
  (string-append "|seq-pinos-chave%"
                 (pino-chave->string (elemento-pos-n-lst s 1))
                 "%"
                 (pino-chave->string (elemento-pos-n-lst s 2))
                 "%"
                 (pino-chave->string (elemento-pos-n-lst s 3))
                 "%"
                 (pino-chave->string (elemento-pos-n-lst s 4))
                 "|"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TAI RESPOSTA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; REP.INTERNA: Um par em que o 1o elemento corresponde ao  ;;;;;;;;;
;;;;;;;;  numero de pinos chave certos na posicao certa e o 2o    ;;;;;;;;;
;;;;;;;;  elemento corresponde ao numero de pinos chave certos    ;;;;;;;;;
;;;;;;;;  mas na posicao errada.                                  ;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; OPERACOES BASICAS

;;; Construtor
;;;
;;; faz-resposta : inteiro x inteiro -> resposta
;;; faz-resposta(p, v) devolve a resposta correspondente ao numero de
;;; pinos chave certos na posicao certa, p, e ao numero de pinos chave
;;; certos mas na posicao errada, v.
(define (faz-resposta p v)
  (if (and (integer? p)
           (integer? v)
           (<= 0 p 4)
           (<= 0 v 4))
      (cons p v)
      (error "faz-resposta: argumentos devem ser inteiros entre 0 e 4")))

;;; Selectores
;;;
;;; resposta-pretos : resposta -> inteiro
;;; resposta-pretos(r) devolve o numero de pinos chave certos na posicao certa.
(define resposta-pretos car)

;;; resposta-vermelhos : resposta -> inteiro
;;; resposta-vermelhos(r) devolve o numero de pinos chave certos na posicao errada.
(define resposta-vermelhos cdr)

;;; Reconhecedor
;;;
;;; resposta? : universal -> logico
;;; resposta?(arg) tem o valor verdadeiro, se arg e uma resposta, e tem o
;;; valor falso, em caso contrario.
(define (resposta? x)
  (and (pair? x)
       (integer? (car x))
       (integer? (cdr x))
       (<= 0 (car x) 4)
       (<= 0 (cdr x) 4)))

;;; Teste
;;;
;;; resposta=? : resposta x resposta -> logico
;;; resposta=?(r1 , r2) tem o valor verdadeiro, se r1 e r2 sao respostas
;;; iguais, e tem o valor falso, em caso contrario.
(define resposta=? equal?)

;;; Transformador
;;;
;;; resposta->string : resposta -> string
;;; resposta->string(r) devolve a string
;;; "|resposta%<resposta-pretos>%<resposta-vermelhos>|"
(define (resposta->string r)
  (string-append "|resposta%"
                 (number->string (car r))
                 "%"
                 (number->string (cdr r))
                 "|"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TAI JOGADA  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; REP.INTERNA: Um par cujo primeiro elemento e' uma         ;;;;;;;;
;;;;;;;; seq-pinos-chave  e o segundo elemento e' uma resposta.    ;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; OPERACOES BASICAS

;;; Construtor
;;;
;;; faz-jogada : seq-pinos-chave x resposta -> jogada
;;; faz-jogada(s, r) devolve a jogada constituida pela seq-pinos-chave
;;; s e a resposta r.
(define (faz-jogada s r)
  (if (and (seq-pinos-chave? s)
           (resposta? r))
      (cons s r)
      (error "faz-jogada: argumentos errados")))

;;; Selectores
;;;
;;; jogada-seq-pinos-chave : jogada -> seq-pinos-chave
;;; jogada-seq-pinos-chave(j) devolve a seq-pinos-chave da jogada j.
(define jogada-seq-pinos-chave car)

;;; jogada-resposta : jogada -> resposta
;;; jogada-resposta(j) devolve a resposta da jogada j.
(define jogada-resposta cdr)

;;; Reconhecedor
;;;
;;; jogada? : universal -> logico
;;; jogada?(arg) tem o valor verdadeiro, se arg e uma jogada, e tem o valor falso,
;;; em caso contrario.
(define (jogada? x)
  (and (pair? x)
       (seq-pinos-chave? (car x))
       (resposta? (cdr x))))

;;; Transformador
;;;
;;; jogada->string : jogada -> string
;;; jogada->string(j) devolve a seguinte string
;;; "|jogada|seq-pinos-chave%<pc 1>% ... %<pc4>||resposta%<resp-pretos>%<resp-vermelhos>||"
(define (jogada->string j)
  (string-append "|jogada%"
                 (seq-pinos-chave->string (car j))
                 "%"
                 (resposta->string (cdr j))
                 "|"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TAI JOGADAS  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; REP.INTERNA: Uma lista de 12 elementos do tipo jogada.     ;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; OPERACOES BASICAS

;;; Construtores
;;;
;;; jogadas(j) : jogada -> jogadas
;;; jogadas(j) devolve um elemento do tipo jogadas em que todos os 12 componentes
;;; sao a jogada j.
(define (jogadas j)
  (if (jogada? j)
      (vector j j j j j j j j j j j j)
      (error "jogadas: argumento deve ser do tipo jogada")))

;;; altera-jogada : jogadas x {1,2,...,12} x jogada -> jogadas
;;; altera-jogadas(js, i, j) devolve um elemento do tipo jogadas semelhante a js,
;;; excepto no que diz respeito ao elemento na posicao i, que deve ser j.
(define (altera-jogadas! js i j)
  (vector-set! js (- i 1) j))

;;; Selectores
;;;
;;; jogadas-i(js, i) : jogadas x {1,2,...,12}  -> jogada
;;; jogadas-i(js, i) devolve o componente da posicao i de jogadas js.
(define (jogadas-i js i)
  (vector-ref js (- i 1)))

;;; Reconhecedores
;;;
;;; jogadas? : universal -> logico
;;; jogadas?(arg) tem o valor verdadeiro, se arg e do tipo jogadas, e tem o valor
;;; falso, em caso contrario.
(define (jogadas? x)
  (and (vector? x)
       (= (vector-length x) 12)
       (todos-satisfazem? (vector->list x) jogada?)))

;;; Transformador
;;;
;;; jogada->string : jogada -> string
;;; jogada->string(js) devolve a string
;;;  "|jogadas%<jogada 1>%<jogada 2>% ... %<jogada 12>|"
;;; Recebe uma jogada e devolve um elemento do tipo jogadas em que todos
;;;  os 12 componentes sao a jogada recebida
(define (jogadas->string js)
  (define (aux js)
    (if (lista-vazia? js)
        ""
        (string-append "%"
                       (jogada->string (primeiro js))
                       (aux (resto js)))))
  (string-append "|jogadas"
                 (aux (vector->list js))
                 "|"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2º PARTE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; A 2º parte do projecto é contituida pelos modulos de    ;;;;;;;;
;;;;;;;; interface, programa de controle, e o jogador            ;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(require "interface.zo")
;(require (lib "misc.ss" "swindle"))

(define mm-controle null)
(define mm-interface null)

(define (mastermind nome-utilizador tipo)
  (set! mm-interface (fpmm-cria-interface))
  (set! mm-controle (cria-controle nome-utilizador tipo)))

;;; em : procedure x symbol x universal
;;; em : obj -> corresponde ao nome do procedimento ao qual a mensagem é enviada
;;; em : mens -> (uma entidade do tipo símbolo) representa o tipo da mensagem enviada
;;; em : args, -> são zero ou mais objectos computacionais que são parte da mensagem
(define (em obj mens . args)
  (apply (obj mens) args))

;;;;;;;;;;;;;;;;;;;;;;;;;;;; PPROGRAMA DE CONTROLE ;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; O programa de controle tem o objectivo de controlar todo o jogo ;;
;;;;;;;; de inicio ao fim. Qualquer comunicação entre os módulos também  ;;
;;;;;;;; é aqui tratada                                                  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cria-controle nome tipo)

  ;;; calcula-resp : seq-pinos-chave x seq-pinos-chave -> resposta
  ;;; calcula-resp : Recebe como 2 sequências de pinos chave (adivinha e segredo)
  ;;; e deolve uma resposta
  (define (calcula-resp adivinha segredo)

    ;;; remover-posicoes : list x list
    ;;; remover-posicoes : Recebe 2 listas 1 delas com posições e outra com elementos
    ;;; e remove os elementos da segunda lista que cuincidam com as posições recebidas
    (define (remover-posicoes lst-posicao lst)
      (let ((lst-temp null))
        (do ((i (comprimento lst) (- i 1)))
          ((= i 0) lst-temp)
          (if (not (membro? i lst-posicao =))
              (set! lst-temp (insere (elemento-pos-n-lst lst i) lst-temp))))))

    ;;; remove-um-elemento : universal x list
    ;;; remove-um-elemento : Recebe um elemento universal e uma lista e remove apenas o
    ;;; primeiro elemento que for igual ao universal recebido
    (define (remove-um-elemento el lst)
      (let ((lst-temp null)
            (primeiro #t))
        (dolist (elm lst)
                (if (equal? el elm)
                    (if primeiro
                        (set! primeiro #f)
                        (set! lst-temp (insere elm lst-temp)))
                    (set! lst-temp (insere elm lst-temp))))
        lst-temp))

    (let ((PinosPretos 0)
          (PinosVermelhos 0)
          (PosicoesPinosPretos null))

      ;; Contar Pinos Pretos
      (do ((i 1 (+ i 1)))
        ((> i (comprimento segredo)) (set! adivinha (remover-posicoes PosicoesPinosPretos adivinha))
                                     (set! segredo (remover-posicoes PosicoesPinosPretos segredo)))
        (if (equal? (elemento-pos-n-lst adivinha i) (elemento-pos-n-lst segredo i))
            (begin
              (set! PinosPretos (+ PinosPretos 1))
              (set! PosicoesPinosPretos (insere i PosicoesPinosPretos)))))


      ;; Contar Pinos Vermelhos
      (do ((i 1 (+ i 1)))
        ((> i (comprimento segredo)) (faz-resposta PinosPretos PinosVermelhos))
        (let ((elemento-comparar (elemento-pos-n-lst segredo i)))
          (if (membro? elemento-comparar adivinha equal?)
              (begin
                (set! PinosVermelhos (+ PinosVermelhos 1))
                (set! adivinha (remove-um-elemento elemento-comparar adivinha))))))))

  (let ((segredoGerado null)
        (jogadasRealizadas null)
        (jogadorActual null))

    ;;; existePinoBranco? : seq-pinos-chave x string -> logico
    ;;; existePinoBranco? : verifica se existe pinos brancos na sequência
    ;;; se existir termina o jogo e o jogador perde
    (define (existePinoBranco? seq nomeJog)
      (if (membro? 'white seq equal?)
          (begin
            (em mm-interface 'fpmm-fim-jogo (string-append (string-append nomeJog " perdeu")))
            (em mm-interface 'fpmm-mostra-segredo segredoGerado)
            #t)
          #f))

    ;;; jogoTerminado? : resposta x seq-pinos-chave x integer x logico x string x string -> true
    ;;; jogoTerminado? : verifica se o jogo deve terminar ou continuar
    (define (jogoTerminado? resposta seq comp mostrarSegredo? nome1 nome2)
      (cond (;; Valida se o jogador automático / manual já adivinhou o segredo escondido
             (equal? resposta (faz-resposta 4 0)) (em mm-interface 'fpmm-fim-jogo (string-append (string-append nome1 " ganhou")))
                                                  (if mostrarSegredo?
                                                      (em mm-interface 'fpmm-mostra-segredo segredoGerado))
                                                  #t)
            ;; Validade se a jogada efectuada ainda não tinha acontecido anteriormente (jogada repetida)
            ((or (not (seq-pinos-chave? seq))
                 (membro? (faz-jogada seq resposta) jogadasRealizadas equal?)) (em mm-interface 'fpmm-fim-jogo (string-append nome1 " perdeu"))
                                                                               (if mostrarSegredo?
                                                                                   (em mm-interface 'fpmm-mostra-segredo segredoGerado))
                                                                               #t)
            ;; Valida se já decorreram no máximo 12 jogadas (12 número de jogadas permitidas)
            ((>= comp 11) (em mm-interface 'fpmm-fim-jogo (string-append nome2 " ganhou"))
                          (if mostrarSegredo?
                              (em mm-interface 'fpmm-mostra-segredo segredoGerado))
                          #t)
            ;; Caso nenhuma condição se verificar então o jogo não é terminado
            (else #f)))

    ;;; existePinoBranco? : logico x seq-pinos-chave
    ;;; existePinoBranco? : Processa o jogo pela ordem devida
    (define (processarJogo mostrarSegredo? seq)
      (let*  ((comp (comprimento jogadasRealizadas))
              (adivinha (em jogadorActual 'adivinha))
              (resposta (calcula-resp adivinha seq)))

        (em mm-interface 'fpmm-mostra-adivinha adivinha  comp)
        (em mm-interface 'fpmm-mostra-resposta resposta comp)
        ;; Informar o jogador da Resposta
        (em jogadorActual 'recebe-resposta resposta)

        (if mostrarSegredo?
            (em mm-interface 'fpmm-mostra-segredo seq))

        ;; Verifica a existencia de pinos brancos na adivinha gerada pelo explorador automático
        (if (not (existePinoBranco? adivinha "Computador"))
            ;; Verificar Jogo Terminado
            (if (not (jogoTerminado? resposta adivinha comp #f "Computador" (symbol->string nome)))
                (begin (em mm-interface 'fpmm-pede-continuar)
                       (set! jogadasRealizadas (insere (faz-jogada adivinha resposta) jogadasRealizadas)))))))

    ;;; novo-segredo : seq-pinos-chave
    ;;; novo-segredo : recebe um segredo do explorador autmatico e continua o jogo
    (define (novo-segredo seq)
      ;; Verifica a existencia de pinos brancos no segredo gerado pelo guardião humano
      (if (not (existePinoBranco? seq (symbol->string nome)))
          (begin
            (set! segredoGerado seq)
            (processarJogo #t seq))))

    ;;; continuar :
    ;;; continuar : permite o jogo prosseguir
    (define (continuar)
      (processarJogo #f segredoGerado))

    ;;; nova-adivinha : seq-pinos-chave
    ;;; nova-adivinha : recebe uma nova adivinha dada pelo explorador manual
    ;;; e continua o jogo
    (define (nova-adivinha seq)
      (let ((resposta (em jogadorActual 'responde-adivinha seq))
            (comp (comprimento jogadasRealizadas)))

        (em mm-interface 'fpmm-mostra-adivinha seq comp)
        (em mm-interface 'fpmm-mostra-resposta resposta comp)

        ;; Verifica a existencia de pinos brancos na adivinha gerada pelo explorador humano
        (if (not (existePinoBranco? seq (symbol->string nome)))
            ;; Verificar Jogo Terminado
            (if (not (jogoTerminado? resposta seq comp #t (symbol->string nome) "Computador"))
                (begin (set! jogadasRealizadas (insere (faz-jogada seq resposta) jogadasRealizadas))
                       (em mm-interface 'fpmm-pede-adivinha (comprimento jogadasRealizadas)))))))

    (case tipo
      ((adivinha) (set! jogadorActual (cria-jogador84 'adivinha))
                  (em mm-interface 'fpmm-inicia-jogo)
                  (em mm-interface 'fpmm-escreve-linha (string-append "Olá " (symbol->string nome) "!") 1)
                  (em mm-interface 'fpmm-escreve-linha "O seu objectivo é gerar o segredo que o jogador automático tentará descobrir." 3)
                  (em mm-interface 'fpmm-escreve-linha "Para isso deve introduzir um segredo na caixa do segredo" 5)
                  (em mm-interface 'fpmm-escreve-linha "Basta carregar em cada uma das posições da caixa e estas ficam coloridas com a cor" 6)
                  (em mm-interface 'fpmm-escreve-linha "seleccionada no bloco de cores em baixo. Para mudar de cor basta carregar na cor" 7)
                  (em mm-interface 'fpmm-escreve-linha "pretendida no bloco de cores. Quando tiver terminado carregue em \"jogar\"." 8)
                  (em mm-interface 'fpmm-pede-segredo))

      ((segredo) (set! jogadorActual (cria-jogador84 'segredo))
                 (set! segredoGerado (em jogadorActual 'novo-segredo))
                 (em mm-interface 'fpmm-inicia-jogo)
                 (em mm-interface 'fpmm-escreve-linha (string-append "Olá " (symbol->string nome) "!") 1)
                 (em mm-interface 'fpmm-escreve-linha "O seu objectivo é adivinhar o segredo gerado automáticamente." 3)
                 (em mm-interface 'fpmm-escreve-linha "Para isso deve introduzir uma adivinha na primeira linha vaga" 5)
                 (em mm-interface 'fpmm-escreve-linha "Basta carregar em cada uma das posições da grelha e estas ficam coloridas com a cor" 6)
                 (em mm-interface 'fpmm-escreve-linha "seleccionada no bloco de cores em baixo. Para mudar de cor basta carregar na cor" 7)
                 (em mm-interface 'fpmm-escreve-linha "pretendida no bloco de cores. Quando tiver terminado carregue em \"jogar\"." 8)
                 ;; Verifica a existencia de pinos brancos no segredo gerado pelo guardião automático
                 (if (not (existePinoBranco? segredoGerado "Computador"))
                     (em mm-interface 'fpmm-pede-adivinha 0))))

    (lambda (m)
      (case m
        ((novo-segredo) novo-segredo)
        ((continuar) continuar)
        ((nova-adivinha) nova-adivinha)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; JOGADOR ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;; O jogador tem uma funcção especifica consoante o papel que      ;;
;;;;;;;; desempenha. Se for explorador terá de gerar adivinhas e receber ;;
;;;;;;;; respostas, enquanto o guardião tem de gerar o segredo           ;;
;;;;;;;; e responder a adivinhas                                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cria-jogador84 tipo)

  ;;; calcula-resp : seq-pinos-chave x seq-pinos-chave -> resposta
  ;;; calcula-resp : Recebe como 2 sequências de pinos chave (adivinha e segredo)
  ;;; e deolve uma resposta
  (define (calcula-resp adivinha segredo)

    ;;; remover-posicoes : list x list
    ;;; remover-posicoes : Recebe 2 listas 1 delas com posições e outra com elementos
    ;;; e remove os elementos da segunda lista que cuincidam com as posições recebidas
    (define (remover-posicoes lst-posicao lst)
      (let ((lst-temp null))
        (do ((i (comprimento lst) (- i 1)))
          ((= i 0) lst-temp)
          (if (not (membro? i lst-posicao =))
              (set! lst-temp (insere (elemento-pos-n-lst lst i) lst-temp))))))

    ;;; remove-um-elemento : universal x list
    ;;; remove-um-elemento : Recebe um elemento universal e uma lista e remove apenas o
    ;;; primeiro elemento que for igual ao universal recebido
    (define (remove-um-elemento el lst)
      (let ((lst-temp null)
            (primeiro #t))
        (dolist (elm lst)
                (if (equal? el elm)
                    (if primeiro
                        (set! primeiro #f)
                        (set! lst-temp (insere elm lst-temp)))
                    (set! lst-temp (insere elm lst-temp))))
        lst-temp))

    (let ((PinosPretos 0)
          (PinosVermelhos 0)
          (PosicoesPinosPretos null))

      ;; Contar Pinos Pretos
      (do ((i 1 (+ i 1)))
        ((> i (comprimento segredo)) (set! adivinha (remover-posicoes PosicoesPinosPretos adivinha))
                                     (set! segredo (remover-posicoes PosicoesPinosPretos segredo)))
        (if (equal? (elemento-pos-n-lst adivinha i) (elemento-pos-n-lst segredo i))
            (begin
              (set! PinosPretos (+ PinosPretos 1))
              (set! PosicoesPinosPretos (insere i PosicoesPinosPretos)))))


      ;; Contar Pinos Vermelhos
      (do ((i 1 (+ i 1)))
        ((> i (comprimento segredo)) (faz-resposta PinosPretos PinosVermelhos))
        (let ((elemento-comparar (elemento-pos-n-lst segredo i)))
          (if (membro? elemento-comparar adivinha equal?)
              (begin
                (set! PinosVermelhos (+ PinosVermelhos 1))
                (set! adivinha (remove-um-elemento elemento-comparar adivinha))))))))

  ;;; todas-possibilidades : -> list
  ;;; todas-possibilidades : devolve uma lista com tadas as sequencias que podem ser jogadas
  (define (todas-possibilidades)
    (let ((v-pino (vector 'orange 'yellow 'red 'lime 'aqua 'brown))
          (seqPossiveisTmp null))
      (dotimes (i 6)
               (dotimes (j 6)
                        (dotimes (k 6)
                                 (dotimes (l 6)
                                          (set! seqPossiveisTmp (insere (cria-seq-pinos-chave (vector-ref v-pino i)
                                                                                              (vector-ref v-pino j)
                                                                                              (vector-ref v-pino k)
                                                                                              (vector-ref v-pino l)) seqPossiveisTmp))))))
      seqPossiveisTmp))

  ;;; todas-possibilidades : seq-pinos-chave x seq-pinos-chave x resposta -> logico
  ;;; todas-possibilidades : Verifica se um segredo e adivinha têm a mesma resposta que foi recebida como parametro
  (define (mesmo-resultado? segredo adivinha resposta)
    (resposta=? resposta (calcula-resp segredo adivinha)))

  ;; Declaração das variaveis para guardar as Jogadas Realizadas e o Segredo Gerado
  (let ((jogadasRealizadas null)
        (segredoGerado null)
        (seqPossiveis null))

    ;;; tratar-possibilidades : seq-pinos-chave x resposta -> logico
    ;;; tratar-possibilidades : Procedimento que remove as possibilidades que já não podem ser segredo
    (define (tratar-possibilidades adivinha resposta)
      (let ((seqPossiveisTmp null))
        (dolist (el seqPossiveis)
                (if (mesmo-resultado? adivinha el resposta)
                    (set! seqPossiveisTmp (insere el seqPossiveisTmp))))
        (set! seqPossiveis seqPossiveisTmp)))

    ;;; tratar-possibilidades :  -> seq-pinos-chave
    ;;; tratar-possibilidades : Procedimento para gerar uma sequencia de pinos chave
    (define (gerar-seq)
      (if (equal? tipo 'adivinha)
          (if (lista-vazia? seqPossiveis)
              (begin
                (set! seqPossiveis (todas-possibilidades))
                (elemento-pos-n-lst seqPossiveis 1023))
              (elemento-pos-n-lst seqPossiveis (+ (random (comprimento seqPossiveis)) 1)))
          (let ((v-pino (vector 'red 'aqua 'brown 'orange 'yellow 'lime)))
            (cria-seq-pinos-chave (vector-ref v-pino (random 6))
                                  (vector-ref v-pino (random 6))
                                  (vector-ref v-pino (random 6))
                                  (vector-ref v-pino (random 6))))))

    ;;; guardiao : mens -> procedure
    ;;; guardiao : Devolve um procedimento que representa as acções do guardião
    (define (guardiao mens)
      (case mens
        ((novo-segredo) (lambda()
                          ;; Guardião gera um novo segredo aleatório
                          (let ((segredo (gerar-seq)))
                            ;; Actualiza a variavel do segredo
                            (set! segredoGerado segredo)
                            ;; Devolve segredo
                            segredo)))
        ((responde-adivinha) (lambda(seq)
                               ;; A geração de uma resposta é feita apartir da última jogada comparada com o segredo
                               (calcula-resp seq segredoGerado)))))

    ;;; explorador : mens -> procedure
    ;;; explorador : Devolve um procedimento que representa as acções do explorador
    (define (explorador mens)
      (case mens
        ((adivinha) (lambda()
                      ;; Gerar adivinha aleatóriamente
                      (let ((adivinha (gerar-seq)))
                        (set! jogadasRealizadas (insere adivinha jogadasRealizadas))
                        adivinha)))
        ((recebe-resposta) (lambda(resp)
                             (tratar-possibilidades (primeiro jogadasRealizadas) resp)))))

    (case tipo
      ((segredo)(lambda (mens) (guardiao mens)))
      ((adivinha) (lambda (mens) (explorador mens)))
      (else (error "cria-jogador84: Tipo de jogador incorrecto")))))