1 ! Copyright (C) 2024 Doug Coleman.
2 ! See https://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs assocs.extras calendar
4 calendar.parser combinators combinators.short-circuit
5 combinators.smart grouping http.download images.loader
6 images.viewer io io.directories json json.http kernel math
7 math.combinatorics math.order math.parser math.statistics
8 namespaces sequences sequences.deep sequences.extras
9 sequences.generalizations sets sorting sorting.specification
10 splitting splitting.extras strings ui.gadgets.panes unicode urls ;
13 CONSTANT: scryfall-oracle-json-path "resource:scryfall-oracle-json"
14 CONSTANT: scryfall-artwork-json-path "resource:scryfall-artwork-json"
15 CONSTANT: scryfall-default-json-path "resource:scryfall-default-json"
16 CONSTANT: scryfall-all-json-path "resource:scryfall-all-json"
17 CONSTANT: scryfall-rulings-json-path "resource:scryfall-rulings-json"
18 CONSTANT: scryfall-images-path "resource:scryfall-images/"
20 : ?write ( str/f -- ) [ write ] when* ;
21 : ?print ( str/f -- ) [ print ] [ nl ] if* ;
23 : download-scryfall-bulk-json ( -- json )
24 "https://api.scryfall.com/bulk-data" http-get-json nip ;
26 : find-scryfall-json ( type -- json/f )
27 [ download-scryfall-bulk-json "data" of ] dip '[ "type" of _ = ] filter ?first ;
29 : load-scryfall-json ( type path -- uri )
30 [ find-scryfall-json "download_uri" of ] dip
31 10 days download-outdated-as path>json ;
33 MEMO: mtg-oracle-cards ( -- json )
34 "oracle_cards" scryfall-oracle-json-path load-scryfall-json ;
36 MEMO: mtg-artwork-cards ( -- json )
37 "unique_artwork" scryfall-artwork-json-path load-scryfall-json ;
39 MEMO: scryfall-default-cards-json ( -- json )
40 "default_cards" scryfall-default-json-path load-scryfall-json ;
42 MEMO: scryfall-all-cards-json ( -- json )
43 "all_cards" scryfall-all-json-path load-scryfall-json ;
45 MEMO: scryfall-rulings-json ( -- json )
46 "rulings" scryfall-rulings-json-path load-scryfall-json ;
48 : ensure-scryfall-images-directory ( -- )
49 scryfall-images-path make-directories ;
51 : scryfall-local-image-path ( string -- path )
52 >url path>> "/" ?head drop "/" "-" replace
53 scryfall-images-path "" prepend-as ;
55 : filter-multi-card-faces ( assoc -- seq )
56 [ "card_faces" of length 1 > ] filter ; inline
58 : multi-card-faces? ( assoc -- seq )
59 "card_faces" of length 1 > ; inline
61 : card>image-uris ( assoc -- seq )
64 [ "card_faces" of [ "image_uris" of ] map ] ?if ;
66 : small-images ( seq -- seq' ) [ "small" of ] map ;
67 : normal-images ( seq -- seq' ) [ "normal" of ] map ;
69 : download-scryfall-image ( assoc -- path )
70 dup scryfall-local-image-path dup delete-when-zero-size
71 [ download-once-as ] [ nip ] if ;
73 : download-normal-images ( seq -- seq' )
74 ensure-scryfall-images-directory
75 normal-images [ download-scryfall-image load-image ] map ;
77 : download-small-images ( seq -- seq' )
78 ensure-scryfall-images-directory
79 small-images [ download-scryfall-image load-image ] map ;
81 : collect-cards-by-name ( seq -- assoc ) [ "name" of ] collect-by ;
82 : collect-cards-by-cmc ( seq -- assoc ) [ "cmc" of ] collect-by ;
83 : collect-cards-by-mana-cost ( seq -- assoc ) [ "mana_cost" of ] collect-by ;
84 : collect-cards-by-color-identity ( seq -- assoc ) [ "color_identity" of ] collect-by-multi ;
85 : red-color-identity ( seq -- seq' ) collect-cards-by-color-identity "R" of ;
86 : blue-color-identity ( seq -- seq' ) collect-cards-by-color-identity "U" of ;
87 : green-color-identity ( seq -- seq' ) collect-cards-by-color-identity "G" of ;
88 : black-color-identity ( seq -- seq' ) collect-cards-by-color-identity "B" of ;
89 : white-color-identity ( seq -- seq' ) collect-cards-by-color-identity "W" of ;
91 : find-card-by-color-identity-intersect ( cards colors -- cards' )
92 [ collect-cards-by-color-identity ] dip [ of ] with map intersect-all ;
94 : find-any-color-identities ( cards colors -- cards' )
95 [ collect-cards-by-color-identity ] dip [ of ] with map union-all ;
97 : color-identity-complement ( seq -- seq' ) [ { "B" "G" "R" "U" "W" } ] dip diff ;
99 : split-mana-cost ( string -- seq )
100 f like [ " // " split1 swap ] { } loop>sequence nip ;
102 : casting-cost-combinations ( seq -- seq' )
103 sequence-cartesian-product [ [ first ] sort-by ] map ;
105 : parse-mana-cost ( string -- seq )
110 casting-cost-combinations
113 : remove-color-identities ( cards colors -- cards' )
114 dupd find-any-color-identities diff ;
116 : remove-other-color-identities ( cards colors -- cards' )
117 color-identity-complement remove-color-identities ;
119 : find-only-color-identities ( cards colors -- cards' )
120 [ find-any-color-identities ] keep remove-other-color-identities ;
122 : filter-color-identity-length= ( seq n -- seq' ) '[ "color_identity" of length _ = ] filter ;
123 : filter-color-identity-length<= ( seq n -- seq' ) '[ "color_identity" of length _ <= ] filter ;
124 : find-exact-color-identities ( cards seq -- cards' )
125 [ find-card-by-color-identity-intersect ] keep length filter-color-identity-length= ;
127 : filter-azorius-any ( seq -- seq' ) { "W" "U" } find-any-color-identities ;
128 : filter-dimir-any ( seq -- seq' ) { "U" "B" } find-any-color-identities ;
129 : filter-orzhov-any ( seq -- seq' ) { "W" "B" } find-any-color-identities ;
130 : filter-boros-any ( seq -- seq' ) { "R" "W" } find-any-color-identities ;
131 : filter-selesnya-any ( seq -- seq' ) { "G" "W" } find-any-color-identities ;
132 : filter-simic-any ( seq -- seq' ) { "G" "U" } find-any-color-identities ;
133 : filter-izzet-any ( seq -- seq' ) { "R" "U" } find-any-color-identities ;
134 : filter-golgari-any ( seq -- seq' ) { "B" "G" } find-any-color-identities ;
135 : filter-rakdos-any ( seq -- seq' ) { "B" "R" } find-any-color-identities ;
136 : filter-gruul-any ( seq -- seq' ) { "G" "R" } find-any-color-identities ;
138 : filter-azorius-only ( seq -- seq' ) { "W" "U" } find-only-color-identities ;
139 : filter-dimir-only ( seq -- seq' ) { "U" "B" } find-only-color-identities ;
140 : filter-orzhov-only ( seq -- seq' ) { "W" "B" } find-only-color-identities ;
141 : filter-boros-only ( seq -- seq' ) { "R" "W" } find-only-color-identities ;
142 : filter-selesnya-only ( seq -- seq' ) { "G" "W" } find-only-color-identities ;
143 : filter-simic-only ( seq -- seq' ) { "G" "U" } find-only-color-identities ;
144 : filter-izzet-only ( seq -- seq' ) { "R" "U" } find-only-color-identities ;
145 : filter-golgari-only ( seq -- seq' ) { "B" "G" } find-only-color-identities ;
146 : filter-rakdos-only ( seq -- seq' ) { "B" "R" } find-only-color-identities ;
147 : filter-gruul-only ( seq -- seq' ) { "G" "R" } find-only-color-identities ;
149 : filter-azorius-exact ( seq -- seq' ) { "W" "U" } find-exact-color-identities ;
150 : filter-dimir-exact ( seq -- seq' ) { "U" "B" } find-exact-color-identities ;
151 : filter-orzhov-exact ( seq -- seq' ) { "W" "B" } find-exact-color-identities ;
152 : filter-boros-exact ( seq -- seq' ) { "R" "W" } find-exact-color-identities ;
153 : filter-selesnya-exact ( seq -- seq' ) { "G" "W" } find-exact-color-identities ;
154 : filter-simic-exact ( seq -- seq' ) { "G" "U" } find-exact-color-identities ;
155 : filter-izzet-exact ( seq -- seq' ) { "R" "U" } find-exact-color-identities ;
156 : filter-golgari-exact ( seq -- seq' ) { "B" "G" } find-exact-color-identities ;
157 : filter-rakdos-exact ( seq -- seq' ) { "B" "R" } find-exact-color-identities ;
158 : filter-gruul-exact ( seq -- seq' ) { "G" "R" } find-exact-color-identities ;
160 : filter-bant-any ( seq -- seq' ) { "G" "W" "U" } find-any-color-identities ;
161 : filter-esper-any ( seq -- seq' ) { "W" "U" "B" } find-any-color-identities ;
162 : filter-grixis-any ( seq -- seq' ) { "U" "B" "R" } find-any-color-identities ;
163 : filter-jund-any ( seq -- seq' ) { "B" "R" "G" } find-any-color-identities ;
164 : filter-naya-any ( seq -- seq' ) { "R" "G" "W" } find-any-color-identities ;
165 : filter-abzan-any ( seq -- seq' ) { "W" "B" "G" } find-any-color-identities ;
166 : filter-jeskai-any ( seq -- seq' ) { "U" "R" "W" } find-any-color-identities ;
167 : filter-mardu-any ( seq -- seq' ) { "R" "W" "B" } find-any-color-identities ;
168 : filter-sultai-any ( seq -- seq' ) { "B" "G" "U" } find-any-color-identities ;
169 : filter-temur-any ( seq -- seq' ) { "G" "U" "R" } find-any-color-identities ;
171 : filter-bant-only ( seq -- seq' ) { "G" "W" "U" } find-only-color-identities ;
172 : filter-esper-only ( seq -- seq' ) { "W" "U" "B" } find-only-color-identities ;
173 : filter-grixis-only ( seq -- seq' ) { "U" "B" "R" } find-only-color-identities ;
174 : filter-jund-only ( seq -- seq' ) { "B" "R" "G" } find-only-color-identities ;
175 : filter-naya-only ( seq -- seq' ) { "R" "G" "W" } find-only-color-identities ;
176 : filter-abzan-only ( seq -- seq' ) { "W" "B" "G" } find-only-color-identities ;
177 : filter-jeskai-only ( seq -- seq' ) { "U" "R" "W" } find-only-color-identities ;
178 : filter-mardu-only ( seq -- seq' ) { "R" "W" "B" } find-only-color-identities ;
179 : filter-sultai-only ( seq -- seq' ) { "B" "G" "U" } find-only-color-identities ;
180 : filter-temur-only ( seq -- seq' ) { "G" "U" "R" } find-only-color-identities ;
182 : filter-bant-exact ( seq -- seq' ) { "G" "W" "U" } find-exact-color-identities ;
183 : filter-esper-exact ( seq -- seq' ) { "W" "U" "B" } find-exact-color-identities ;
184 : filter-grixis-exact ( seq -- seq' ) { "U" "B" "R" } find-exact-color-identities ;
185 : filter-jund-exact ( seq -- seq' ) { "B" "R" "G" } find-exact-color-identities ;
186 : filter-naya-exact ( seq -- seq' ) { "R" "G" "W" } find-exact-color-identities ;
187 : filter-abzan-exact ( seq -- seq' ) { "W" "B" "G" } find-exact-color-identities ;
188 : filter-jeskai-exact ( seq -- seq' ) { "U" "R" "W" } find-exact-color-identities ;
189 : filter-mardu-exact ( seq -- seq' ) { "R" "W" "B" } find-exact-color-identities ;
190 : filter-sultai-exact ( seq -- seq' ) { "B" "G" "U" } find-exact-color-identities ;
191 : filter-temur-exact ( seq -- seq' ) { "G" "U" "R" } find-exact-color-identities ;
193 : filter-non-white ( seq -- seq' ) { "U" "B" "R" "G" } find-only-color-identities ;
194 : filter-non-blue ( seq -- seq' ) { "W" "B" "R" "G" } find-only-color-identities ;
195 : filter-non-black ( seq -- seq' ) { "W" "U" "R" "G" } find-only-color-identities ;
196 : filter-non-red ( seq -- seq' ) { "W" "U" "B" "G" } find-only-color-identities ;
197 : filter-non-green ( seq -- seq' ) { "W" "U" "B" "R" } find-only-color-identities ;
199 : filter-legalities ( seq name -- seq' ) '[ "legalities" of _ of "legal" = ] filter ;
200 : filter-standard ( seq -- seq' ) "standard" filter-legalities ;
201 : filter-future ( seq -- seq' ) "future" filter-legalities ;
202 : filter-historic ( seq -- seq' ) "historic" filter-legalities ;
203 : filter-timeless ( seq -- seq' ) "timeless" filter-legalities ;
204 : filter-gladiator ( seq -- seq' ) "gladiator" filter-legalities ;
205 : filter-pioneer ( seq -- seq' ) "pioneer" filter-legalities ;
206 : filter-explorer ( seq -- seq' ) "explorer" filter-legalities ;
207 : filter-modern ( seq -- seq' ) "modern" filter-legalities ;
208 : filter-legacy ( seq -- seq' ) "legacy" filter-legalities ;
209 : filter-pauper ( seq -- seq' ) "pauper" filter-legalities ;
210 : filter-vintage ( seq -- seq' ) "vintage" filter-legalities ;
211 : filter-penny ( seq -- seq' ) "penny" filter-legalities ;
212 : filter-commander ( seq -- seq' ) "commander" filter-legalities ;
213 : filter-oathbreaker ( seq -- seq' ) "oathbreaker" filter-legalities ;
214 : filter-standardbrawl ( seq -- seq' ) "standardbrawl" filter-legalities ;
215 : filter-brawl ( seq -- seq' ) "brawl" filter-legalities ;
216 : filter-alchemy ( seq -- seq' ) "alchemy" filter-legalities ;
217 : filter-paupercommander ( seq -- seq' ) "paupercommander" filter-legalities ;
218 : filter-duel ( seq -- seq' ) "duel" filter-legalities ;
219 : filter-oldschool ( seq -- seq' ) "oldschool" filter-legalities ;
220 : filter-premodern ( seq -- seq' ) "premodern" filter-legalities ;
221 : filter-predh ( seq -- seq' ) "predh" filter-legalities ;
223 : spanish-standard-cards ( -- seq )
224 scryfall-all-cards-json
226 [ "lang" of "es" = ] filter ;
228 : filter-red-any ( seq -- seq' ) [ "colors" of "R" swap member? ] filter ;
229 : filter-red-only ( seq -- seq' ) [ "colors" of { "R" } = ] filter ;
230 : filter-blue-any ( seq -- seq' ) [ "colors" of "U" swap member? ] filter ;
231 : filter-blue-only ( seq -- seq' ) [ "colors" of { "U" } = ] filter ;
232 : filter-green-any ( seq -- seq' ) [ "colors" of "G" swap member? ] filter ;
233 : filter-green-only ( seq -- seq' ) [ "colors" of { "G" } = ] filter ;
234 : filter-black-any ( seq -- seq' ) [ "colors" of "B" swap member? ] filter ;
235 : filter-black-only ( seq -- seq' ) [ "colors" of { "B" } = ] filter ;
236 : filter-white-any ( seq -- seq' ) [ "colors" of "W" swap member? ] filter ;
237 : filter-white-only ( seq -- seq' ) [ "colors" of { "W" } = ] filter ;
238 : filter-multi-color ( seq -- seq' ) [ "colors" of length 1 > ] filter ;
239 : filter-cmc= ( seq n -- seq' ) >float '[ "cmc" of _ = ] filter ;
240 : filter-cmc< ( seq n -- seq' ) >float '[ "cmc" of _ < ] filter ;
241 : filter-cmc<= ( seq n -- seq' ) >float '[ "cmc" of _ <= ] filter ;
242 : filter-cmc> ( seq n -- seq' ) >float '[ "cmc" of _ > ] filter ;
243 : filter-cmc>= ( seq n -- seq' ) >float '[ "cmc" of _ >= ] filter ;
245 : parse-type-line ( string -- pairs )
250 [ [ " " split ] ?call >array ] bi@ 2array
254 : type-line-of ( assoc -- string ) "type_line" of parse-type-line ;
256 : types-of ( assoc -- seq ) type-line-of [ first ] map concat ;
257 : subtypes-of ( assoc -- seq ) type-line-of [ second ] map concat ;
259 ! cards can have several type lines (one for each face)
260 : any-type? ( json name -- ? )
261 [ type-line-of ] dip >lower '[ first [ >lower ] map _ member-of? ] any? ;
262 : any-subtype? ( json name -- ? )
263 [ type-line-of ] dip >lower '[ second [ >lower ] map _ member-of? ] any? ;
265 : type-intersects? ( json types -- ? )
266 [ type-line-of ] dip [ >lower ] map '[ first [ >lower ] map _ intersects? ] any? ;
267 : subtype-intersects? ( json subtypes -- ? )
268 [ type-line-of ] dip [ >lower ] map '[ second [ >lower ] map _ intersects? ] any? ;
270 : filter-type ( seq text -- seq' ) '[ _ any-type? ] filter ;
271 : filter-subtype ( seq text -- seq' ) '[ _ any-subtype? ] filter ;
272 : filter-type-intersects ( seq text -- seq' ) '[ _ type-intersects? ] filter ;
273 : filter-subtype-intersects ( seq text -- seq' ) '[ _ subtype-intersects? ] filter ;
275 : filter-basic ( seq -- seq' ) [ "Basic" any-type? ] filter ;
276 : filter-basic-subtype ( seq text -- seq' ) [ filter-basic ] dip filter-subtype ;
277 : filter-land ( seq -- seq' ) [ "Land" any-type? ] filter ;
278 : filter-land-subtype ( seq text -- seq' ) [ filter-land ] dip filter-subtype ;
279 : filter-creature ( seq -- seq' ) [ "Creature" any-type? ] filter ;
280 : filter-creature-subtype ( seq text -- seq' ) [ filter-creature ] dip filter-subtype ;
281 : filter-emblem ( seq -- seq' ) [ "Emblem" any-type? ] filter ;
282 : filter-emblem-subtype ( seq text -- seq' ) [ filter-emblem ] dip filter-subtype ;
283 : filter-enchantment ( seq -- seq' ) [ "Enchantment" any-type? ] filter ;
284 : filter-enchantment-subtype ( seq text -- seq' ) [ filter-enchantment ] dip filter-subtype ;
285 : filter-saga ( seq -- seq' ) "saga" filter-enchantment-subtype ;
286 : filter-instant ( seq -- seq' ) [ "Instant" any-type? ] filter ;
287 : filter-instant-subtype ( seq text -- seq' ) [ filter-instant ] dip filter-subtype ;
288 : filter-sorcery ( seq -- seq' ) [ "Sorcery" any-type? ] filter ;
289 : filter-sorcery-subtype ( seq text -- seq' ) [ filter-sorcery ] dip filter-subtype ;
290 : filter-planeswalker ( seq -- seq' ) [ "Planeswalker" any-type? ] filter ;
291 : filter-planeswalker-subtype ( seq text -- seq' ) [ filter-planeswalker ] dip filter-subtype ;
292 : filter-legendary ( seq -- seq' ) [ "Legendary" any-type? ] filter ;
293 : filter-legendary-subtype ( seq text -- seq' ) [ filter-legendary ] dip filter-subtype ;
294 : filter-battle ( seq -- seq' ) [ "Battle" any-type? ] filter ;
295 : filter-battle-subtype ( seq text -- seq' ) [ filter-battle ] dip filter-subtype ;
296 : filter-artifact ( seq -- seq' ) [ "Artifact" any-type? ] filter ;
297 : filter-artifact-subtype ( seq text -- seq' ) [ filter-artifact ] dip filter-subtype ;
299 : reject-basic ( seq -- seq' ) [ "Basic" any-type? ] reject ;
300 : reject-land ( seq -- seq' ) [ "Land" any-type? ] reject ;
301 : reject-creature ( seq -- seq' ) [ "Creature" any-type? ] reject ;
302 : reject-emblem ( seq -- seq' ) [ "Emblem" any-type? ] reject ;
303 : reject-enchantment ( seq -- seq' ) [ "Enchantment" any-type? ] reject ;
304 : reject-instant ( seq -- seq' ) [ "Instant" any-type? ] reject ;
305 : reject-sorcery ( seq -- seq' ) [ "Sorcery" any-type? ] reject ;
306 : reject-planeswalker ( seq -- seq' ) [ "Planeswalker" any-type? ] reject ;
307 : reject-legendary ( seq -- seq' ) [ "Legendary" any-type? ] reject ;
308 : reject-battle ( seq -- seq' ) [ "Battle" any-type? ] reject ;
309 : reject-artifact ( seq -- seq' ) [ "Artifact" any-type? ] reject ;
311 : filter-mounts ( seq -- seq' ) "mount" filter-subtype ;
312 : filter-vehicles ( seq -- seq' ) "vehicle" filter-subtype ;
313 : filter-adventure ( seq -- seq' ) "adventure" filter-subtype ;
314 : filter-aura ( seq -- seq' ) "aura" filter-subtype ;
315 : filter-aura-subtype ( seq text -- seq' ) [ filter-aura ] dip filter-subtype ;
316 : filter-equipment ( seq -- seq' ) "Equipment" filter-subtype ;
317 : filter-equipment-subtype ( seq text -- seq' ) [ filter-equipment ] dip filter-subtype ;
319 : filter-common ( seq -- seq' ) '[ "rarity" of "common" = ] filter ;
320 : filter-uncommon ( seq -- seq' ) '[ "rarity" of "uncommon" = ] filter ;
321 : filter-rare ( seq -- seq' ) '[ "rarity" of "rare" = ] filter ;
322 : filter-mythic ( seq -- seq' ) '[ "rarity" of "mythic" = ] filter ;
324 : standard-cards ( -- seq' ) mtg-oracle-cards filter-standard ;
325 : historic-cards ( -- seq' ) mtg-oracle-cards filter-historic ;
326 : modern-cards ( -- seq' ) mtg-oracle-cards filter-modern ;
328 : sort-by-cmc ( assoc -- assoc' ) [ "cmc" of ] sort-by ;
329 : histogram-by-cmc ( assoc -- assoc' ) [ "cmc" of ] histogram-by sort-keys ;
331 : filter-by-itext-prop ( seq string prop -- seq' )
332 swap >lower '[ _ of >lower _ subseq-of? ] filter ;
334 : filter-by-text-prop ( seq string prop -- seq' )
335 swap '[ _ of _ subseq-of? ] filter ;
337 : map-card-faces ( json quot -- seq )
338 '[ [ "card_faces" of ] [ ] [ 1array ] ?if _ map ] map ; inline
340 : all-card-types ( seq -- seq' )
341 [ "type_line" of ] map-card-faces
342 concat members sort ;
344 : card>faces ( assoc -- seq )
345 [ "card_faces" of ] [ ] [ 1array ] ?if ;
347 : filter-card-faces-sub-card ( seq quot -- seq )
348 [ [ card>faces ] map concat ] dip filter ; inline
350 : filter-card-faces-sub-card-prop ( seq string prop -- seq' )
351 swap '[ _ of _ subseq-of? ] filter-card-faces-sub-card ;
353 : filter-card-faces-sub-card-iprop ( seq string prop -- seq' )
354 swap >lower '[ _ of >lower _ subseq-of? ] filter-card-faces-sub-card ;
356 : filter-card-faces-main-card ( seq quot -- seq )
357 dup '[ [ "card_faces" of ] [ _ any? ] _ ?if ] filter ; inline
359 : filter-card-faces-main-card-prop ( seq string prop -- seq' )
360 swap '[ _ of _ subseq-of? ] filter-card-faces-main-card ;
362 : filter-card-faces-main-card-iprop ( seq string prop -- seq' )
363 swap >lower '[ _ of >lower _ subseq-of? ] filter-card-faces-main-card ;
365 : filter-by-flavor-text ( seq string -- seq' )
366 "flavor_text" filter-card-faces-main-card-prop ;
368 : filter-by-flavor-itext ( seq string -- seq' )
369 "flavor_text" filter-card-faces-main-card-iprop ;
371 : filter-by-oracle-text ( seq string -- seq' )
372 "oracle_text" filter-card-faces-main-card-prop ;
374 : filter-by-oracle-itext ( seq string -- seq' )
375 "oracle_text" filter-card-faces-main-card-iprop ;
377 : filter-by-name-text ( seq string -- seq' ) "name" filter-by-text-prop ;
378 : filter-by-name-itext ( seq string -- seq' ) "name" filter-by-itext-prop ;
380 : filter-create-treasure ( seq -- seq' ) "create a treasure token" filter-by-oracle-itext ;
381 : filter-treasure-token ( seq -- seq' ) "treasure token" filter-by-oracle-itext ;
382 : filter-create-blood-token ( seq -- seq' ) "create a blood token" filter-by-oracle-itext ;
383 : filter-blood-token ( seq -- seq' ) "blood token" filter-by-oracle-itext ;
384 : filter-create-map-token ( seq -- seq' ) "create a map token" filter-by-oracle-itext ;
385 : filter-map-token ( seq -- seq' ) "map token" filter-by-oracle-itext ;
387 : filter-affinity ( seq -- seq' ) "affinity" filter-by-oracle-itext ;
388 : filter-backup ( seq -- seq' ) "backup" filter-by-oracle-itext ;
389 : filter-blitz ( seq -- seq' ) "blitz" filter-by-oracle-itext ;
390 : filter-compleated ( seq -- seq' ) "compleated" filter-by-oracle-itext ;
391 : filter-corrupted ( seq -- seq' ) "corrupted" filter-by-oracle-itext ;
392 : filter-counter ( seq -- seq' ) "counter" filter-by-oracle-itext ;
393 : filter-crew ( seq -- seq' ) "crew" filter-by-oracle-itext ;
394 : filter-cycling ( seq -- seq' ) "cycling" filter-by-oracle-itext ;
395 : filter-deathtouch ( seq -- seq' ) "deathtouch" filter-by-oracle-itext ;
396 : filter-defender ( seq -- seq' ) "defender" filter-by-oracle-itext ;
397 : filter-descend ( seq -- seq' ) "descend" filter-by-oracle-itext ;
398 : filter-destroy-target ( seq -- seq' ) "destroy target" filter-by-oracle-itext ;
399 : filter-discover ( seq -- seq' ) "discover" filter-by-oracle-itext ;
400 : filter-disguise ( seq -- seq' ) "disguise" filter-by-oracle-itext ;
401 : filter-domain ( seq -- seq' ) "domain" filter-by-oracle-itext ;
402 : filter-double-strike ( seq -- seq' ) "double strike" filter-by-oracle-itext ;
403 : filter-equip ( seq -- seq' ) "equip" filter-by-oracle-itext ;
404 : filter-equip-n ( seq -- seq' ) "equip {" filter-by-oracle-itext ;
405 : filter-exile ( seq -- seq' ) "exile" filter-by-oracle-itext ;
406 : filter-fights ( seq -- seq' ) "fights" filter-by-oracle-itext ;
407 : filter-first-strike ( seq -- seq' ) "first strike" filter-by-oracle-itext ;
408 : filter-flash ( seq -- seq' ) "flash" filter-by-oracle-itext ;
409 : filter-flying ( seq -- seq' ) "flying" filter-by-oracle-itext ;
410 : filter-for-mirrodin ( seq -- seq' ) "for mirrodin!" filter-by-oracle-itext ;
411 : filter-graveyard ( seq -- seq' ) "graveyard" filter-by-oracle-itext ;
412 : filter-haste ( seq -- seq' ) "haste" filter-by-oracle-itext ;
413 : filter-hideaway ( seq -- seq' ) "hideaway" filter-by-oracle-itext ;
414 : filter-hexproof ( seq -- seq' ) "hexproof" filter-by-oracle-itext ;
415 : filter-indestructible ( seq -- seq' ) "indestructible" filter-by-oracle-itext ;
416 : filter-investigate ( seq -- seq' ) "investigate" filter-by-oracle-itext ;
417 : filter-lifelink ( seq -- seq' ) "lifelink" filter-by-oracle-itext ;
418 : filter-madness ( seq -- seq' ) "madness" filter-by-oracle-itext ;
419 : filter-menace ( seq -- seq' ) "menace" filter-by-oracle-itext ;
420 : filter-mill ( seq -- seq' ) "mill" filter-by-oracle-itext ;
421 : filter-ninjutsu ( seq -- seq' ) "ninjutsu" filter-by-oracle-itext ;
422 : filter-proliferate ( seq -- seq' ) "proliferate" filter-by-oracle-itext ;
423 : filter-protection ( seq -- seq' ) "protection" filter-by-oracle-itext ;
424 : filter-prowess ( seq -- seq' ) "prowess" filter-by-oracle-itext ;
425 : filter-reach ( seq -- seq' ) "reach" filter-by-oracle-itext ;
426 : filter-read-ahead ( seq -- seq' ) "read ahead" filter-by-oracle-itext ;
427 : filter-reconfigure ( seq -- seq' ) "reconfigure" filter-by-oracle-itext ;
428 : filter-role ( seq -- seq' ) "role" filter-by-oracle-itext ;
429 : filter-sacrifice ( seq -- seq' ) "sacrifice" filter-by-oracle-itext ;
430 : filter-scry ( seq -- seq' ) "scry" filter-by-oracle-itext ;
431 : filter-shroud ( seq -- seq' ) "shroud" filter-by-oracle-itext ;
432 : filter-token ( seq -- seq' ) "token" filter-by-oracle-itext ;
433 : filter-toxic ( seq -- seq' ) "toxic" filter-by-oracle-itext ;
434 : filter-trample ( seq -- seq' ) "trample" filter-by-oracle-itext ;
435 : filter-vehicle ( seq -- seq' ) "vehicle" filter-by-oracle-itext ;
436 : filter-vigilance ( seq -- seq' ) "vigilance" filter-by-oracle-itext ;
437 : filter-ward ( seq -- seq' ) "ward" filter-by-oracle-itext ;
439 : filter-day ( seq -- seq' ) "day" filter-by-oracle-itext ;
440 : filter-night ( seq -- seq' ) "night" filter-by-oracle-itext ;
441 : filter-daybound ( seq -- seq' ) "daybound" filter-by-oracle-itext ;
442 : filter-nightbound ( seq -- seq' ) "nightbound" filter-by-oracle-itext ;
444 : filter-cave ( seq -- seq' ) "cave" filter-land-subtype ;
445 : filter-sphere ( seq -- seq' ) "sphere" filter-land-subtype ;
447 : filter-mount ( seq -- seq' ) "mount" filter-by-oracle-itext ;
448 : filter-outlaw ( seq -- seq' )
449 { "Assassin" "Mercenary" "Pirate" "Rogue" "Warlock" } filter-subtype-intersects ;
450 : filter-plot ( seq -- seq' ) "plot" filter-by-oracle-itext ;
451 : filter-saddle ( seq -- seq' ) "saddle" filter-by-oracle-itext ;
452 : filter-spree ( seq -- seq' ) "saddle" filter-by-oracle-itext ;
454 : power>n ( string -- n/f )
455 [ "*" = ] [ drop -1 ] [ string>number ] ?if ;
457 : mtg< ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ < ] } 2&& ;
458 : mtg<= ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ <= ] } 2&& ;
459 : mtg> ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ > ] } 2&& ;
460 : mtg>= ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ >= ] } 2&& ;
461 : mtg= ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ = ] } 2&& ;
463 : filter-power=* ( seq -- seq' ) [ "power" of "*" = ] filter-card-faces-main-card ;
464 : filter-toughness=* ( seq -- seq' ) [ "toughness" of "*" = ] filter-card-faces-main-card ;
466 : filter-power= ( seq n -- seq' ) '[ "power" of _ mtg= ] filter-card-faces-main-card ;
467 : filter-power< ( seq n -- seq' ) '[ "power" of _ mtg< ] filter-card-faces-main-card ;
468 : filter-power> ( seq n -- seq' ) '[ "power" of _ mtg> ] filter-card-faces-main-card ;
469 : filter-power<= ( seq n -- seq' ) '[ "power" of _ mtg<= ] filter-card-faces-main-card ;
470 : filter-power>= ( seq n -- seq' ) '[ "power" of _ mtg>= ] filter-card-faces-main-card ;
472 : filter-toughness= ( seq n -- seq' ) '[ "toughness" of _ mtg= ] filter-card-faces-main-card ;
473 : filter-toughness< ( seq n -- seq' ) '[ "toughness" of _ mtg< ] filter-card-faces-main-card ;
474 : filter-toughness> ( seq n -- seq' ) '[ "toughness" of _ mtg> ] filter-card-faces-main-card ;
475 : filter-toughness<= ( seq n -- seq' ) '[ "toughness" of _ mtg<= ] filter-card-faces-main-card ;
476 : filter-toughness>= ( seq n -- seq' ) '[ "toughness" of _ mtg>= ] filter-card-faces-main-card ;
478 : map-props ( seq props -- seq' ) '[ _ intersect-keys ] map ;
480 : gadgets. ( seq -- )
482 [ output-stream get '[ _ write-gadget ] each ]
483 [ output-stream get '[ _ print-gadget ] each ] bi* ;
485 : images. ( seq -- ) [ <image-gadget> ] map gadgets. ;
487 : normal-images-grid. ( seq -- )
489 [ [ card>image-uris ] map concat download-normal-images images. ] each ;
491 : small-card. ( assoc -- )
492 card>image-uris download-small-images images. ;
494 : small-cards. ( seq -- ) [ small-card. ] each ;
496 : normal-card. ( assoc -- )
497 card>image-uris download-normal-images images. ;
499 : normal-cards. ( seq -- ) [ normal-card. ] each ;
501 ! rarity is only on main card `json` (if there are two faces)
502 : card-face-summary. ( json seq -- )
504 [ nip "name" of write bl ]
505 [ nip "mana_cost" of ?print ]
506 [ nip "type_line" of ?write ]
507 [ drop bl "--" write bl "rarity" of >title ?print ]
508 [ nip [ "power" of ] [ "toughness" of ] bi 2dup and [ "/" glue print ] [ 2drop ] if ]
509 [ nip "oracle_text" of ?print ]
512 : card-face-summaries. ( json seq -- ) [ card-face-summary. ] with each ;
514 : card-summary. ( assoc -- )
517 [ [ length number>string "Card Faces: " prepend print ] [ card-face-summaries. ] bi ]
518 [ card-face-summary. ] ?if nl nl nl ;
520 : card-summaries. ( seq -- ) [ card-summary. ] each ;
522 : card-summary-with-pic. ( assoc -- )
524 [ card-summary. ] bi ;
526 : card-summaries-with-pics. ( seq -- ) [ card-summary-with-pic. ] each ;
528 : standard-dragons. ( -- )
530 "Dragon" filter-creature-subtype
534 : collect-by-cmc ( seq -- seq' ) [ "cmc" of ] collect-by ;
536 MEMO: mtg-sets-by-abbrev ( -- assoc )
537 scryfall-all-cards-json
538 [ [ "set" of ] [ "set_name" of ] bi ] H{ } map>assoc ;
540 MEMO: mtg-sets-by-name ( -- assoc )
541 scryfall-all-cards-json
542 [ [ "set_name" of ] [ "set" of ] bi ] H{ } map>assoc ;
544 : filter-mtg-set ( seq abbrev -- seq ) '[ "set" of _ = ] filter ;
546 : unique-set-names ( seq -- seq' ) [ "set_name" of ] map members ;
547 : unique-set-abbrevs ( seq -- seq' ) [ "set" of ] map members ;
549 : standard-set-names ( -- seq ) standard-cards unique-set-names ;
550 : standard-set-abbrevs ( -- seq ) standard-cards unique-set-abbrevs ;
553 : sets-by-release-date ( -- assoc )
554 scryfall-all-cards-json
555 [ [ "set_name" of ] [ "released_at" of ] bi ] H{ } map>assoc
558 : collect-cards-by-set-abbrev ( seq -- assoc ) [ "set" of ] collect-by ;
559 : collect-cards-by-set-name ( seq -- assoc ) [ "set_name" of ] collect-by ;
560 : cards-by-set-abbrev ( -- assoc ) mtg-oracle-cards collect-cards-by-set-abbrev ;
561 : cards-by-set-name ( -- assoc ) mtg-oracle-cards collect-cards-by-set-name ;
563 : filter-set ( seq abbrev -- seq ) >lower '[ "set" of _ = ] filter ;
564 : filter-set-intersect ( seq abbrevs -- seq ) [ >lower ] map '[ "set" of _ member? ] filter ;
566 : mid-cards ( -- seq ) mtg-oracle-cards "mid" filter-set ;
567 : vow-cards ( -- seq ) mtg-oracle-cards "vow" filter-set ;
568 : neo-cards ( -- seq ) mtg-oracle-cards "neo" filter-set ;
569 : snc-cards ( -- seq ) mtg-oracle-cards "snc" filter-set ;
570 : dmu-cards ( -- seq ) mtg-oracle-cards "dmu" filter-set ;
571 : bro-cards ( -- seq ) mtg-oracle-cards "bro" filter-set ;
572 : one-cards ( -- seq ) mtg-oracle-cards "one" filter-set ;
573 : mom-cards ( -- seq ) mtg-oracle-cards "mom" filter-set ;
574 : mat-cards ( -- seq ) mtg-oracle-cards "mat" filter-set ;
575 : woe-cards ( -- seq ) mtg-oracle-cards "woe" filter-set ;
576 : woe-cards-bonus ( -- seq ) mtg-oracle-cards [ "set" of "wot" = ] filter-set ;
577 : woe-cards-all ( -- seq ) mtg-oracle-cards { "woe" "wot" } filter-set-intersect ;
578 : lci-cards ( -- seq ) mtg-oracle-cards "lci" filter-set ;
579 : mkm-cards ( -- seq ) mtg-oracle-cards "mkm" filter-set ;
580 : otj-cards ( -- seq ) mtg-oracle-cards "otj" filter-set ;
581 : otj-cards-bonus ( -- seq ) mtg-oracle-cards "big" filter-set ;
582 : otj-cards-all ( -- seq ) mtg-oracle-cards { "otj" "big" } filter-set-intersect ;
584 : sort-by-colors ( seq -- seq' )
586 { [ "color_identity" of length ] <=> }
587 { [ "color_identity" of sort ?first "A" or ] <=> }
589 { [ "mana_cost" of length ] <=> }
590 { [ "creature" any-type? -1 1 ? ] <=> }
591 { [ "power" of -1 1 ? ] <=> }
592 { [ "toughness" of -1 1 ? ] <=> }
593 { [ "name" of ] <=> }
596 : cards-by-color. ( seq -- ) sort-by-colors normal-cards. ;
598 CONSTANT: rarity-to-number H{
605 : sort-by-rarity ( seq -- seq' )
607 { [ "rarity" of rarity-to-number at ] <=> }
608 { [ "color_identity" of length ] <=> }
609 { [ "color_identity" of sort ?first "A" or ] <=> }
611 { [ "mana_cost" of length ] <=> }
612 { [ "name" of ] <=> }
615 : cards-by-rarity. ( seq -- ) sort-by-rarity normal-cards. ;
617 : sort-by-release ( seq -- seq' )
619 { [ "released_at" of ymd>timestamp ] <=> }
623 : cards-by-release. ( seq -- ) sort-by-release normal-cards. ;
625 : sort-by-set-colors ( seq -- seq' )
627 { [ "released_at" of ymd>timestamp ] <=> }
629 { [ "color_identity" of length ] <=> }
630 { [ "color_identity" of sort ?first "A" or ] <=> }
632 { [ "mana_cost" of length ] <=> }
633 { [ "creature" any-type? -1 1 ? ] <=> }
634 { [ "power" of -1 1 ? ] <=> }
635 { [ "toughness" of -1 1 ? ] <=> }
636 { [ "name" of ] <=> }
639 : cards-by-set-colors. ( seq -- ) sort-by-set-colors normal-cards. ;
641 : cards-by-name ( seq name -- seq' ) filter-by-name-itext sort-by-release ;
642 : cards-by-name. ( seq name -- ) cards-by-name [ "name" of ] sort-by normal-cards. ;
644 : paren-set? ( string -- ? )
645 { [ "(" head? ] [ ")" tail? ] [ length 5 = ] } 1&& ;
647 : remove-set-and-num ( string -- string' )
650 [ paren-set? ] [ string>number ] bi* and [
654 : parse-mtga-card-line ( string -- array )
660 standard-cards swap cards-by-name first
663 : parse-standard-cards ( strings -- seq )
664 [ parse-mtga-card-line ] map concat ;
666 TUPLE: mtga-deck about deck sideboard section ;
668 : <mtga-deck> ( -- mtga-deck )
669 mtga-deck new "Deck" >>section ;
671 ERROR: unknown-mtga-deck-section section ;
672 : parse-mtga-standard-deck ( string -- mtga-deck )
673 string-lines [ [ blank? ] trim ] map harvest
674 { "About" "Deck" "Sideboard" } split*
677 dup { "About" "Deck" "Sideboard" } intersects? [
681 { "About" [ >>about ] }
682 { "Deck" [ parse-standard-cards >>deck ] }
683 { "Sideboard" [ parse-standard-cards >>sideboard ] }
684 [ unknown-mtga-deck-section ]
689 : sort-by-deck-order ( seq -- seq' )
690 [ "Land" any-type? not ] partition
691 [ sort-by-set-colors ] bi@ append ;
693 : mtga-deck. ( mtga-deck -- )
695 [ deck>> "Deck" print sort-by-deck-order normal-cards. ]
696 [ sideboard>> "Sideboard" print sort-by-deck-order normal-cards. ] tri ;
698 : filter-mtg-cheat-sheet ( seq -- seq' )
707 ] { } append-outputs-as sort-by-colors ;
709 : mtg-cheat-sheet. ( seq -- ) filter-mtg-cheat-sheet normal-cards. ;
710 : mtg-cheat-sheet-text. ( seq -- ) filter-mtg-cheat-sheet card-summaries. ;