-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathinternal-player.rkt
197 lines (162 loc) · 9.14 KB
/
internal-player.rkt
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
#lang racket
;; represents the "ground truth" state of players:
;; -- what the referee knows about the players,
;; -- what other players know about each other.
;
;
; ;;;
; ; ;
; ; ;
; ;;;; ;; ;; ;;;;;; ;;;; ;;;; ; ;;; ;;; ;
; ; ; ; ; ; ; ; ;; ; ;; ; ; ; ;
; ;;;;;; ;; ; ;;;;;; ; ; ; ; ;
; ; ;; ; ; ; ; ; ;;;;; ;
; ; ;; ; ; ; ; ; ; ; ;
; ;; ; ; ; ; ;; ; ; ; ; ; ;; ;
; ;;;;; ; ; ;;; ;;;;; ; ; ; ;;; ; ;;;
;
;
;
;
(require (only-in Fish/Common/penguin penguin/c))
(require (only-in Fish/Common/fish fish#/c))
(require (only-in Fish/Common/board posn/c))
(require (only-in pict pict?))
(provide
(contract-out
(iplayer? contract?)
(create-player
;; set up an internal player representation, knowledge about players
(-> penguin/c any/c iplayer?))
(upscore-player
;; increase this player's running score
(-> iplayer? fish#/c iplayer?))
(+place-player
;; add an avatar location to this player's places
(-> iplayer? posn/c iplayer?))
(move-player
;; move an avatar of this player from old to new
(->i ([p iplayer?] [old (p) posn/c] [new posn/c])
#:pre/name (old p) "avatar exists" (member old (iplayer-places p))
[r (old) (and/c iplayer? (λ (np) (not (member old (iplayer-places np)))))]))
(iplayer-penguin (-> iplayer? pict?))
(iplayer-color (-> iplayer? string?))
(iplayer-places (-> iplayer? (listof posn/c)))
(iplayer-payload (-> iplayer? any))
(iplayer-score (-> iplayer? natural-number/c))))
;
;
; ; ; ;
; ; ;
; ; ;
; ;;; ; ;;;; ; ;;; ;;;; ; ;;; ;;; ; ;;;; ; ;;; ;;; ;;; ;;;; ;;;;
; ;; ;; ; ; ;; ;; ; ; ;; ; ;; ;; ; ; ;; ; ; ; ; ; ; ; ;
; ; ; ;;;;;; ; ; ;;;;;; ; ; ; ; ;;;;;; ; ; ; ; ;;;;;; ;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;
; ;; ;; ;; ; ;; ;; ;; ; ; ; ;; ;; ;; ; ; ; ; ; ; ;; ; ; ;
; ;;; ; ;;;;; ; ;;; ;;;;; ; ; ;;; ; ;;;;; ; ; ;;; ;;;;; ;;;;; ;;;;
; ;
; ;
; ;
;
(module+ test
(require rackunit))
(module+ serialize
(require SwDev/Lib/pattern-matching))
;
;
; ;
; ; ;
; ; ;
; ;;; ; ;;; ;;;;;; ;;; ;;;; ;;;; ; ;;;
; ;; ;; ; ; ; ; ; ;; ; ; ; ;; ;;
; ; ; ; ; ; ; ;;;;;; ; ;
; ; ; ;;;;; ; ;;;;; ; ; ; ;
; ; ; ; ; ; ; ; ; ; ; ; ;;
; ;; ;; ; ;; ; ; ;; ; ;; ; ;; ;; ;;
; ;;; ; ;;; ; ;;; ;;; ; ; ;;;;; ; ;;; ;;
; ;
; ;
; ;
;
(struct iplayer [color penguin score places payload] #:prefab)
#; {type InternalPlayer = (player ColorString Penguin Score [Listof Posn/c])}
;; the player is represented by Penguin in the visual display, uses the specified color, has collected
;; `score` fish, its penguins occupy the `places`, and an external client may use `payload` for ANY/C
(define (create-player pc x)
(match-define (list color penguin) pc)
(iplayer color penguin 0 '[] x))
(define (upscore-player p delta)
(struct-copy iplayer p [score (+ (iplayer-score p) delta)]))
(define (+place-player p place)
(struct-copy iplayer p [places (cons place (iplayer-places p))]))
(define (move-player p old nu)
(struct-copy iplayer p [places (cons nu (remove old (iplayer-places p)))]))
;
;
;
; ; ;
; ; ;
; ;;;;;; ;;;; ;;;; ;;;;;; ;;;;
; ; ; ; ; ; ; ; ;
; ; ;;;;;; ; ; ;
; ; ; ;;;; ; ;;;;
; ; ; ; ; ;
; ; ;; ; ; ; ; ; ;
; ;;; ;;;;; ;;;; ;;; ;;;;
;
;
;
;
(module+ test
(define basic-player (create-player '["red" dot] 'payload))
(check-equal? (iplayer-score (upscore-player basic-player 5)) 5 "upscore")
(check-equal? (iplayer-places (+place-player basic-player '[2 2])) '[[2 2]] "+place")
(define +player (+place-player basic-player '[2 2]))
(check-equal? (iplayer-places (move-player +player '[2 2] '[2 3])) '[[2 3]] "move"))
;
;
; ; ;;; ;
; ;
; ;
; ;;;; ;;;; ;;;; ;;; ;;; ; ;;; ;;;;;; ;;;;
; ; ; ; ; ;; ; ; ; ; ; ; ;; ; ;
; ; ;;;;;; ; ; ; ; ; ;; ;;;;;;
; ;;;; ; ; ; ;;;;; ; ; ;; ;
; ; ; ; ; ; ; ; ; ;; ;
; ; ; ;; ; ; ; ; ;; ; ; ;; ;; ;
; ;;;; ;;;;; ; ;;;;; ;;; ; ;;; ;;;;; ;;;;;; ;;;;;
;
;
;
;
(module+ serialize
(require (only-in json jsexpr?))
(provide
COLOR SCORE PLACES
(contract-out
(player-validator (-> jsexpr? any))
(jsexpr->player (-> any/c #;"after you called board validator on this input" iplayer?))
(player->jsexpr (-> iplayer? jsexpr?))))
(require (submod Fish/Common/board serialize))
(require Fish/Common/penguin)
(define COLOR 'color)
(define SCORE 'score)
(define PLACES 'places)
(def/mp player [_ c s p]
#'(hash-table
(COLOR (? penguin-color/c c))
(SCORE (? natural? s))
(PLACES (list (? posn-validator p) (... ...)))))
;; does the JSON value satisfy the spec for boards: (board f)
(define (player-validator j)
(match j
[[player c s p] #true]
[j #false]))
(define (jsexpr->player j)
(match j
[(player c s p) (iplayer c (cadar penguins) s p 'xternal)]))
(define (player->jsexpr ip)
(match-define (iplayer c _ s places _) ip)
(make-hasheq `[ (,COLOR . ,c) (,SCORE . ,s) (,PLACES . ,(map posn->jsexpr places))])))