;;;------------------------------------------------------------
;;; Gerenciador de campeonato
;;; Modificado em 22/08/97 para jogo de  GATOS E RATO
;;; Modificado em 07/09/97 havia um erro que impedia que a
;;;                        funcao GATO-INICIA fosse chamada
;;;
;;; Funcao principal: chama-se campeonato
;;;
;;; Recebe uma lista de nomes de pacotes e promove um campeonato
;;; entre os ditos cujos.  Cada pacote devera' possuir uma funcao
;;; INIT e uma funcao JOGADA que serao chamadas para promover
;;; partidas entre os pacotes.
;;; Todos jogam contra todos.  O valor retornado por campeonato
;;; e' uma lista contendo o placar final, no seguinte formato:
;;;
;;; ( (jog1 nvit nderr ndesclass)
;;;   (jog2 nvit nderr ndesclass)
;;;    ...
;;;   (jogn nvit nderr ndesclass)
;;; )
;;;
;;; onde (jog1 jog2 ... jogn) e' a lista de entrada e nvit, nderr
;;; e ndesclass sao, respectivamente, o numero de vitorias,
;;; derrotas e desclassificacoes que cada jogador teve.  Nao ha'
;;; empates.
;;;
;;; Obs.: Cada par de jogadores joga duas partidas para que cada
;;; jogador tenha a chance de jogar tanto como  Rato  quanto como
;;; Gato .  O  Rato  sempre comeca.

(defvar *placar* nil)

(defun campeonato (jogadores)
  "Recebe lista de jogadores; retorna placar final"

  ;; inicializa placar - tudo zero
  (setf *placar* (placar-inicial jogadores))

  ;; joga todos contra todos
  ;; serao jogadas (n*n - n) partidas (quadrado todo menos a diagonal)
  (dolist (jog1 jogadores)
	  (dolist (jog2 jogadores)
		  (unless (equal jog1 jog2)
			  (terpri)
			  (carrega jog1)
			  (carrega jog2)
			  (format t "~s versus ~s" jog1 jog2)
			  (registra jog1
				    jog2
				    (print
				     (partida-por-nome jog1 jog2)
				     )
				    *placar*)
			  (terpri)
			  (tira-tudo (list jog1 jog2))
			  )
		  )
	  )
  *placar*
  )

;;;------------------------------------------------------------
;;; Placar-inicial: tudo zerado

(defun placar-inicial (jogadores)
  (if (null jogadores)
      nil
    (cons (list (car jogadores) 0 0 0)
	  (placar-inicial (cdr jogadores))
	  )
    )
  )

;;;------------------------------------------------------------
;;; Funcao registra: atualiza o placar com o resultado de uma
;;; partida.  Entrada: jog1 jog2 resultado placar.  Saida:
;;; nao importa.  O importante e' o efeito colateral na variavel
;;; placar.
;;; Possiveis resultados: veja comentario na funcao PARTIDA

