home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / games / mastermind.el < prev    next >
Encoding:
Text File  |  1993-04-06  |  8.7 KB  |  306 lines
  1. ;;; File: mastermind.el
  2. ;;; Author: Anders Holst  (aho@sans.kth.se)
  3. ;;; Copyright (C) Anders Holst 1992
  4. ;;;
  5. ;;; LCD Archive Entry:
  6. ;;; mastermind|Anders Holst|aho@thalamus.sans.kth.se|
  7. ;;; The mastermind game.|
  8. ;;; 16-Mar-1993||~/games/mastermind.el.Z|
  9. ;;;
  10. ;;; This program is free software; you can redistribute it and/or modify
  11. ;;; it under the terms of the GNU General Public License as published by
  12. ;;; the Free Software Foundation; either version 1, or (at your option)
  13. ;;; any later version.
  14. ;;;
  15. ;;; This program is distributed in the hope that it will be useful,
  16. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;;; GNU General Public License for more details.
  19. ;;;
  20. ;;; You should have received a copy of the GNU General Public License
  21. ;;; along with your copy of Emacs; if not, write to the Free Software
  22. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23. ;;;
  24. ;;; --------------------------------------------------------------------------
  25.  
  26. ;;
  27. ;;  DESCRIPTION
  28. ;;
  29. ;;  This is a simple mastermind game in Emacs.
  30. ;;  Start with "M-x mastermind".  A numeric argument determines how
  31. ;;  many positions to guess (default is 4).  The variable
  32. ;;  `mastermind-max-color' desides the number of possible "colors", or
  33. ;;  numbers (defaulted to 6).  Maximum of allowed numbers is 10, where
  34. ;;  "0" is considered as the tenth alternative.
  35. ;;  The answer for each guessed line is presented as the number of
  36. ;;  completely correct positions, followed by the number of correct
  37. ;;  numbers at wrong positions.
  38. ;;  
  39.  
  40.  
  41. (defvar mastermind-mode-map nil "Local keymap for mastermind mode")
  42.  
  43. (defvar mastermind-max-color 6
  44.   "*The number of different possible \"colors\", i.e. numbers used (max 9).")
  45.  
  46. (if mastermind-mode-map
  47.     ()
  48.   (setq mastermind-mode-map (make-keymap))
  49.   (suppress-keymap mastermind-mode-map t)
  50.   (define-key mastermind-mode-map "\C-f" 'mm-right)
  51.   (define-key mastermind-mode-map "\C-b" 'mm-left)
  52.   (define-key mastermind-mode-map "\C-p" 'mm-up)
  53.   (define-key mastermind-mode-map "\C-n" 'mm-down)
  54.   (define-key mastermind-mode-map "\C-e" 'mm-eol)
  55.   (define-key mastermind-mode-map "\C-a" 'mm-bol)
  56.   (define-key mastermind-mode-map "\e<" 'mm-top)
  57.   (define-key mastermind-mode-map "\e>" 'mm-bot)
  58.   (define-key mastermind-mode-map " "    'mm-space)
  59.   (define-key mastermind-mode-map "\177"   'mm-bsp)
  60.   (define-key mastermind-mode-map "0"    'mm-set-number)
  61.   (define-key mastermind-mode-map "1"    'mm-set-number)
  62.   (define-key mastermind-mode-map "2"    'mm-set-number)
  63.   (define-key mastermind-mode-map "3"    'mm-set-number)
  64.   (define-key mastermind-mode-map "4"    'mm-set-number)
  65.   (define-key mastermind-mode-map "5"    'mm-set-number)
  66.   (define-key mastermind-mode-map "6"    'mm-set-number)
  67.   (define-key mastermind-mode-map "7"    'mm-set-number)
  68.   (define-key mastermind-mode-map "8"    'mm-set-number)
  69.   (define-key mastermind-mode-map "9"    'mm-set-number)
  70.   (define-key mastermind-mode-map "\C-m" 'mm-make-guess))
  71.  
  72.  
  73. ;; Mastermind mode is suitable only for specially formatted data.
  74. (put 'mastermind-mode 'mode-class 'special)
  75.  
  76. (defun mastermind-mode ()
  77.   "Major mode for playing mastermind.
  78.  
  79. Number -- set number in the position in a line
  80. SPC    -- blank the number in the position
  81. DEL    -- blank the number in the previous position
  82. RET    -- make a guess on the line
  83.  
  84. The answer will be presented as the number of correctly placed numbers
  85. followed by the number of correct numbers incorrectly placed.
  86.  
  87. Precisely,\\{mastermind-mode-map}"
  88.   (interactive)
  89.   (kill-all-local-variables)
  90.   (use-local-map mastermind-mode-map)
  91.   (setq truncate-lines t)
  92.   (setq major-mode 'mastermind-mode)
  93.   (setq mode-name "Mastermind"))
  94.  
  95. (defun mastermind (num)
  96.   "Play mastermind.  NUM is number of positions (default 4)."
  97.   (interactive "P")
  98.   (switch-to-buffer "*Mastermind*")
  99.   (mastermind-mode)
  100.   (setq buffer-read-only t)
  101.   (buffer-flush-undo (current-buffer))
  102.   (setq mm-len (or num 4))
  103.   (setq mm-answer (mm-init-line mm-len))
  104.   (setq mm-guess ())
  105.   (setq mm-check (make-list mm-len ()))
  106.   (setq mm-guesses 0)
  107.   (setq mm-pos 0)
  108.   (setq mm-done ())
  109.   (mm-clear-buffer)
  110.   (mm-blank-line)
  111.   (mm-new-line))
  112.  
  113. (defun mm-abs (num)
  114.   (if (>= num 0)
  115.       num
  116.       (- num)))
  117.  
  118. (defun mm-init-line (num)
  119.   (random t)
  120.   (let ((line ()))
  121.     (while (>= (setq num (1- num)) 0)
  122.       (setq line (cons (1+ (mod (mm-abs (random)) 
  123.                 mastermind-max-color)) line)))
  124.     line))
  125.  
  126. (defun mm-clear-buffer ()
  127.   (let ((buffer-read-only nil))
  128.     (erase-buffer)))
  129.  
  130. (defun mm-new-line ()
  131.   (let (i (buffer-read-only nil))
  132.     (insert "\n\n   ")
  133.     (setq i mm-len)
  134.     (while (>= (setq i (1- i)) 0)
  135.       (insert "- "))
  136.     (setq mm-guess (make-list mm-len ()))
  137.     (mm-goto 0)))
  138.  
  139. (defun mm-blank-line ()
  140.   (let ((buffer-read-only nil))
  141.     (insert (make-string (+ (* 2 mm-len) 3) 32))))
  142.  
  143. (defun mm-goto (pos)
  144.   (setq mm-pos (max 0 (min mm-len pos)))
  145.   (goto-char (point-max))
  146.   (beginning-of-line)
  147.   (forward-char (+ (* mm-pos 2) 3)))
  148.  
  149. (defun mm-in-pos ()
  150.   (= (+ (point-max) (* mm-pos 2) (- (* mm-len 2))) (point)))
  151.  
  152. (defun mm-right ()
  153.   "Move point to next position on line."
  154.   (interactive)
  155.   (if (= mm-pos mm-len)
  156.       ()
  157.     (forward-char 2)
  158.     (setq mm-pos (1+ mm-pos))))
  159.  
  160. (defun mm-left ()
  161.   "Move point to previous position on line."
  162.   (interactive)
  163.   (if (= mm-pos 0)
  164.       ()
  165.     (backward-char 2)
  166.     (setq mm-pos (1- mm-pos))))
  167.  
  168. (defun mm-up ()
  169.   "Move point up one line."
  170.   (interactive)
  171.   (previous-line 2))
  172.  
  173. (defun mm-down ()
  174.   "Move point down one line."
  175.   (interactive)
  176.   (next-line 2))
  177.  
  178. (defun mm-eol ()
  179.   "Move point to end of the line with the current guess."
  180.   (interactive)
  181.   (mm-goto mm-len))
  182.  
  183. (defun mm-bol ()
  184.   "Move point to beginning of the line with the current guess."
  185.   (interactive)
  186.   (mm-goto 0))
  187.  
  188. (defun mm-top ()
  189.   "Move to the first line in buffer"
  190.   (interactive)
  191.   (goto-char (+ (* mm-pos 2) 4)))
  192.  
  193. (defun mm-bot ()
  194.   "Move to the line with the current guess"
  195.   (interactive)
  196.   (mm-goto mm-pos))
  197.  
  198. (defun mm-set-pos (num)
  199.   (let ((buffer-read-only nil))
  200.     (mm-goto mm-pos)
  201.     (cond (mm-done
  202.        (message "Game over! Do `M-x mastermind' to start a new game")
  203.        (ding))
  204.       ((= mm-pos mm-len)
  205.        ())
  206.       ((null num)
  207.        (setcar (nthcdr mm-pos mm-guess) ())
  208.        (delete-char 1)
  209.        (insert-char 45 1)
  210.        (backward-char 1))
  211.       (t
  212.        (setcar (nthcdr mm-pos mm-guess) num)
  213.        (delete-char 1)
  214.        (insert-char (+ 48 num) 1)
  215.        (backward-char 1)))))
  216.  
  217. (defun mm-space ()
  218.   "Blank the guess at the current position and move to the next position"
  219.   (interactive)
  220.   (mm-set-pos ())
  221.   (mm-right))
  222.  
  223. (defun mm-bsp ()
  224.   "Move to the previous position and blank the guess there"
  225.   (interactive)
  226.   (if (not (= mm-pos 0))
  227.       (progn 
  228.     (mm-left)
  229.     (mm-set-pos ()))))
  230.  
  231. (defun mm-set-number ()
  232.   "Set the invoking number in the current position, and move right"
  233.   (interactive)
  234.   (let ((num (- (string-to-char (this-command-keys)) ?0)))
  235.     (if (and (<= num mastermind-max-color)
  236.          (or (= 10 mastermind-max-color)
  237.          (> num 0)))
  238.     (progn
  239.       (mm-set-pos num)
  240.       (mm-right))
  241.     (progn
  242.       (message (format "%d is not an allowed number. Max is %d" 
  243.                num mastermind-max-color))
  244.       (ding)))))
  245.  
  246. (defun mm-nil-pos ()
  247.   (let ((tmp (memq () mm-guess)))
  248.     (if tmp
  249.     (- mm-len (length tmp)))))
  250.  
  251. (defun mm-make-guess ()
  252.   "Make a guess on the last written line.
  253. The number of correctly placed numbers, followed by the number of
  254. incorrectly placed numbers are written after the line."
  255.   (interactive)
  256.   (let (tmp (buffer-read-only ()))
  257.     (cond (mm-done
  258.        (message "Game over! Do `M-x mastermind' to start a new game")
  259.        (ding))
  260.       ((setq tmp (mm-nil-pos))
  261.        (mm-goto tmp))
  262.       ((not (mm-in-pos))
  263.        (mm-goto mm-pos))
  264.       ((setq tmp (mm-check-guess))
  265.        (mm-goto mm-len)
  266.        (setq mm-guesses (1+ mm-guesses))
  267.        (insert (concat "  !  " 
  268.                (int-to-string (car tmp))
  269.                "  "
  270.                (int-to-string (cdr tmp))))
  271.        (if (not (= (car tmp) mm-len))
  272.            (mm-new-line)
  273.            (progn
  274.          (insert "\n\n")
  275.          (mm-blank-line)
  276.          (mm-goto 0)
  277.          (insert (format "Correct. It took %d guesses." mm-guesses))
  278.          (mm-goto 0)
  279.          (setq mm-done t)))))))
  280.  
  281. (defun mm-check-guess ()
  282.   (let (i j (res1 0) (res2 0))
  283.     (setq i mm-len)
  284.     (while (>= (setq i (1- i)) 0)
  285.       (setcar (nthcdr i mm-check) ()))
  286.     (setq i mm-len)
  287.     (while (>= (setq i (1- i)) 0)
  288.       (if (= (nth i mm-guess) (nth i mm-answer))
  289.       (progn
  290.         (setq res1 (1+ res1))
  291.         (setcar (nthcdr i mm-check) t))))
  292.     (setq i mm-len)
  293.     (while (>= (setq i (1- i)) 0)
  294.       (if (not (= (nth i mm-guess) (nth i mm-answer)))
  295.       (progn
  296.         (setq j mm-len)
  297.         (while (>= (setq j (1- j)) 0)
  298.           (if (and (not (nth j mm-check))
  299.                (not (= i j))
  300.                (= (nth i mm-guess) (nth j mm-answer)))
  301.           (progn
  302.             (setq res2 (1+ res2))
  303.             (setcar (nthcdr j mm-check) t)
  304.             (setq j 0)))))))
  305.     (cons res1 res2)))
  306.