[编程交流] Tic-Tac-Toe

(defun C:test nil
 (TicTacToe)
)
; Tic Tac Toe
; Written By Grrr
; Credits: Lee Mac
(defun TicTacToe ( / SubstNth GroupByN kL vL *error* dcl des dch dcf tmp )
 
 (defun SubstNth ( n v L / i ) (setq i -1) (mapcar (function (lambda (x) (if (eq n (setq i (1+ i))) v x))) L))
 
 (defun GroupByN ( n L / r ) ; Grrr
   (repeat n (and L (setq r (cons (car L) r))) (setq L (cdr L)) r)
   (if L (cons (reverse r) (GroupByN n L)) (list (reverse r)))
 ); defun GroupByN
 
 (setq kL 
   '(
     ("A1" "B1" "C1")
     ("A2" "B2" "C2")
     ("A3" "B3" "C3")
   ); list
 ); setq kL 
 
 (setq vL 
   '(
     (nil nil nil)
     (nil nil nil)
     (nil nil nil)
   )
 )
 
 (defun *error* ( msg )
   (and (< 0 dch) (unload_dialog dch))
   (and (eq 'FILE (type des)) (close des))
   (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
   (princ)
 ); defun *error*
 
 (cond
   (
     (progn
       (while (not (member dcf '(0 1))) (*error* nil)
         (cond
           (
             (not ; Rewrite and Reload the dialog continiously
               (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
                 (vl-every (function (lambda (x) (princ (strcat "\n" x) des))) 
                   (list
                     "test : dialog "
                     "{ label = "Tic Tac Toe"; spacer;"
                     "  : column "
                     "  {"
                     (apply (function strcat) 
                       (mapcar 
                         (function 
                           (lambda (kL vL)
                             (strcat "\n"
                               "    : row "
                               "    { fixed_width = true; alignment = centered; "
                               (apply (function strcat)
                                 (mapcar 
                                   (function 
                                     (lambda (k v)
                                       (strcat "\n" "      : button { key = "" k ""; label = "" (cond (v)("")) ""; width = 3; fixed_width = true; height = 1.5; }")
                                     ); lambda (xx)
                                   ); function
                                   kL
                                   vL
                                 ); mapcar
                               ); apply 'strcat
                               "    }"
                             ); strcat
                           ); lambda (r)
                         ); function 
                         kL
                         vL
                       ); mapcar
                     ); apply 'strcat
                     "  }"
                     "  spacer_1; ok_only; : text { key = "error"; }"
                     "}"
                   ); list
                 ); vl-every
                 (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) 
               ); and
             ); not
             (princ "\nUnable to write or load the DCL file.") (setq dcf 0)
           )
           ( (not (new_dialog "test" dch)) (princ "\nUnable to display the dialog") (setq dcf 0) )
           (T 
             (eval (read (apply 'strcat (mapcar 'chr '(40 83 69 84 95 84 73 76 69 32 34 101 114 114 111 114 34 32 34 87 114 105 116 116 101 110 32 98 121 32 71 114 114 114 34 41)))))
             (mapcar 
               (function 
                 (lambda (rk rv)
                   (mapcar 
                     (function 
                       (lambda ( k v )
                         (action_tile k 
                           (vl-prin1-to-string
                             (quote
                               (
                                 (lambda ( / i n tmp )
                                   
                                   (cond
                                     ( (not (nth (setq i (vl-position $key (apply 'append kL))) (apply 'append vL)))
                                       (setq vL (GroupByN 3 (SubstNth i "O" (apply 'append vL))))
                                       (cond 
                                         ( (vl-some 'null (apply 'append vL))
                                           ; SubstNth ( n v L )
                                           (cond ; apply a little logic (but not alot, since we don't want to draw everytime)
                                             ( ; row 
                                               (and
                                                 (setq n -1)
                                                 (setq n
                                                   (vl-some 
                                                     '(lambda (row) (setq n (1+ n))
                                                       (if
                                                         (and 
                                                           (= 2 (length (vl-remove-if-not '(lambda (x) (= x "O")) row)))
                                                           (vl-some 'null row)
                                                         ); and
                                                         n
                                                       ); if
                                                     ); lambda (row)
                                                     vL
                                                   ); vl-some
                                                 ); setq n
                                               ); and
                                               (setq vL
                                                 (SubstNth n
                                                   (SubstNth (vl-position nil (nth n vL)) "X" (nth n vL))
                                                   vL
                                                 ); SubstNth
                                               ); setq vL
                                             ) ; row
                                             ( ; col
                                               (and
                                                 (setq n -1)
                                                 (setq n
                                                   (vl-some 
                                                     '(lambda (col) (setq n (1+ n))
                                                       (if
                                                         (and 
                                                           (= 2 (length (vl-remove-if-not '(lambda (x) (= x "O")) col)))
                                                           (vl-some 'null col)
                                                         ); and
                                                         n
                                                       ); if
                                                     ); lambda (col)
                                                     (apply 'mapcar (cons 'list vL))
                                                   ); vl-some
                                                 ); setq n
                                               ); and
                                               (setq vL (apply 'mapcar (cons 'list vL)))
                                               (setq vL 
                                                 (SubstNth n
                                                   (SubstNth (vl-position nil (nth n vL)) "X" (nth n vL))
                                                   vL
                                                 ); SubstNth
                                               ); setq vL
                                               (setq vL (apply 'mapcar (cons 'list vL)))
                                             ) ; col
                                             ( ; mid
                                               (null (nth 1 (nth 1 vL)))
                                               (setq vL 
                                                 (SubstNth 1
                                                   (SubstNth 1 "X" (nth 1 vL))
                                                   vL
                                                 ); SubstNth
                                               ); setq vL
                                             ) ; mid
                                             (t ; random!
                                               (while (nth (setq tmp (LM:randrange 0 ) (apply 'append vL)))
                                               (setq vL (GroupByN 3 (SubstNth tmp "X" (apply 'append vL))))
                                             ); t
                                           ); cond
                                           
                                           
                                         ); vl-some 'null
                                       ); cond
                                       (cond 
                                         ( 
                                           (or 
                                             (vl-some '(lambda (x) (equal x '("O" "O" "O"))) (append vL (apply 'mapcar (cons 'list vL))))
                                             (vl-some '(lambda (x) (equal (mapcar 'nth '(0 1 2) x) '("O" "O" "O"))) (list vL (reverse vL)))
                                           ); or
                                           (done_dialog 3)
                                         )
                                         ( 
                                           (or 
                                             (vl-some '(lambda (x) (equal x '("X" "X" "X"))) (append vL (apply 'mapcar (cons 'list vL))))
                                             (vl-some '(lambda (x) (equal (mapcar 'nth '(0 1 2) x) '("X" "X" "X"))) (list vL (reverse vL)))
                                           ); or
                                           (done_dialog 4)
                                         )
                                         ( (apply 'and (apply 'append vL)) (done_dialog 5) )
                                         ( (done_dialog 2) )
                                       ); cond 
                                     )
                                     ( (set_tile "error" "Already taken!") )
                                   ); cond
                                 ); lambda
                               )
                             ); quote
                           ); vl-prin1-to-string
                         ); action_tile k
                       ); lambda 
                     ); function 
                     rk rv
                   ); mapcar 
                 ); lambda
               ); function
               kL vL
             ); mapcar
             (cond
               ( (= dcf 3) (set_tile "error" "You win!") (mapcar '(lambda (x) (mapcar '(lambda (xx) (mode_tile xx 1)) x)) kL) )
               ( (= dcf 4) (set_tile "error" "You loose!") (mapcar '(lambda (x) (mapcar '(lambda (xx) (mode_tile xx 1)) x)) kL) )
               ( (= dcf 5) (set_tile "error" "Draw!") (mapcar '(lambda (x) (mapcar '(lambda (xx) (mode_tile xx 1)) x)) kL) )
             ); cond
             (setq dcf (start_dialog)) 
             
           ); T
         ); cond
       ); while
       (= 0 dcf) 
     ); progn
     (princ "\nUser cancelled the dialog.")
   )
 ); cond
 (*error* nil) (princ) 
); defun 
;; Rand  -  Lee Mac
;; PRNG implementing a linear congruential generator with
;; parameters derived from the book 'Numerical Recipes'
(defun LM:rand ( / a c m )
 (setq m   4294967296.0
   a   1664525.0
   c   1013904223.0
   $xn (rem (+ c (* a (cond ($xn) ((getvar 'date))))) m)
 )
 (/ $xn m)
)
;; Random in Range  -  Lee Mac
;; Returns a pseudo-random integral number in a given range (inclusive)
(defun LM:randrange ( a b )
 (+ (min a b) (fix (* (LM:rand) (1+ (abs (- a b))))))
)