Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 152 lines (126 sloc) 5.031 kB
f9bce83 @sile ロジック部分がほぼ完成
authored
1 (defpackage game
2 (:use :common-lisp)
ec9f53f @sile おおむね完成
authored
3 (:import-from :mine shuffle)
f9bce83 @sile ロジック部分がほぼ完成
authored
4 (:export init-game
5 board-width
6 board-height
7 locate-bombs
8 open-cell
9 flip-flag
10 each
11 finish?
12 bomb-count
13 flag-count))
14 (in-package :game)
15
16 ;;;;;;;;;
17 ;;; types
18 (deftype cell-state () '(member :mask :flag :open))
19
20
21 ;;;;;;;;;;;
22 ;;; structs
23 (defstruct game
24 (board #2A() :type array)
25 (cell-states #2A() :type (array cell-state)))
26
27
28 ;;;;;;;;;;;;;;;;;;;;;;
29 ;;; internal functions
30 (defun surrounding-cells (game x y)
31 (destructuring-bind (height width)
32 (array-dimensions (game-board game))
33 (loop FOR y~ FROM (max 0 (1- y)) TO (min (1- height) (1+ y))
34 APPEND
35 (loop FOR x~ FROM (max 0 (1- x)) TO (min (1- width) (1+ x))
36 UNLESS (and (= x~ x) (= y~ y))
37 COLLECT (list x~ y~)))))
38
39 (defun board-size (game)
40 (array-total-size (game-board game)))
41
42 (defmacro cell (board x y)
43 `(aref ,board ,y ,x))
44
320a9ac @sile 若干整理
authored
45 (defun open-surrounding-cells (game x y)
46 (let ((bomb-num (cell (game-board game) x y))
47 (flag-num (loop FOR (x~ y~) IN (surrounding-cells game x y)
48 WHEN (eq (cell (game-cell-states game) x~ y~) :flag)
49 SUM 1)))
50 (when (= bomb-num flag-num)
51 (loop FOR (x~ y~) IN (surrounding-cells game x y)
52 DO (open-cell game x~ y~ nil)))))
53
54
f9bce83 @sile ロジック部分がほぼ完成
authored
55 ;;;;;;;;;;;;;;;;;;;;;;
56 ;;; exported functions
57 (defun init-game (width height)
58 (make-game :board (make-array `(,height ,width)
59 :initial-element nil)
60 :cell-states (make-array `(,height ,width)
61 :element-type 'cell-state
62 :initial-element :mask)))
63
64 (defun board-width (game)
65 (second (array-dimensions (game-board game))))
66
67 (defun board-height (game)
68 (first (array-dimensions (game-board game))))
69
70 (defmacro each ((cell state &key (x (gensym)) (y (gensym)) result-form eol-form) game &body body)
71 (let ((height (gensym))
72 (width (gensym))
73 (g (gensym)))
74 `(let ((,g ,game))
75 (destructuring-bind (,height ,width) (array-dimensions (game-board ,g))
76 (loop FOR ,y FROM 0 BELOW ,height DO
77 (locally
78 (loop FOR ,x FROM 0 BELOW ,width DO
79 (symbol-macrolet ((,cell (cell (game-board ,g) ,x ,y))
80 (,state (cell (game-cell-states ,g) ,x ,y)))
81 ,@body))
82 ,eol-form)))
83 ,result-form)))
84
85 (defun locate-bombs (game bomb-count init-x init-y)
86 (assert (< 0 bomb-count (- (board-size game) 9)))
87
88 (let* ((excludes `((,init-x ,init-y) . ,(surrounding-cells game init-x init-y)))
ec9f53f @sile おおむね完成
authored
89 (bombs (subseq (shuffle (loop FOR x FROM 0 BELOW (board-width game)
90 APPEND
91 (loop FOR y FROM 0 BELOW (board-height game)
92 FOR pos = `(,x ,y)
93 UNLESS (find pos excludes :test #'equal)
94 COLLECT pos)))
f9bce83 @sile ロジック部分がほぼ完成
authored
95 0 bomb-count)))
ec9f53f @sile おおむね完成
authored
96 (loop FOR (x y) IN bombs DO
97 (setf (cell (game-board game) x y) :bomb)))
f9bce83 @sile ロジック部分がほぼ完成
authored
98
ec9f53f @sile おおむね完成
authored
99 (each (cell state :x x :y y) game
100 (unless (eq cell :bomb)
101 (setf cell (count :bomb (surrounding-cells game x y)
102 :key (lambda (pos)
103 (cell (game-board game) (first pos) (second pos)))))))
f9bce83 @sile ロジック部分がほぼ完成
authored
104 (open-cell game init-x init-y))
105
106 (defun open-cell (game x y &optional (open-surrounding-cells t))
107 (ecase (cell (game-cell-states game) x y)
108 (:flag 'ignore)
109 (:open (when (and (not (has-bomb? game x y))
110 open-surrounding-cells)
111 (open-surrounding-cells game x y)))
112 (:mask
113 (setf (cell (game-cell-states game) x y) :open)
114 (when (and (not (has-bomb? game x y))
115 (zerop (cell (game-board game) x y)))
116 (loop FOR (x~ y~) IN (surrounding-cells game x y)
117 DO (open-cell game x~ y~ nil))))))
118
119 (defun flip-flag (game x y)
120 (ecase #1=(cell (game-cell-states game) x y)
121 (:open 'ignore)
122 (:flag (setf #1# :mask))
123 (:mask (setf #1# :flag))))
124
125 (defun has-bomb? (game x y)
126 (eq (cell (game-board game) x y) :bomb))
127
128 (defun bomb-count (game &aux (count 0))
129 (each (cell state :result-form count) game
130 (when (eq cell :bomb)
131 (incf count))))
132
133 (defun flag-count (game &aux (count 0))
134 (each (cell state :result-form count) game
135 (when (eq state :flag)
136 (incf count))))
137
138 (defun finish? (game)
139 (each (cell state) game
140 (when (and (eq cell :bomb)
141 (eq state :open))
ec9f53f @sile おおむね完成
authored
142 (return-from finish? (values t nil))))
f9bce83 @sile ロジック部分がほぼ完成
authored
143
144 (each (cell state) game
145 (when (eq state :mask)
146 (return-from finish? (values nil nil))))
147
148 (when (/= (bomb-count game) (flag-count game))
149 (return-from finish? (values nil nil)))
150
ec9f53f @sile おおむね完成
authored
151 (values t t))
Something went wrong with that request. Please try again.