extra/scryfall/scryfall.factor

   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 combinators http.download images.loader images.viewer io
   5 io.directories json json.http kernel math math.parser
   6 math.statistics namespaces sequences sequences.extras sets
   7 sorting splitting ui.gadgets.panes unicode urls ;
   8 IN: scryfall
   9
  10 CONSTANT: scryfall-oracle-json-path "resource:scryfall-oracle-json"
  11 CONSTANT: scryfall-artwork-json-path "resource:scryfall-artwork-json"
  12 CONSTANT: scryfall-default-json-path "resource:scryfall-default-json"
  13 CONSTANT: scryfall-all-json-path "resource:scryfall-all-json"
  14 CONSTANT: scryfall-rulings-json-path "resource:scryfall-rulings-json"
  15 CONSTANT: scryfall-images-path "resource:scryfall-images/"
  16
  17 : ?print ( str/f -- ) [ print ] [ nl ] if* ;
  18
  19 : download-scryfall-bulk-json ( -- json )
  20     "https://api.scryfall.com/bulk-data" http-get-json nip ;
  21
  22 : find-scryfall-json ( type -- json/f )
  23     [ download-scryfall-bulk-json "data" of ] dip '[ "type" of _ = ] filter ?first ;
  24
  25 : load-scryfall-json ( type path -- uri )
  26     [ find-scryfall-json "download_uri" of ] dip
  27     120 hours download-outdated-to path>json ;
  28
  29 MEMO: mtg-oracle-cards ( -- json )
  30     "oracle_cards" scryfall-oracle-json-path load-scryfall-json ;
  31
  32 : mtg-artwork-cards ( -- json )
  33     "unique_artwork" scryfall-artwork-json-path load-scryfall-json ;
  34
  35 MEMO: scryfall-default-cards-json ( -- json )
  36     "default_cards" scryfall-default-json-path load-scryfall-json ;
  37
  38 MEMO: scryfall-all-cards-json ( -- json )
  39     "all_cards" scryfall-all-json-path load-scryfall-json ;
  40
  41 MEMO: scryfall-rulings-json ( -- json )
  42     "rulings" scryfall-rulings-json-path load-scryfall-json ;
  43
  44 : ensure-scryfall-images-directory ( -- )
  45     scryfall-images-path make-directories ;
  46
  47 : scryfall-local-image-path ( string -- path )
  48     >url path>> "/" ?head drop "/" "-" replace
  49     scryfall-images-path "" prepend-as ;
  50
  51 : map-card-faces ( assoc quot -- seq )
  52     [ "card_faces" of ] dip map ; inline
  53
  54 : card>image-uris ( assoc -- seq )
  55     [ "image_uris" of ]
  56     [ 1array ]
  57     [ "card_faces" of [ "image_uris" of ] map ] ?if ;
  58
  59 : small-images ( seq -- seq' ) [ "small" of ] map ;
  60 : normal-images ( seq -- seq' ) [ "normal" of ] map ;
  61
  62 : download-scryfall-image ( assoc -- path )
  63     dup scryfall-local-image-path dup delete-when-zero-size
  64     [ download-once-to ] [ nip ] if ;
  65
  66 : download-normal-images ( seq -- seq' )
  67     ensure-scryfall-images-directory
  68     normal-images [ download-scryfall-image load-image ] map ;
  69
  70 : download-small-images ( seq -- seq' )
  71     ensure-scryfall-images-directory
  72     small-images [ download-scryfall-image load-image ] map ;
  73
  74 MEMO: all-cards-by-name ( -- assoc )
  75     mtg-oracle-cards
  76     [ "name" of ] collect-by
  77     [ first ] map-values ;
  78
  79 : find-card-by-name ( seq name -- card ) '[ "name" of _ = ] filter ;
  80 : cards-by-name ( seq -- assoc ) [ "name" of ] collect-by ;
  81 : cards-by-cmc ( seq -- assoc ) [ "cmc" of ] collect-by ;
  82 : cards-by-color-identity ( seq -- assoc ) [ "color_identity" of ] collect-by-multi ;
  83 : red-color-identity ( seq -- seq' ) cards-by-color-identity "R" of ;
  84 : blue-color-identity ( seq -- seq' ) cards-by-color-identity "U" of ;
  85 : green-color-identity ( seq -- seq' ) cards-by-color-identity "G" of ;
  86 : black-color-identity ( seq -- seq' ) cards-by-color-identity "B" of ;
  87 : white-color-identity ( seq -- seq' ) cards-by-color-identity "W" of ;
  88
  89 : find-card-by-color-identity-intersect ( cards colors -- cards' )
  90     [ cards-by-color-identity ] dip [ of ] with map intersect-all ;
  91
  92 : find-any-color-identities ( cards colors -- cards' )
  93     [ cards-by-color-identity ] dip [ of ] with map union-all ;
  94
  95 : color-identity-complement ( seq -- seq' ) [ { "W" "U" "B" "R" "G" } ] dip diff ;
  96
  97 : remove-color-identities ( cards colors -- cards' )
  98     dupd find-any-color-identities diff ;
  99
 100 : remove-other-color-identities ( cards colors -- cards' )
 101     color-identity-complement remove-color-identities ;
 102
 103 : find-only-color-identities ( cards colors -- cards' )
 104     [ find-any-color-identities ] keep remove-other-color-identities ;
 105
 106 : filter-color-identity-length= ( seq n -- seq' ) '[ "color_identity" of length _ = ] filter ;
 107 : filter-color-identity-length<= ( seq n -- seq' ) '[ "color_identity" of length _ <= ] filter ;
 108 : find-exact-color-identities ( cards seq -- cards' )
 109     [ find-card-by-color-identity-intersect ] keep length filter-color-identity-length= ;
 110
 111 : filter-azorius-any ( seq -- seq' ) { "W" "U" } find-any-color-identities ;
 112 : filter-dimir-any ( seq -- seq' ) { "U" "B" } find-any-color-identities ;
 113 : filter-orzhov-any ( seq -- seq' ) { "W" "B" } find-any-color-identities ;
 114 : filter-boros-any ( seq -- seq' ) { "R" "W" } find-any-color-identities ;
 115 : filter-selesnya-any ( seq -- seq' ) { "G" "W" } find-any-color-identities ;
 116 : filter-simic-any ( seq -- seq' ) { "G" "U" } find-any-color-identities ;
 117 : filter-izzet-any ( seq -- seq' ) { "R" "U" } find-any-color-identities ;
 118 : filter-golgari-any ( seq -- seq' ) { "B" "G" } find-any-color-identities ;
 119 : filter-rakdos-any ( seq -- seq' ) { "B" "R" } find-any-color-identities ;
 120 : filter-gruul-any ( seq -- seq' ) { "G" "R" } find-any-color-identities ;
 121
 122 : filter-azorius-only ( seq -- seq' ) { "W" "U" } find-only-color-identities ;
 123 : filter-dimir-only ( seq -- seq' ) { "U" "B" } find-only-color-identities ;
 124 : filter-orzhov-only ( seq -- seq' ) { "W" "B" } find-only-color-identities ;
 125 : filter-boros-only ( seq -- seq' ) { "R" "W" } find-only-color-identities ;
 126 : filter-selesnya-only ( seq -- seq' ) { "G" "W" } find-only-color-identities ;
 127 : filter-simic-only ( seq -- seq' ) { "G" "U" } find-only-color-identities ;
 128 : filter-izzet-only ( seq -- seq' ) { "R" "U" } find-only-color-identities ;
 129 : filter-golgari-only ( seq -- seq' ) { "B" "G" } find-only-color-identities ;
 130 : filter-rakdos-only ( seq -- seq' ) { "B" "R" } find-only-color-identities ;
 131 : filter-gruul-only ( seq -- seq' ) { "G" "R" } find-only-color-identities ;
 132
 133 : filter-azorius-exact ( seq -- seq' ) { "W" "U" } find-exact-color-identities ;
 134 : filter-dimir-exact ( seq -- seq' ) { "U" "B" } find-exact-color-identities ;
 135 : filter-orzhov-exact ( seq -- seq' ) { "W" "B" } find-exact-color-identities ;
 136 : filter-boros-exact ( seq -- seq' ) { "R" "W" } find-exact-color-identities ;
 137 : filter-selesnya-exact ( seq -- seq' ) { "G" "W" } find-exact-color-identities ;
 138 : filter-simic-exact ( seq -- seq' ) { "G" "U" } find-exact-color-identities ;
 139 : filter-izzet-exact ( seq -- seq' ) { "R" "U" } find-exact-color-identities ;
 140 : filter-golgari-exact ( seq -- seq' ) { "B" "G" } find-exact-color-identities ;
 141 : filter-rakdos-exact ( seq -- seq' ) { "B" "R" } find-exact-color-identities ;
 142 : filter-gruul-exact ( seq -- seq' ) { "G" "R" } find-exact-color-identities ;
 143
 144 : filter-bant-any ( seq -- seq' ) { "G" "W" "U" } find-any-color-identities ;
 145 : filter-esper-any ( seq -- seq' ) { "W" "U" "B" } find-any-color-identities ;
 146 : filter-grixis-any ( seq -- seq' ) { "U" "B" "R" } find-any-color-identities ;
 147 : filter-jund-any ( seq -- seq' ) { "B" "R" "G" } find-any-color-identities ;
 148 : filter-naya-any ( seq -- seq' ) { "R" "G" "W" } find-any-color-identities ;
 149 : filter-abzan-any ( seq -- seq' ) { "W" "B" "G" } find-any-color-identities ;
 150 : filter-jeskai-any ( seq -- seq' ) { "U" "R" "W" } find-any-color-identities ;
 151 : filter-mardu-any ( seq -- seq' ) { "R" "W" "B" } find-any-color-identities ;
 152 : filter-sultai-any ( seq -- seq' ) { "B" "G" "U" } find-any-color-identities ;
 153 : filter-temur-any ( seq -- seq' ) { "G" "U" "R" } find-any-color-identities ;
 154
 155 : filter-bant-only ( seq -- seq' ) { "G" "W" "U" } find-only-color-identities ;
 156 : filter-esper-only ( seq -- seq' ) { "W" "U" "B" } find-only-color-identities ;
 157 : filter-grixis-only ( seq -- seq' ) { "U" "B" "R" } find-only-color-identities ;
 158 : filter-jund-only ( seq -- seq' ) { "B" "R" "G" } find-only-color-identities ;
 159 : filter-naya-only ( seq -- seq' ) { "R" "G" "W" } find-only-color-identities ;
 160 : filter-abzan-only ( seq -- seq' ) { "W" "B" "G" } find-only-color-identities ;
 161 : filter-jeskai-only ( seq -- seq' ) { "U" "R" "W" } find-only-color-identities ;
 162 : filter-mardu-only ( seq -- seq' ) { "R" "W" "B" } find-only-color-identities ;
 163 : filter-sultai-only ( seq -- seq' ) { "B" "G" "U" } find-only-color-identities ;
 164 : filter-temur-only ( seq -- seq' ) { "G" "U" "R" } find-only-color-identities ;
 165
 166 : filter-bant-exact ( seq -- seq' ) { "G" "W" "U" } find-exact-color-identities ;
 167 : filter-esper-exact ( seq -- seq' ) { "W" "U" "B" } find-exact-color-identities ;
 168 : filter-grixis-exact ( seq -- seq' ) { "U" "B" "R" } find-exact-color-identities ;
 169 : filter-jund-exact ( seq -- seq' ) { "B" "R" "G" } find-exact-color-identities ;
 170 : filter-naya-exact ( seq -- seq' ) { "R" "G" "W" } find-exact-color-identities ;
 171 : filter-abzan-exact ( seq -- seq' ) { "W" "B" "G" } find-exact-color-identities ;
 172 : filter-jeskai-exact ( seq -- seq' ) { "U" "R" "W" } find-exact-color-identities ;
 173 : filter-mardu-exact ( seq -- seq' ) { "R" "W" "B" } find-exact-color-identities ;
 174 : filter-sultai-exact ( seq -- seq' ) { "B" "G" "U" } find-exact-color-identities ;
 175 : filter-temur-exact ( seq -- seq' ) { "G" "U" "R" } find-exact-color-identities ;
 176
 177 : filter-non-white ( seq -- seq' ) { "U" "B" "R" "G" } find-any-color-identities ;
 178 : filter-non-blue ( seq -- seq' ) { "W" "B" "R" "G" } find-any-color-identities ;
 179 : filter-non-black ( seq -- seq' ) { "W" "U" "R" "G" } find-any-color-identities ;
 180 : filter-non-red ( seq -- seq' ) { "W" "U" "B" "G" } find-any-color-identities ;
 181 : filter-non-green ( seq -- seq' ) { "W" "U" "B" "R" } find-any-color-identities ;
 182
 183 : filter-legalities ( seq name -- seq' ) '[ "legalities" of _ of "legal" = ] filter ;
 184 : filter-standard ( seq -- seq' ) "standard" filter-legalities ;
 185 : filter-future ( seq -- seq' ) "future" filter-legalities ;
 186 : filter-historic ( seq -- seq' ) "historic" filter-legalities ;
 187 : filter-timeless ( seq -- seq' ) "timeless" filter-legalities ;
 188 : filter-gladiator ( seq -- seq' ) "gladiator" filter-legalities ;
 189 : filter-pioneer ( seq -- seq' ) "pioneer" filter-legalities ;
 190 : filter-explorer ( seq -- seq' ) "explorer" filter-legalities ;
 191 : filter-modern ( seq -- seq' ) "modern" filter-legalities ;
 192 : filter-legacy ( seq -- seq' ) "legacy" filter-legalities ;
 193 : filter-pauper ( seq -- seq' ) "pauper" filter-legalities ;
 194 : filter-vintage ( seq -- seq' ) "vintage" filter-legalities ;
 195 : filter-penny ( seq -- seq' ) "penny" filter-legalities ;
 196 : filter-commander ( seq -- seq' ) "commander" filter-legalities ;
 197 : filter-oathbreaker ( seq -- seq' ) "oathbreaker" filter-legalities ;
 198 : filter-standardbrawl ( seq -- seq' ) "standardbrawl" filter-legalities ;
 199 : filter-brawl ( seq -- seq' ) "brawl" filter-legalities ;
 200 : filter-alchemy ( seq -- seq' ) "alchemy" filter-legalities ;
 201 : filter-paupercommander ( seq -- seq' ) "paupercommander" filter-legalities ;
 202 : filter-duel ( seq -- seq' ) "duel" filter-legalities ;
 203 : filter-oldschool ( seq -- seq' ) "oldschool" filter-legalities ;
 204 : filter-premodern ( seq -- seq' ) "premodern" filter-legalities ;
 205 : filter-predh ( seq -- seq' ) "predh" filter-legalities ;
 206
 207 : filter-red-any ( seq -- seq' ) [ "colors" of "R" swap member? ] filter ;
 208 : filter-red-only ( seq -- seq' ) [ "colors" of { "R" } = ] filter ;
 209 : filter-blue-any ( seq -- seq' ) [ "colors" of "U" swap member? ] filter ;
 210 : filter-blue-only ( seq -- seq' ) [ "colors" of { "U" } = ] filter ;
 211 : filter-green-any ( seq -- seq' ) [ "colors" of "G" swap member? ] filter ;
 212 : filter-green-only ( seq -- seq' ) [ "colors" of { "G" } = ] filter ;
 213 : filter-black-any ( seq -- seq' ) [ "colors" of "B" swap member? ] filter ;
 214 : filter-black-only ( seq -- seq' ) [ "colors" of { "B" } = ] filter ;
 215 : filter-white-any ( seq -- seq' ) [ "colors" of "W" swap member? ] filter ;
 216 : filter-white-only ( seq -- seq' ) [ "colors" of { "W" } = ] filter ;
 217 : filter-multi-color ( seq -- seq' ) [ "colors" of length 1 > ] filter ;
 218 : filter-cmc= ( seq n -- seq' ) >float '[ "cmc" of _ = ] filter ;
 219 : filter-cmc< ( seq n -- seq' ) >float '[ "cmc" of _ < ] filter ;
 220 : filter-cmc<= ( seq n -- seq' ) >float '[ "cmc" of _ <= ] filter ;
 221 : filter-cmc> ( seq n -- seq' ) >float '[ "cmc" of _ > ] filter ;
 222 : filter-cmc>= ( seq n -- seq' ) >float '[ "cmc" of _ >= ] filter ;
 223
 224 : parse-type-line ( string -- pairs )
 225     " // " split1
 226     [
 227         [
 228             " — " split1
 229             [ [ " " split ] ?call >array ] bi@ 2array
 230         ] ?call
 231     ] bi@ 2array sift ;
 232
 233 : type-line-of ( assoc -- string ) "type_line" of parse-type-line ;
 234 : any-type? ( seq name -- ? ) [ type-line-of ] dip '[ first _ member-of? ] any? ;
 235 : any-subtype? ( seq name -- ? ) [ type-line-of ] dip '[ second _ member-of? ] any? ;
 236
 237 : filter-creature-type ( seq type -- seq' ) '[ _ any-subtype? ] filter ;
 238
 239 : filter-land ( seq -- seq' ) [ "Land" any-type? ] filter ;
 240 : filter-creature ( seq -- seq' ) [ "Creature" any-type? ] filter ;
 241 : filter-enchantment ( seq -- seq' ) [ "Enchantment" any-type? ] filter ;
 242 : filter-instant ( seq -- seq' ) [ "Instant" any-type? ] filter ;
 243 : filter-sorcery ( seq -- seq' ) [ "Sorcery" any-type? ] filter ;
 244 : filter-planeswalker ( seq -- seq' ) [ "Planeswalker" any-type? ] filter ;
 245
 246 : filter-common ( seq -- seq' ) '[ "rarity" of "common" = ] filter ;
 247 : filter-uncommon ( seq -- seq' ) '[ "rarity" of "uncommon" = ] filter ;
 248 : filter-rare ( seq -- seq' ) '[ "rarity" of "rare" = ] filter ;
 249 : filter-mythic ( seq -- seq' ) '[ "rarity" of "mythic" = ] filter ;
 250
 251 : standard-cards ( -- seq' ) mtg-oracle-cards filter-standard ;
 252
 253 : sort-by-cmc ( assoc -- assoc' ) [ "cmc" of ] sort-by ;
 254 : histogram-by-cmc ( assoc -- assoc' ) [ "cmc" of ] histogram-by sort-keys ;
 255
 256 : filter-by-oracle-text ( seq string -- seq' )
 257     '[ "oracle_text" of _ subseq-of? ] filter ;
 258
 259 : filter-by-oracle-itext ( seq string -- seq' )
 260     >lower
 261     '[ "oracle_text" of >lower _ subseq-of? ] filter ;
 262
 263 : filter-flash ( seq -- seq' ) "Flash" filter-by-oracle-text ;
 264
 265 : map-props ( seq props -- seq' ) '[ _ intersect-keys ] map ;
 266
 267 : gadgets. ( seq -- )
 268     1 cut*
 269     [ output-stream get '[ _ write-gadget ] each ]
 270     [ output-stream get '[ _ print-gadget ] each ] bi* ;
 271
 272 : images. ( seq -- ) [ <image-gadget> ] map gadgets. ;
 273
 274 : small-card. ( assoc -- )
 275     card>image-uris download-small-images images. ;
 276
 277 : small-cards. ( seq -- ) [ small-card. ] each ;
 278
 279 : normal-card. ( assoc -- )
 280     card>image-uris download-normal-images images. ;
 281
 282 : normal-cards. ( seq -- ) [ normal-card. ] each ;
 283
 284 : card-face-summary. ( seq -- )
 285     {
 286         [ "name" of write bl ]
 287         [ "mana_cost" of ?print ]
 288         [ "type_line" of ?print ]
 289         [ [ "power" of ] [ "toughness" of ] bi 2dup and [ "/" glue print ] [ 2drop ] if ]
 290         [ "oracle_text" of ?print ]
 291     } cleave nl ;
 292
 293 : card-face-summaries. ( seq -- ) [ card-face-summary. ] each ;
 294
 295 : card-summary. ( assoc -- )
 296     {
 297         [
 298             [ "card_faces" of ]
 299             [ [ length number>string "Card Faces: " prepend print ] [ card-face-summaries. ] bi ]
 300             [ card-face-summary. ] ?if
 301         ]
 302     } cleave nl nl nl ;
 303
 304 : card-summaries. ( seq -- ) [ card-summary. ] each ;
 305
 306 : card-summary-with-pic. ( assoc -- )
 307     [ normal-card. ]
 308     [ card-summary. ] bi ;
 309
 310 : card-summaries-with-pics. ( seq -- ) [ card-summary-with-pic. ] each ;
 311
 312 : standard-dragons. ( -- )
 313     standard-cards
 314     "Dragon" filter-creature-type
 315     sort-by-cmc
 316     normal-cards. ;
 317
 318 : collect-by-cmc ( seq -- seq' ) [ "cmc" of ] collect-by ;