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