(defun registra (jog1 jog2 resultado placar)
  "Recebe JOG1, JOG2, o RESULTADO e o PLACAR.
   Tem como efeito colateral a modificacao do
   PLACAR para refletir o resultado."
  (cond
   ((equal (car resultado) 'vitoria)
    (when (equal (second resultado) 'rato)
	  ;;  Rato , ou seja, jog1, ganhou
	  ;; numero de vitorias e' o segundo da lista
	  (incf (second (assoc jog1 placar)))
	  ;; numero de derrotas e' o terceiro da lista
	  (incf (third (assoc jog2 placar)))
	  )
    (when (equal (second resultado) 'gato)
	  ;;  Gato , ou seja, jog2, ganhou
	  ;; numero de vitorias e' o segundo da lista
	  (incf (second (assoc jog2 placar)))
	  ;; numero de derrotas e' o quarto da lista
	  (incf (third (assoc jog1 placar)))
	  )
    )
   ;; quando um e' desclassificado, o outro ganha ponto
   ((equal (car resultado) 'desclassificado)
    (when (equal (second resultado) 'rato)
	  ;;  Rato , ou seja, jog1, foi desclassificado
	  ;; numero de desclassificacoes e' o quarto da lista
	  (incf (fourth (assoc jog1 placar)))
	  ;; numero de vitorias e' o segundo da lista
	  (incf (second (assoc jog2 placar)))
	  )
    (when (equal (second resultado) 'gato)
	  ;;  Gato, ou seja, jog2, foi desclassificado
	  ;; numero de vitorias e' o segundo da lista
	  (incf (second (assoc jog1 placar)))
	  ;; numero de desclassificacoes e' o quarto da lista
	  (incf (fourth (assoc jog2 placar)))
	  )
    )
   (t
    (print "Resultado invalido: ")
    (print resultado)
    )
   )
  )

;;;------------------------------------------------------------
;;; Partida-por-nome: o mesmo que partida, mas so' que recebe
;;; apenas os nomes dos pacotes que vao jogar, e nao as funcoes.

(defun partida-por-nome (jog1 jog2)
  (partida (symbol-function (find-symbol "RATO-INICIA" jog1))
	   (symbol-function (find-symbol "RATO-RESPONDE" jog1))
	   (symbol-function (find-symbol "GATO-INICIA" jog2))
	   (symbol-function (find-symbol "GATO-RESPONDE" jog2))
	   )
  )

;;; Modulo gerenciador de jogo
;;; Rotinas para executar uma partida

(defvar *posicao* nil)

;;; A funcao partida recebe quatro funcoes (rato-inicia do primeiro jogador,
;;; rato-responde do primeiro jogador, gato-inicia  do segundo jogador, 
;;; gato-responde  do segundo jogador) e executa uma partida entre os dois.
;;; O valor retornado e' um dos seguintes:
;;;    (desclassificado rato) --->  se o primeiro jogador fez invalida
;;;    (desclassificado gato) --->  se o segundo  jogador fez invalida
;;;    (vitoria rato)         --->  se o primeiro jogador ganhou
;;;    (vitoria gato)         --->  se o segundo  jogador ganhou

(defun partida (rato-inicia rato-responde gato-inicia gato-responde)
  "Executa partida entre dois jogadores"
  ;; Coloca posicao inicial
  (setf *posicao* '( (rato (8 4))
                     (gato (1 1))
                     (gato (1 3))
                     (gato (1 5))
                     (gato (1 7)) )
        )

  (let ((vez 'rato)			; vez pode ser 'rato ou 'gato
					; valor inicial: 'rato
	
	(primeiro-lance-rato t)		; primeiro-lance indica se e' o
	(primeiro-lance-gato t)		; primeiro lance de 'rato e 'gato
					; valor inicial: ambos t
			
	jogada  			; jogada passada de um jogador
					; a outro
					; valor inicial: irrelevante
	)

    (loop				; repita ate' algum return

     ;; chame a funcao apropriada
     ;; passe jogada e receba jogada
     (setf jogada
           (if (equal vez 'rato)
             ;; vez do  Rato
             (if primeiro-lance-rato
                (funcall rato-inicia)
                (funcall rato-responde jogada)
                )
             ;; vez do  Gato
             (if primeiro-lance-gato
                (funcall gato-inicia jogada)
                (funcall gato-responde jogada)
                )
             )
           )

     ;; nunca mais sera' o primeiro-lance
     ;; do jogador de quem e' a vez.  07/09/97
     (if (equal vez 'rato)
       (setf primeiro-lance-rato nil)
       (setf primeiro-lance-gato nil)
       )

     ;; imprime o jogador e a jogada
     (print (cons vez jogada))
     
     ;; verifica se invalida
     (unless (valida jogada vez *posicao*)
	     (return (list 'desclassificado vez)))

     ;; modifica posicao
     (setf *posicao* (nova *posicao* jogada))

     ;; ve se o cara da vez ganhou com esta jogada
     (if (equal vez 'rato)
       (when (rato-ganhou *posicao*)
	   (return '(vitoria rato)))
       (when (gato-ganhou *posicao*)
	   (return '(vitoria gato)))
       )

     ;; atualiza para proxima iteracao
     (setf vez (if (equal vez 'rato) 'gato 'rato))
    )
  )
)

;;;------------------------------------------------------------
;;; Para propositos de debug apenas: remove os pacotes ja'
;;; carregados

(defun tira-tudo (jogadores)
  (dolist (jogador jogadores)
	  (delete-package jogador)
	  )
  )

;;;------------------------------------------------------------
;;; Funcao carrega: carrega o pacote de um jogador

(defun carrega (jogador)
  (load (string-downcase (symbol-name jogador)))
  )

;;;--------------------------------------------------
;;; Parte mais especifica do jogo de  GATOS E RATO .
;;;
;;;---------------------------------------------------------
;;; Verifica se JOGADA e' valida para um JOGADOR
;;;   numa determinada POSICAO
;;; Formato da JOGADA: ((l1 c1) (l2 c2))
;;; onde li=linha, ci=coluna
;;; O JOGADOR pode ser:  rato  ou  gato
;;; Formato da POSICAO:
;;;     ((rato (rl  rc ))
;;;      (gato (g1l g1c))
;;;      (gato (g2l g2c))
;;;      (gato (g3l g3c))
;;;      (gato (g4l g4c)))
;;;
;;; Jogada e' valida se:
;;; 1.   (l1 c1) e (l2 c2) sao casas validas
;;; 2.   (l1 c1) e' posicao ocupada pelo jogador
;;; 3.   (l2 c2) pode ser alcancada pelo jogador 
;;;              a partir de (l1 c1)
;;; 4.   (l2 c2) esta' desocupada

(defun valida (jogada jogador posicao)
  "Verifica de JOGADA do JOGADOR e' valida
   na POSICAO"
  (and
    (listp jogada)
    (= 2 (length jogada))
    (let ((origem  (first  jogada))
          (destino (second jogada)))
      (and
        (valida-casa origem )
        (valida-casa destino)
        (if (equal jogador 'rato)
           (equal origem (rato posicao))
           (member origem (gatos posicao) :test #'equal))
        (alcancavel destino jogador origem)
        (livre destino posicao)
        )
      )
    )
  )

;;;-----------------------------------------------
;;; Auxiliares de validacao de jogada
;;;-----------------------------------------------

;;;-----------------------------------------------
;;; Validacao de casa: funcao que verifica se uma
;;; casa e' valida.
;;; Formato da casa:  (l c)
;;; Casa e' valida se tanto  l  como  c  estiverem
;;; entre 1 e 8 e se a casa  (l c)  for  preta,
;;; isto e',  l+c  for um numero par.

(defun valida-casa (casa)
  "Verifica se CASA e' valida"
  (and
    (listp casa)
    (= 2 (length casa))
    (let ((l (first  casa))
          (c (second casa)))
      (and
        (dentro l)
        (dentro c)
        (evenp (+ l c))
        )
      )
    )
  )

(defun dentro (x)
  "Verifica se X e' uma coordenada que
   esta' dentro do intervalo [1..8]"
  (and
    (numberp x)
    (<= 1 x)
    (<= x 8)
    )
  )

;;;-------------------------------------------------
;;; Funcoes que extraem as casas ocupadas pelo
;;; Rato  e pelos  Gatos  numa posicao.
;;; As casas dos  Gatos  vem dentro de uma lista.
;;; A casa do  Rato , como e' so' uma, vem apenas
;;; ela, sem lista em volta.
;;;
;;; Formato da posicao:
;;;     ((rato (rl  rc ))
;;;      (gato (g1l g1c))
;;;      (gato (g2l g2c))
;;;      (gato (g3l g3c))
;;;      (gato (g4l g4c)))
;;;

(defun rato (posicao)
  "Retorna a casa do  Rato  numa POSICAO"
  (cadar posicao)
  )

(defun gatos (posicao)
  "Retorna uma lista com as casas ocupadas
   pelos  Gatos  numa POSICAO"
  ;; extrai-casas e' uma funcao mais geral,
  ;; que retorna uma lista formada pelos
  ;; segundos elementos de cada elemento
  ;; de seu argumento.
  ;; Aqui no caso, precisamos so' da parte
  ;; da posicao que envolve os gatos.
  (extrai-casas (cdr posicao))
  )

(defun extrai-casas (lista)
  "Retorna uma lista formada pelos segundos
   elementos de cada elemento de uma LISTA"
  (if (null lista)
    nil
    (cons (cadar lista)
          (extrai-casas (cdr lista))
          )
    )
  )

;;;------------------------------------------
;;; Verificacao de se uma dada casa e'
;;; alcancavel a partir de outra.  Esta
;;; verificacao depende de se o jogador e'
;;; Rato  ou  Gato .
;;;
;;; Nota: e' olhado apenas o aspecto numerico,
;;; e nao se as jogadas esta' dentro ou fora do
;;; tabuleiro.
;;;
;;; Gatos  podem ir apenas para a linha de
;;; cima;  o  Rato pode ir para a linha de
;;; cima ou a de baixo.
;;; Linha de cima da linha  i  e' a linha  i+1.
;;; Linha de baixo e'  i-1 .
;;; A coluna do destino deve ter diferenca
;;; de uma unidade com a coluna da origem.

(defun alcancavel (destino jogador origem)
  "Verifica se a casa DESTINO pode ser alcancada
   em uma jogada por JOGADOR a partir da casa 
   ORIGEM"
  (or 
    (linha-de 'cima destino origem)
    (and 
      (equal jogador 'rato)
      (linha-de 'baixo destino origem)
      )
    )
  )
  
(defun linha-de (direcao destino origem)
  "Dada uma DIRECAO (cima ou baixo),
   verifica se a casa DESTINO se encontra
   na proxima linha `a da casa ORIGEM, na
   DIRECAO dada, e se as colunas diferem tambem
   de uma unidade, em qualquer direcao 
   (direita, esquerda)"
  (and
    ;; ve se a linha e' a de cima ou de baixo,
    ;; conforme a direcao
    (= (linha destino) 
       (funcall (if (equal direcao 'cima) #'+ #'-)
                (linha origem) 1))
    ;; e se as colunas diferem de 1
    (= 1 (abs (- (coluna destino) (coluna origem))))
    )
  )

(defun linha (casa)
  "Retorna a linha de uma CASA dada"
  (first casa)
  )

(defun coluna (casa)
  "Retorna a coluna de uma CASA dada"
  (second casa)
  )

;;;-------------------------------------------------
;;; Verifica se casa esta' livre
;;;
;;; Usa member e rotina extrai-casas ja' definida

(defun livre (casa posicao)
  "Verifica se CASA esta' livre numa POSICAO"
  (not (ocupada casa posicao))
  )

(defun ocupada (casa posicao)
  "Verifica se CASA esta' ocupada numa POSICAO"
  (member casa (extrai-casas posicao) :test #'equal)
  )

;;;--------------------------------------------------
;;; Modifica a posicao dada a jogada efetuada
;;;

(defun nova (posicao jogada)
  "Retorna a nova posicao resultante dada uma POSICAO
   e uma JOGADA efetuada nela"
  (cond
    ((null posicao) ())
    ;; compara casa da primeira peca com origem da jogada
    ((equal (cadar posicao)
            (first jogada))
       ;; achamos a peca que vai ser jogada -
       ;; monta nova lista (peca casa) e
       ;; constroi nova posicao com esta lista
       ;;; na frente do resto da posicao
       (cons (list (caar posicao)
                   (second jogada))
             (cdr posicao))
       )
    ;; nao e' a primeira peca que sera' movida -
    ;; chame recursivamente para o cdr da posicao
    (t (cons (car posicao) (nova (cdr posicao) jogada)))
    )
  )

;;;------------------------------------------------------
;;; Verificacao de posicao ganhadora
;;;
;;; Para o  Rato , isto significa: chegou na primeira
;;; linha ou os  Gatos  nao podem se mover.
;;;
;;; Para os  Gatos , isto significa: o  Rato nao
;;; pode se mover.
;;;
;;; Nunca ha' empate.

(defun rato-ganhou (posicao)
  "Verifica se a posicao reflete uma vitoria
   do  Rato ."
  (or
    (rato-na-primeira-linha posicao)
    ;; possiveis-movimentos-dos-gatos retorna
    ;; lista com as possiveis casas para onde
    ;; um  Gato  pode ir
    (null (possiveis-movimentos-dos-gatos posicao))
    )
  )

(defun rato-na-primeira-linha (posicao)
  "Verifica se o  Rato  esta' na
   primeira linha"
  (= 1 (caadar posicao))
  )

;;; Retorna lista com as possiveis casas onde
;;; algum  Gato  pode ir.

(defun possiveis-movimentos-dos-gatos (posicao)
  "Retorna lista com as possiveis casas para
   onde um  Gato  pode ir"
  (validas-e-livres 
    (casas-potenciais (extrai-casas (cdr posicao)))
    posicao
    )
  )

(defun casas-potenciais (lista)
  "Retorna uma lista de casas potenciais
   onde  Gatos  podem ir a partir de alguma
   das casas da LISTA dada"
  (if (null lista)
    ()
    (append (adj-frente (car lista))
            (casas-potenciais (cdr lista))
            )
    )
  )

(defun adj-frente (casa)
  "Retorna uma lista das casas potenciais
   onde um  Gato  poderia ir a partir da
   CASA passada como parametro"
  (let ((l (first  casa))
        (c (second casa)))
    (list 
      (list (+ l 1) (+ c 1))
      (list (+ l 1) (- c 1))
      )
    )
  )

(defun validas-e-livres (lista posicao)
  "Recebe uma LISTA de casas potenciais
   e uma POSICAO e retorna uma outra lista
   contendo apenas as casas
   da LISTA que sao validas e livres"
  (cond
    ((null lista) ())
    ((and (valida-casa (car lista))
          (livre (car lista) posicao))
      (cons (car lista) 
            (validas-e-livres (cdr lista)
                              posicao)
            ))
    (t (validas-e-livres (cdr lista)
                         posicao))
    )
  )

;;;--------------------------------------------
;;; Verificacao de se  Gatos  ganharam
;;;
;;; Deve ser verificado se o  Rato  possui
;;; movimento.

(defun gato-ganhou (posicao)
  "Verifica se a POSICAO representa uma vitoria
   para os  Gatos "
  (null (possiveis-movimentos-do-rato posicao))
  )

;;; Calcula possiveis movimentos do   Rato .
;;; Metodo: monta lista das casas adjacentes,
;;; e passa-a `a funcao validas-e-livres.

(defun possiveis-movimentos-do-rato (posicao)
  "Retorna uma lista com os movimentos que
   o  Rato  pode fazer na POSICAO dada"
  (validas-e-livres (adjacentes (cadar posicao))
                    posicao)
  )

;;; Funcao que monta as casas adjacentes a uma casa,
;;; tanto pra frente como pra tras (movimentos
;;; de  Rato ).

(defun adjacentes (casa)
  "Retorna uma lista com as casas (possivelmente
   invalidas) adjacentes a uma CASA dada"
  (let ((l (first  casa))
        (c (second casa)))
    (list
      (list (+ l 1) (+ c 1))
      (list (+ l 1) (- c 1))
      (list (- l 1) (+ c 1))
      (list (- l 1) (- c 1))
      )
    )
  )