mirror of
https://gitlab.com/eql/EQL5.git
synced 2026-03-15 11:10:34 -07:00
134 lines
3.7 KiB
Common Lisp
134 lines
3.7 KiB
Common Lisp
;;; for (c) please see COPYING.txt
|
|
;;;
|
|
;;; This is a port of "tic-tac-toe.js" from a Qt example.
|
|
|
|
(use-package :qml)
|
|
|
|
(defvar *board* "board")
|
|
|
|
;;; utils
|
|
|
|
(defun cell-state (i)
|
|
(if (stringp *board*)
|
|
(q< |state| (nth i (children *board*)))
|
|
(svref *board* i)))
|
|
|
|
(defun set-cell-state (i state)
|
|
(if (stringp *board*)
|
|
(q> |state| (nth i (children *board*)) state)
|
|
(setf (svref *board* i) state)))
|
|
|
|
(defun empty-cell (i)
|
|
(x:empty-string (cell-state i)))
|
|
|
|
;;; game
|
|
|
|
(defun tic-tac-clicked (index)
|
|
(when (and (q< |running| "game")
|
|
(can-play-at-pos index))
|
|
(unless (make-move index "X")
|
|
(computer-turn))))
|
|
|
|
(defun winner ()
|
|
(dotimes (i 3)
|
|
(when (or (and (not (empty-cell i))
|
|
(equal (cell-state i) (cell-state (+ i 3)))
|
|
(equal (cell-state i) (cell-state (+ i 6))))
|
|
(and (not (empty-cell (* i 3)))
|
|
(equal (cell-state (* i 3)) (cell-state (+ (* i 3) 1)))
|
|
(equal (cell-state (* i 3)) (cell-state (+ (* i 3) 2)))))
|
|
(return-from winner t)))
|
|
(when (or (and (not (empty-cell 0))
|
|
(equal (cell-state 0) (cell-state 4))
|
|
(equal (cell-state 0) (cell-state 8)))
|
|
(and (not (empty-cell 2))
|
|
(equal (cell-state 2) (cell-state 4))
|
|
(equal (cell-state 2) (cell-state 6))))
|
|
(return-from winner t)))
|
|
|
|
(defun restart-game ()
|
|
(q> |visible| "message_display" nil)
|
|
(q> |running| "game" t)
|
|
(dotimes (i 9)
|
|
(set-cell-state i "")))
|
|
|
|
(defun make-move (pos player)
|
|
(let ((*board* "board"))
|
|
(set-cell-state pos player)
|
|
(when (winner)
|
|
(game-finished (x:cc player " wins"))
|
|
t)))
|
|
|
|
(defun can-play-at-pos (pos)
|
|
(let ((*board* "board"))
|
|
(empty-cell pos)))
|
|
|
|
(defun computer-turn ()
|
|
(qsleep 1/7)
|
|
(let ((r (random 10)))
|
|
(if (< r (q< |difficulty| "game"))
|
|
(smart-ai)
|
|
(random-ai))))
|
|
|
|
(defun smart-ai ()
|
|
(flet ((board-copy ()
|
|
(let ((copy (make-array 9)))
|
|
(dotimes (i 9)
|
|
(setf (svref copy i) (cell-state i)))
|
|
copy))
|
|
(thwart (a b c)
|
|
;; if they are at A, try B or C
|
|
(when (equal (cell-state a) "X")
|
|
(cond ((can-play-at-pos b)
|
|
(make-move b "O")
|
|
t)
|
|
((can-play-at-pos c)
|
|
(make-move c "O")
|
|
t)))))
|
|
;; try "O" win move
|
|
(dotimes (i 9)
|
|
(let ((*board* (board-copy)))
|
|
(when (can-play-at-pos i)
|
|
(set-cell-state i "O")
|
|
(when (winner)
|
|
(make-move i "O")
|
|
(return-from smart-ai)))))
|
|
;; prevent "X" from winning
|
|
(dotimes (i 9)
|
|
(let ((*board* (board-copy)))
|
|
(when (can-play-at-pos i)
|
|
(set-cell-state i "X")
|
|
(when (winner)
|
|
(make-move i "O")
|
|
(return-from smart-ai)))))
|
|
(when (or (thwart 4 0 2)
|
|
(thwart 0 4 3)
|
|
(thwart 2 4 1)
|
|
(thwart 6 4 7)
|
|
(thwart 8 4 5)
|
|
(thwart 1 4 2)
|
|
(thwart 3 4 0)
|
|
(thwart 5 4 8)
|
|
(thwart 7 4 6))
|
|
(return-from smart-ai))
|
|
(dotimes (i 9)
|
|
(when (can-play-at-pos i)
|
|
(make-move i "O")
|
|
(return-from smart-ai)))
|
|
(restart-game)))
|
|
|
|
(defun random-ai ()
|
|
(let (unfilled-posns)
|
|
(dotimes (i 9)
|
|
(when (can-play-at-pos i)
|
|
(push i unfilled-posns)))
|
|
(if (null unfilled-posns)
|
|
(restart-game)
|
|
(let ((choice (nth (random (length unfilled-posns))
|
|
unfilled-posns)))
|
|
(make-move choice "O")))))
|
|
|
|
(defun game-finished (message)
|
|
(q> |text| "message_display" message)
|
|
(q> |visible| "message_display" t)
|
|
(q> |running| "game" nil))
|