CommonLispで七並べ序章 | Codetter（こーどったー）

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
;全自動モード
(defconstant AUTO-MODE nil)
;プレイヤー人数
(defconstant PLAYER-NUMBER 4)
;パス回数
(defconstant PASS-NUMBER 3)
(defmacro definit (this slots &body body)
    (let ((self (first slots)) (slots (rest slots)))
        `(defmethod initialize-instance :after ((,self ,this) &key)
            (with-slots ,slots ,self
                ,@body))))
(defmacro defmet (funcname args this slots &body body)
    (let ((self (first slots)) (slots (rest slots)))
        `(defmethod ,funcname ((,self ,this) ,@args)
            (with-slots ,slots ,self
                ,@body))))
;トランプカードクラス
(defconstant TrumpCard-suitStrs #("▲" "▼" "◆" "■" "Jo" "JO"))
(defconstant TrumpCard-powerStrs #("Ａ" "２" "３" "４" "５" "６" "７" "８" "９" "10" "Ｊ" "Ｑ" "Ｋ" "KR"))
(defconstant TrumpCard-suits 4)
(defconstant TrumpCard-powers 13)
(defclass TrumpCard()(
    (power :initarg :power
           :reader   power)
    (suit  :initarg :suit
           :reader   suit)
    (name  :reader   name)
)) 
(definit TrumpCard(self name suit power)
    (setf name (format nil "~A~A" (aref TrumpCard-suitStrs suit) (aref TrumpCard-powerStrs power)))
)
;トランプの束クラス
(defclass TrumpDeck()(
    (g      :initform 0)
    (deck   :reader   :deck
            :initform '())
    (jokers :initarg  :jokers
            :initform 0)
))
(definit TrumpDeck(self deck jokers) 
    (loop for suit from 0 below TrumpCard-suits do
        (loop for power from 0 below TrumpCard-powers do
            (push (make-instance 'TrumpCard :suit suit :power power) deck)
        )
    )
    (loop while (< 0 jokers) do
        (decf jokers)
        (push (make-instance 'TrumpCard :suit (+ TrumpCard-suits jokers) :power TrumpCard-powers) deck)
    )
)
(defmet -count() TrumpDeck(self deck)
    (length deck)
)
(defmet shuffle() TrumpDeck(self deck)
    (let ((seed (make-random-state t)))
        (loop for i from 0 below (length deck) do
            (rotatef (nth i deck) (nth (random (- (length deck) i) seed) deck))
        )
    )
)
(defmet draw() TrumpDeck(self g deck)
    (let ((card (nth g deck)))
        (incf g)
        card
    )
)
;プレイヤークラス
(defclass Player()(
    (deck      :initform '()
               :reader    deck)
    (id        :initarg  :id
               :reader    id)
    (name      :initarg  :name
               :reader    name)
    (isGameOut :initform  nil
               :reader    isGameOut)
))
(defmet sortDeck() Player(self deck)
    (flet ((sortValue(v) (+(*(suit v) TrumpCard-powers) (power v))))
        (setf deck (sort deck #'(lambda(a b) (< (sortValue a) (sortValue b)))))
    )
)
(defmet addCard(card) Player(self deck)
    (push card deck)
)
(defmet removeCard(cardName) Player(self deck)
    (setf deck (delete-if (lambda(v) (string= cardName v)) deck))
)
(defmet existCard(cardName) Player(self deck)
    (position cardName deck :test (lambda(cardName card) (string= cardName (name card))))
)
(defmet gameOut() Player(self)
    (isGameOut t)
)
;メイン処理
(loop for i from 0 below 100 do
    (format t "~%")
)
(princ "
/---------------------------------------/
/                 七並べ                /
/---------------------------------------/
")
(let (
    (trp (make-instance 'TrumpDeck))
    (p '())
    (pid 0)
)
    (shuffle trp)
    (loop for i from 0 below 4 do
        (push (make-instance 'Player :id pid :name (format nil "Player ~d" (1+ pid))) p)
        (incf pid)
    )
    (setf p (nreverse p))
    (loop for i from 0 below (-count trp) do
        (addCard (nth (mod i PLAYER-NUMBER) p) (draw trp))
    )
    (dolist (pl p)
        (sortDeck pl)
        (format t "~%【~A】~%" (name pl))
        (dolist (card (deck pl))
            (princ (name card))
        )
    )
)
(quit)
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX