Merge branch 'loot-fixup'

* loot-fixup:
  allow stickering individual loot cards
  extract standard-loot-deck
  cleanup make-sample-loot-deck
  convert cards-per-deck to type->number-of-cards
  make loot-picker take type->cards instead
  re-align loot-type/c
  refactor split data inputs to build-loot-deck
  split data inputs to build-loot-deck
  fixup! add back button from build-loot-deck mode
  fixup loot-cards lang: use money pattern variable

defns/loot.rkt

@@ -20,11 +20,15 @@
   [money-deck (apply list/c (make-list max-money-cards money?))]
   [material-decks (hash/c material-kind? (apply list/c (make-list max-material-cards material?)))]
   [herb-decks (hash/c herb-kind? (apply list/c (make-list max-herb-cards herb?)))]
+  [standard-loot-deck (hash/c loot-type/c (listof loot-card?))]
   [material-kinds (listof material-kind?)]
   [herb-kinds (listof herb-kind?)]
-  [apply-sticker (-> (and/c loot-card? (not/c random-item?)) loot-card?)]))
+  [apply-sticker (-> (and/c loot-card? (not/c random-item?)) loot-card?)]
+  [loot-type/c flat-contract?]
+  [card->type (-> loot-card? loot-type/c)]))
 
 (require
+ racket/hash
  racket/serialize
  rebellion/type/enum
  frosthaven-manager/qi
@@ -110,3 +114,18 @@
     [(money amount) (money (add1 amount))]
     [(material name amount) (material name (map add1 amount))]
     [(herb name amount) (herb name (add1 amount))]))
