mirror of
https://gitlab.com/eql/EQL5.git
synced 2025-12-26 11:52:47 -08:00
134 lines
3.8 KiB
Common Lisp
134 lines
3.8 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*)
|
|
(qml-get (nth i (children *board*)) "state")
|
|
(svref *board* i)))
|
|
|
|
(defun set-cell-state (i state)
|
|
(if (stringp *board*)
|
|
(qml-set (nth i (children *board*)) "state" state)
|
|
(setf (svref *board* i) state)))
|
|
|
|
(defun empty-cell (i)
|
|
(x:empty-string (cell-state i)))
|
|
|
|
;;; game
|
|
|
|
(defun tic-tac-clicked (index)
|
|
(when (and (qml-get "game" "running")
|
|
(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 ()
|
|
(qml-set "message_display" "visible" nil)
|
|
(qml-set "game" "running" 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 (qml-get "game" "difficulty"))
|
|
(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)
|
|
(qml-set "message_display" "text" message)
|
|
(qml-set "message_display" "visible" t)
|
|
(qml-set "game" "running" nil))
|