;; ClueReasoner.lisp - project skeleton for a propositional reasoner
;; for the game of Clue.  Unimplemented portions have the comment "TO
;; BE IMPLEMENTED AS AN EXERCISE".  The reasoner does not include
;; knowledge of how many cards each player holds.
;; Originally by Todd Neller
;; Ported to Lisp by Dave Musicant

;; Copyright (C) 2005 Dave Musicant

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; Information about the GNU General Public License is available online at:
;;   http://www.gnu.org/licenses/
;; To receive a copy of the GNU General Public License, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;; Initialize important variables
(setf case-file 'cf)
(setf players '(sc mu wh gr pe pl))
(setf extended-players (append players (list case-file)))
(setf suspects '(mu pl gr pe sc wh))
(setf weapons '(kn ca re ro pi wr))
(setf rooms '(ha lo di ki ba co bi li st))
(setf cards (append suspects weapons rooms))

(defun get-pair-num-from-names(player card)
  (get-pair-num-from-positions (position player extended-players) 
                               (position card cards)))

(defun get-pair-num-from-positions(player card)
  (+ (* player (length cards)) card 1))

(defun initial-clauses()
  ;; TO BE IMPLEMENTED AS AN EXERCISE

  (let ((clauses nil) (clause nil))

    ;; Each card is in at least one place (including case file).
    (dolist (card cards)
      (setf clause nil)
      (dolist (player extended-players)
        (setf clause (append clause (list
                                     (get-pair-num-from-names player card)))))
      (setf clauses (append clauses (list clause))))

    ;; If a card is one place, it cannot be in another place.

    ;; At least one card of each category is in the case file.
            
    ;; No two cards in each category can both be in the case file.

    clauses))

(defun hand(player player-cards)
  ;; TO BE IMPLEMENTED AS AN EXERCISE  
)

(defun suggest(suggester card1 card2 card3 refuter card-shown)
  ;; TO BE IMPLEMENTED AS AN EXERCISE
)

(defun accuse(accuser card1 card2 card3 is-correct)
  ;; TO BE IMPLEMENTED AS AN EXERCISE
)

(defun query(player card clauses)
  (test-literal (get-pair-num-from-names player card)
                clauses))


(defun query-string(return-code)
  (if (equal return-code 'true)
      "Y"
    (if (equal return-code 'false)
        "n"
      "-")))

(defun print-notepad(clauses)
  (dolist (player players)
    (format t "~0,5T~a" player))
  (format t "~0,5T~a~%" case-file)
  (dolist (card cards)
    (format t "~a~0,5T" card)
    (dolist (player players)
      (format t "~a~0,5T" (query-string (query player card clauses))))
    (format t "~a~%" (query-string (query case-file card clauses)))))

(defun play-clue()
  (let ((clauses nil))
    (setf clauses (initial-clauses))
    (setf clauses (append clauses (hand 'sc '(wh li st))))
    (setf clauses (append clauses (suggest 'sc 'sc 'ro 'lo 'mu 'sc)))
    (setf clauses (append clauses (suggest 'mu 'pe 'pi 'di 'pe nil)))
    (setf clauses (append clauses (suggest 'wh  'mu  're  'ba  'pe  nil)))
    (setf clauses (append clauses (suggest 'gr  'wh  'kn  'ba  'pl  nil)))
    (setf clauses (append clauses (suggest 'pe  'gr  'ca  'di  'wh  nil)))
    (setf clauses (append clauses (suggest 'pl  'wh  'wr  'st  'sc  'wh)))
    (setf clauses (append clauses (suggest 'sc  'pl  'ro  'co  'mu  'pl)))
    (setf clauses (append clauses (suggest 'mu  'pe  'ro  'ba  'wh  nil)))
    (setf clauses (append clauses (suggest 'wh  'mu  'ca  'st  'gr  nil)))
    (setf clauses (append clauses (suggest 'gr  'pe  'kn  'di  'pe  nil)))
    (setf clauses (append clauses (suggest 'pe  'mu  'pi  'di  'pl  nil)))
    (setf clauses (append clauses (suggest 'pl  'gr  'kn  'co  'wh  nil)))
    (setf clauses (append clauses (suggest 'sc  'pe  'kn  'lo  'mu  'lo)))
    (setf clauses (append clauses (suggest 'mu  'pe  'kn  'di  'wh  nil)))
    (setf clauses (append clauses (suggest 'wh  'pe  'wr  'ha  'gr  nil)))
    (setf clauses (append clauses (suggest 'gr  'wh  'pi  'co  'pl  nil)))
    (setf clauses (append clauses (suggest 'pe  'sc  'pi  'ha  'mu  nil)))
    (setf clauses (append clauses (suggest 'pl  'pe  'pi  'ba  nil  nil)))
    (setf clauses (append clauses (suggest 'sc  'wh  'pi  'ha  'pe  'ha)))
    (setf clauses (append clauses (suggest 'wh  'pe  'pi  'ha  'pe  nil)))
    (setf clauses (append clauses (suggest 'pe  'pe  'pi  'ha  nil  nil)))
    (setf clauses (append clauses (suggest 'sc  'gr  'pi  'st  'wh  'gr)))
    (setf clauses (append clauses (suggest 'mu  'pe  'pi  'ba  'pl  nil)))
    (setf clauses (append clauses (suggest 'wh  'pe  'pi  'st  'sc  'st)))
    (setf clauses (append clauses (suggest 'gr  'wh  'pi  'st  'sc  'wh)))
    (setf clauses (append clauses (suggest 'pe  'wh  'pi  'st  'sc  'wh)))
    (setf clauses (append clauses (suggest 'pl  'pe  'pi  'ki  'gr  nil)))
    (format t "Before accusation~%")
    (print-notepad clauses)
    (setf clauses (append clauses (accuse 'sc 'pe 'pi 'bi t)))
    (format t "After accusation~%")
    (print-notepad clauses)))