; Bulls and Cows game v2 - 6th March 2020
; see http://www.ulisp.com/show?2Z78
;

(defvar *spectrum* nil)

; Calculate number of bulls and cows between two numbers
(defun bullcow (digits guess code)
  (let ((score 0))
    (dotimes (i 16) (setf (nth i *spectrum*) 0))
    (dotimes (d digits)
      (let ((da (mod guess 16))
            (db (mod code 16)))
        (cond
         ((= da db) (incf score 16))
         (t 
          (when (<= (incf (nth da *spectrum*)) 0) (incf score))
          (when (>= (decf (nth db *spectrum*)) 0) (incf score))))
        (setq guess (truncate guess 16))
        (setq code (truncate code 16))))
    score))

; Convert a decimal number to bcd: 123 -> #x123
(defun bcd (n)
  (cond
   ((zerop n) 0)
   (t (+ (mod n 10) (* 16 (bcd (truncate n 10)))))))

; Print n digits with leading zeros
(defun printn (n d)
  (cond
   ((= n 0) nil)
   (t (printn (1- n) (truncate d 16)) (princ (mod d 16)))))

; Next valid bcd number
(defun incbcd (n)
  (cond
   ((< (logand n #xf) 9) (1+ n))
   (t (ash (incbcd (ash n -4)) 4))))

; Return t only if every call of fun a b succeeds
(defun every* (fun a b)
  (cond
   ((or (null a) (null b)) t)
   ((null (funcall fun (car a) (car b))) nil)
   (t (every* fun (cdr a) (cdr b)))))

; Find guess compatible with all my guesses and your replies
(defun computer-choose (digits start try guesses replies)
  (let ((s (ash 1 (* digits 4))))
    (loop
     (setq try (mod (incbcd try) s))
     (when (= try start) (return nil))
     (when
         (every*
          (lambda (guess reply) (= (bullcow digits try guess) reply))
          guesses replies)
       (return try)))))

; Invite player to guess my code
(defun player-guess (digits i-playing mycode)
  (princ " Your guess: ")
  (let* ((your-guess (bcd (read)))
         (result (bullcow digits your-guess mycode))
         (you-playing (if (= result (* digits #x10)) nil result)))
    (princ " Score: ") (printn 2 result)
    (unless you-playing
      (terpri)
      (if i-playing (princ "You win!") (princ "You got it!"))
      (terpri) (princ "   "))
    you-playing))

; Let me have a guess
(defun computer-guess (digits you-playing try)
  (princ "   My guess: ") (printn digits try) (princ " Score: ")
  (let* ((your-reply (bcd (read)))
         (i-playing (if (= your-reply (* digits #x10)) nil your-reply)))
    (unless i-playing
      (terpri)
      (if you-playing (princ "I win!") (princ "I got it!")))
    i-playing))

; Play the game
(defun play (digits)
  (setq *spectrum* (let (lst) (dotimes (i 16 lst) (push 0 lst))))
  (let* ((s (expt 10 digits))
         (mycode (bcd (random s)))
         (start (bcd (random s)))
         (try start) (turn 0)
         (i-playing 0) (you-playing 0) guesses replies)
    (loop
     (terpri) (princ "[") (princ (incf turn)) (princ "]")
     (when you-playing (setq you-playing (player-guess digits i-playing mycode)))
     (when i-playing (setq i-playing (computer-guess digits you-playing try))
       (when i-playing
         (push try guesses)
         (push i-playing replies)
         (setq try (computer-choose digits start try guesses replies))
         (unless try
           (terpri)
           (princ "I think you gave an incorrect answer")
           (setq i-playing nil))))
     (when (and (not you-playing) (not i-playing)) (return)))))