+
+(define loot-type/c
+  (or/c 'money material-kind? herb-kind? 'random-item))
+
+(define (card->type c)
+  (match c
+    [(money _) 'money]
+    [(material m _) m]
+    [(herb t _) t]
+    [(? random-item?) 'random-item]))
+
+(define standard-loot-deck
+  (hash-union (hash 'money money-deck 'random-item (list random-item))
+              material-decks
+              herb-decks))

gui/deserialized-state.rkt

@@ -21,7 +21,7 @@
    (~a-view "level" state-@level s)
    (~a-view "num-players" state-@num-players s)
    (pp-view "creatures" state-@creatures s)
-   (pp-view "cards-per-deck" state-@cards-per-deck s)
+   (pp-view "type->number-of-cards" state-@type->number-of-cards s)
    (pp-view "loot-deck" state-@loot-deck s)
    (~a-view "num-loot-cards" state-@num-loot-cards s)
    (apply hpanel

gui/loot.rkt

@@ -2,8 +2,10 @@
 
 (provide
   (contract-out
-    [loot-picker (->* ((obs/c (hash/c (listof loot-card?) natural-number/c)))
-                      (#:on-card (-> (list/c (or/c 'add 'remove) (listof loot-card?)) any))
+    [loot-picker (->* ((obs/c (hash/c loot-type/c natural-number/c))
+                       (obs/c (hash/c loot-type/c (listof loot-card?))))
+                      (#:on-card (-> (list/c (or/c 'add 'remove) loot-type/c) any)
+                       #:on-deck (-> (hash/c loot-type/c (listof loot-card?)) any))
                       (is-a?/c view<%>))]
     [loot-button
       (->* ((obs/c (listof loot-card?))
@@ -22,45 +24,110 @@
          frosthaven-manager/observable-operator
          racket/gui/easy/contract
          frosthaven-manager/defns
+         frosthaven-manager/files
          frosthaven-manager/gui/mixins
          frosthaven-manager/gui/counter
          frosthaven-manager/gui/render
-         frosthaven-manager/gui/table)
+         frosthaven-manager/gui/table
+         frosthaven-manager/gui/rich-text-display
+         frosthaven-manager/qi)
 
-(define (loot-picker @cards-per-deck #:on-card [on-card void])
-  (define cards-picker (make-cards-picker! @cards-per-deck #:on-card on-card))
-  (define money-view (cards-picker "Money Cards: " max-money-cards money-deck))
+(define (loot-picker @type->cards @type->deck
+                     #:on-card [on-card void]
+                     #:on-deck [on-deck void])
+  (hpanel
+   (loot-cards-loader @type->deck #:on-deck on-deck)
+   (base-loot-picker @type->cards #:on-card on-card)))
+
+(define (base-loot-picker @type->cards #:on-card [on-card void])
+  (define cards-picker (make-cards-picker! @type->cards #:on-card on-card))
+  (define money-view (cards-picker "Money Cards: " max-money-cards 'money))
   (define material-views
     (for/list ([m (in-list material-kinds)])
-      (cards-picker (~a m " Cards: ") max-material-cards (hash-ref material-decks m))))
+      (cards-picker (~a m " Cards: ") max-material-cards m)))
   (define herb-views
     (for/list ([h (in-list herb-kinds)])
-      (cards-picker (~a h " Cards: ") max-herb-cards (hash-ref herb-decks h))))
+      (cards-picker (~a h " Cards: ") max-herb-cards h)))
   (define random-item-view
-    (let ([deck (list random-item)])
-      (checkbox #:label "Random Item Card?"
-                #:checked? (@~> @cards-per-deck (~> (hash-ref deck 0) (> 0)))
-                (match-lambda
-                  [#t (on-card `(add ,deck))]
-                  [#f (on-card `(remove ,deck))]))))
+    (checkbox #:label "Random Item Card?"
+              #:checked? (@~> @type->cards (~> (hash-ref 'random-item 0) (> 0)))
+              (match-lambda
+                [#t (on-card `(add random-item))]
+                [#f (on-card `(remove random-item))])))
   (vpanel
     #:stretch '(#f #f)
+    (text "Loot Cards in the Loot Deck")
     random-item-view
     money-view
     (apply group "Materials" material-views)
     (apply group "Herbs" herb-views)))
 
-(define ((make-cards-picker! @cards-per-deck #:on-card on-card)
-         label max-cards deck)
-  (define @n (@~> @cards-per-deck (hash-ref deck 0)))
+(define ((make-cards-picker! @type->cards #:on-card on-card)
+         label max-cards type)
+  (define @n (@~> @type->cards (hash-ref type 0)))
   (define (subtract-card)
     (when (> (@! @n) 0)
-      (on-card `(remove ,deck))))
+      (on-card `(remove ,type))))
   (define (add-card)
     (when (< (@! @n) max-cards)
-      (on-card `(add ,deck))))
+      (on-card `(add ,type))))
   (hpanel (spacer) (counter (@~> @n (~a label _)) add-card subtract-card) (spacer)))
 
+(define (loot-cards-loader @type->deck #:on-deck [on-deck void])
+  (define/obs @error-text "")
+  (define (call-with-error-text th)
+    (:= @error-text "")
+    (with-handlers ([exn:fail? (λ (e) (:= @error-text (exn-message e)))])
+      (th)))
+  (define-syntax-rule (with-error-text e ...)
+    (call-with-error-text (thunk e ...)))
+  (define (load-standard-cards)
+    (:= @error-text "")
+    (on-deck standard-loot-deck))
+  (define (load-cards)
+    (with-error-text
+     (define file
+       (get-file/filter "Loot Cards File" '("Loot Cards" "*.rkt")))
+     (when file
+       (define loot-cards (dynamic-require file 'loot-cards))
+       (on-deck loot-cards))))
+  (define (make-table-entries type->deck)
+    (for*/vector ([(type deck) (in-hash type->deck)]
+                  [card (in-list deck)])
+      (cons type card)))
+  (define (make-columns type+card)
+    (match-define (cons _type card) type+card)
+    (for/vector ([num-players '(2 3 4)])
+      ((format-loot-card num-players) card)))
+  (vpanel
+   (text "Useable Loot Cards")
+   (table
+    '("2 players" "3 players" "4 players")
+    (@> @type->deck make-table-entries)
+    (λ (action entries selection)
+      (case action
+        [(dclick)
+         (when (and selection (exact-nonnegative-integer? selection))
+           (match-define (cons type card) (vector-ref entries selection))
+           (define new-card (apply-sticker card))
+           (on-deck
+            (~> (entries) vector->list
+                (list-set selection (cons type new-card))
+                (group-by car _)
+                (list~>hash #:->key (~> car car)
+                            #:->value (map cdr _)))))]))
+    #:entry->row make-columns)
+   (vpanel
+    #:stretch '(#f #f)
+    (hpanel (button "Use Standard Loot Cards" load-standard-cards)
+            (button "Load Loot Cards" load-cards))
+    (cond-view
+      [(@> @error-text non-empty-string?)
+       (hpanel (text "Error Message:" #:color "red")
+               (rich-text-display (@~> @error-text (~> (string-split "\n") (add-between newline)))
+                                       #:min-size '(#f 60)))]
+      [else (spacer)]))))
+
 (define (loot-button @loot-deck
                      @num-loot-cards
                      @num-players
@@ -132,12 +199,8 @@
 (module+ main
   (require frosthaven-manager/manager)
   (define s (make-state))
-  (define/match (find-deck card)
-    [{(money _)} "Money"]
-    [{(or (material kind _) (herb kind _))} (~a kind)]
-    [{(== random-item)} "Random Item"])
   (define (table-with-actual-loot-deck)
-    (define @deck (@> @cards-per-loot-deck build-loot-deck))
+    (define @deck (obs-combine build-loot-deck @type->cards @type->deck))
     ;; not setting current renderer, nor using an eventspace: dialog
     (vpanel
       (hpanel (text "Duplicates?")
@@ -146,13 +209,17 @@
              (@> @deck list->vector)
              #:entry->row (flow (~> (-< eq-hash-code _) (>< ~a) vector))
              #:min-size '(250 300))))
-  (define-flow count+decks->row (~> (-< (~> car car find-deck) (~> cdr ~a)) vector))
-  (define/obs @cards-per-loot-deck (state-@cards-per-deck s))
+  (define-flow count+decks->row (~> (-< car cdr) (>< ~a) vector))
+  (define @type->cards (state-@type->number-of-cards s))
+  (define @type->deck (state-@type->deck s))
   (void (render/eventspace
           ;; no separate eventspace: block main until this window closed
-          (window (hpanel (loot-picker #:on-card (update-loot-deck-and-num-loot-cards s))
+          (window (hpanel (loot-picker @type->cards
+                                       @type->deck
+                                       #:on-card (update-loot-deck-and-num-loot-cards s)
+                                       #:on-deck (λ:= (state-@type->deck s)))
                           (table '("Deck" "Cards")
-                                 (@~> @cards-per-loot-deck (~> hash->list list->vector))
+                                 (@~> @type->cards (~> hash->list list->vector))
                                  #:entry->row count+decks->row
                                  #:min-size '(250 #f))
                           (table-with-actual-loot-deck))))))

gui/manager.rkt

@@ -103,7 +103,10 @@
 
 (define (build-loot-deck-view s)
   (vpanel
-    (loot-picker (state-@cards-per-deck s) #:on-card (update-loot-deck-and-num-loot-cards s))
+    (loot-picker (state-@type->number-of-cards s)
+                 (state-@type->deck s)
+                 #:on-card (update-loot-deck-and-num-loot-cards s)
+                 #:on-deck (λ:= (state-@type->deck s)))
     (spacer)
     (hpanel #:stretch '(#t #f)
             #:alignment '(center center)

gui/table.rkt

@@ -51,10 +51,15 @@
                   name-text))
 
   (test-case "make-preview-rows for loot deck"
-    (define loot-deck (build-loot-deck (hash money-deck 3
-                                             (hash-ref material-decks lumber) 2
-                                             (hash-ref material-decks hide) 2
-                                             (hash-ref herb-decks axenut) 2)))
+    (define loot-deck (build-loot-deck
+                       (hash 'money 3
+                             lumber 2
+                             hide 2
+                             axenut 2)
+                       (hash 'money money-deck
+                             lumber (hash-ref material-decks lumber)
+                             hide (hash-ref material-decks hide)
+                             axenut (hash-ref herb-decks axenut))))
     (define n-players 3)
     (define loot-text (list->vector (map vector (map (format-loot-card n-players) loot-deck))))
     (define-flow reveal (~> (esc (format-loot-card n-players)) vector))

loot-cards.rkt

@@ -35,7 +35,7 @@
    #:attributes {constructor}
    #:literals {money}
    [pattern [money amount:number]
-            #:with constructor #'(money number)])
+            #:with constructor #'(money amount)])
  (define-syntax-class material-spec
    #:attributes {constructor}
    #:literals {lumber metal hide}
@@ -61,10 +61,7 @@
   (-sticker (list (cons stickers c.constructor) ...)))
 
 (define (-extend-standard-deck)
-  (const
-   (hash-union (hash money money-deck 'random-item (list random-item))
-               material-decks
-               herb-decks)))
+  (const standard-loot-deck))
 
 (define ((-sticker stickers-per-card) x)
   (let loop ([res (hash)]
@@ -73,11 +70,7 @@
     (match stickers-per-card
       ['() (hash-union res x #:combine append)]
       [(cons (cons n card) stickers-per-card)
-       (define type
-         (match card
-           [(money _) money]
-           [(material m _) m]
-           [(herb t _) t]))
+       (define type (card->type card))
        (define old-card
          (match (member card (hash-ref x type))
            [(cons old-card _) old-card]

manager/loot.rkt

@@ -3,8 +3,9 @@
 (provide
   (contract-out
     [update-loot-deck-and-num-loot-cards
-      (-> state? (-> (list/c (or/c 'add 'remove) (listof loot-card?)) any))]
-    [build-loot-deck (-> (hash/c (listof loot-card?) natural-number/c)
+      (-> state? (-> (list/c (or/c 'add 'remove) loot-type/c) any))]
+    [build-loot-deck (-> (hash/c loot-type/c natural-number/c)
+                         (hash/c loot-type/c (listof loot-card?))
                          (listof loot-card?))]
     [build-loot-deck! (-> state? any)]
     [give-player-loot (-> state? (-> any/c any))]
@@ -19,7 +20,7 @@
 (module+ test (require rackunit))
 
 (define ((update-loot-deck-and-num-loot-cards s) evt)
-  ((loot-picker-updater (state-@cards-per-deck s)) evt)
+  ((loot-picker-updater (state-@type->number-of-cards s)) evt)
   (<@ (state-@num-loot-cards s) (case (car evt) [(add) add1] [(remove) sub1])))
 
 ;; valid: only called if loot-deck non-empty, loot assigned
@@ -73,21 +74,24 @@
 (define (place-loot-on-bottom s)
   (<~@ (state-@loot-deck s) rotate))
 
-(define ((loot-picker-updater @cards-per-loot-deck) evt)
+(define ((loot-picker-updater @type->number-of-cards) evt)
   (define (update cards-per-loot-deck)
     (match evt
-      [`(add ,deck) (hash-update cards-per-loot-deck deck add1 0)]
-      [`(remove ,deck) (hash-update cards-per-loot-deck deck sub1 0)]))
-  (<@ @cards-per-loot-deck update))
+      [`(add ,type) (hash-update cards-per-loot-deck type add1 0)]
+      [`(remove ,type) (hash-update cards-per-loot-deck type sub1 0)]))
+  (<@ @type->number-of-cards update))
 
-(define (build-loot-deck cards-per-loot-deck)
+(define (build-loot-deck type->number-of-cards type->deck)
   (shuffle
    (flatten
-    (for/list ([(deck count) (in-hash cards-per-loot-deck)])
+    (for/list ([(type count) (in-hash type->number-of-cards)])
+      (define deck (hash-ref type->deck type))
       (take (shuffle deck) count)))))
 
 (define (build-loot-deck! s)
-  (:= (state-@loot-deck s) (build-loot-deck (@! (state-@cards-per-deck s)))))
+  (:= (state-@loot-deck s)
+      (build-loot-deck (@! (state-@type->number-of-cards s))
+                       (@! (state-@type->deck s)))))
 
 (define (player->rewards p num-players level)
   (define gold-factor (level-info-gold (get-level-info level)))