├── testfiles ├── aoes │ ├── drag-down.rkt │ ├── ring1.rkt │ ├── unbreakable-wall.rkt │ └── speartip.rkt ├── sample-bestiary-import.rkt ├── boss-foes.rkt ├── sample-foes.rkt ├── syntax │ └── monsters.rkt ├── bosses.rkt ├── guards.rkt ├── parsers │ └── monster.rkt ├── data.rkt └── archers.rkt ├── screenshots ├── fh-desktop-01.png ├── fh-desktop-02.png ├── fh-mobile-01.png └── fh-mobile-02.jpg ├── scribblings ├── pp.scrbl ├── aoe.scrbl ├── bestiary.scrbl ├── syntax.scrbl ├── parsers.scrbl ├── contracts.scrbl ├── frosthaven-manager.scrbl ├── qi │ ├── utils.scrbl │ └── list2hash.scrbl ├── gui │ ├── counter.scrbl │ ├── server.scrbl │ ├── manager.scrbl │ ├── formula-editor.scrbl │ ├── elements.scrbl │ ├── table.scrbl │ ├── level-picker.scrbl │ ├── number-players.scrbl │ ├── rewards.scrbl │ ├── round-number.scrbl │ ├── level-info.scrbl │ ├── mixins.scrbl │ ├── common-menu.scrbl │ ├── helpers.scrbl │ ├── font.scrbl │ ├── round-prompts.scrbl │ ├── monster-modifier.scrbl │ ├── player-info.scrbl │ ├── static-table.scrbl │ ├── rich-text-display.scrbl │ ├── loot.scrbl │ ├── stacked-tables.scrbl │ ├── markdown.scrbl │ └── render.scrbl ├── server.scrbl ├── manager │ ├── save.scrbl │ ├── db.scrbl │ ├── transition.scrbl │ ├── elements.scrbl │ ├── ability-decks.scrbl │ ├── modifier-decks.scrbl │ ├── loot.scrbl │ └── round-prompts.scrbl ├── defns.scrbl ├── files.scrbl ├── elements.scrbl ├── parsers │ ├── formula.scrbl │ ├── foes.scrbl │ └── monster.scrbl ├── constants.scrbl ├── pp │ └── bestiary.scrbl ├── monster-db.scrbl ├── icons.scrbl ├── observable-operator.scrbl ├── reference.scrbl ├── manager.scrbl ├── troubleshooting.scrbl ├── gui.scrbl ├── enum-helpers.scrbl ├── common.rkt ├── defns │ ├── level.scrbl │ ├── scenario.scrbl │ └── loot.scrbl ├── curlique.scrbl ├── installation.scrbl ├── syntax │ ├── module-reader.scrbl │ └── monsters.scrbl ├── rich-text-helpers.scrbl └── aoe-images.scrbl ├── .gitignore ├── manager.rkt ├── defns.rkt ├── gui ├── counter.rkt ├── level-picker.rkt ├── number-players.rkt ├── round-number.rkt ├── server.rkt ├── helpers.rkt ├── deserialized-state.rkt ├── font.rkt ├── render.rkt ├── mixins.rkt ├── static-table.rkt ├── level-info.rkt ├── table.rkt ├── formula-editor.rkt └── elements.rkt ├── observable-operator.rkt ├── contracts.rkt ├── rich-text-helpers.rkt ├── qi ├── list2hash.rkt └── utils.rkt ├── files.rkt ├── syntax └── module-reader.rkt ├── manager ├── db.rkt ├── save.rkt ├── elements.rkt ├── transition.rkt └── ability-decks.rkt ├── README.md ├── .github └── workflows │ ├── docs.yml │ ├── resyntax-autofixer.yml │ ├── ci.yml │ └── release.yml ├── LICENSE ├── aoe.rkt ├── ABOUT.md ├── defns └── level.rkt ├── bestiary.rkt ├── constants.rkt ├── info.rkt ├── curlique.rkt ├── Makefile ├── enum-helpers.rkt ├── static ├── style.css └── events.js ├── parsers ├── formula.rkt └── foes.rkt ├── loot-cards.rkt └── sample-bestiary.rkt /testfiles/aoes/drag-down.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/aoe 2 | 3 | x x 4 | x 5 | m 6 | -------------------------------------------------------------------------------- /testfiles/aoes/ring1.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/aoe 2 | 3 | x x 4 | x x x 5 | x x 6 | -------------------------------------------------------------------------------- /testfiles/aoes/unbreakable-wall.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/aoe 2 | 3 | x x x 4 | o m 5 | -------------------------------------------------------------------------------- /testfiles/aoes/speartip.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/aoe 2 | 3 | x 4 | x 5 | m 6 | o 7 | -------------------------------------------------------------------------------- /screenshots/fh-desktop-01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/benknoble/frosthaven-manager/HEAD/screenshots/fh-desktop-01.png -------------------------------------------------------------------------------- /screenshots/fh-desktop-02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/benknoble/frosthaven-manager/HEAD/screenshots/fh-desktop-02.png -------------------------------------------------------------------------------- /screenshots/fh-mobile-01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/benknoble/frosthaven-manager/HEAD/screenshots/fh-mobile-01.png -------------------------------------------------------------------------------- /screenshots/fh-mobile-02.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/benknoble/frosthaven-manager/HEAD/screenshots/fh-mobile-02.jpg -------------------------------------------------------------------------------- /testfiles/sample-bestiary-import.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/bestiary 2 | 3 | import-monsters "archers.rkt" 4 | import-monsters "guards.rkt" 5 | import-monsters "bosses.rkt" 6 | -------------------------------------------------------------------------------- /testfiles/boss-foes.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/foes 2 | 3 | import-monsters "sample-bestiary-import.rkt" 4 | 5 | begin-foe "giant squid" ("boss") 6 | <[2 normal] [3 normal] [4 normal]> 7 | end-foe 8 | -------------------------------------------------------------------------------- /scribblings/pp.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{@tt{pp}} 4 | 5 | This collection holds pretty printers based on 6 | @racketmodname[pretty-expressive]. 7 | 8 | @include-section{pp/bestiary.scrbl} 9 | -------------------------------------------------------------------------------- /scribblings/aoe.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{@tt{aoe}} 4 | 5 | This module implements the Area-of-Effect (AoE) language. See 6 | @secref{Programming_a_Scenario} and @racketmodname[frosthaven-manager/aoe] 7 | for more information. 8 | -------------------------------------------------------------------------------- /scribblings/bestiary.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{@tt{bestiary}} 4 | 5 | This module implements the bestiary language. See 6 | @secref{Programming_a_Scenario} and 7 | @racketmodname[frosthaven-manager/bestiary] for more information. 8 | -------------------------------------------------------------------------------- /scribblings/syntax.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{@tt{syntax}} 4 | 5 | The modules in this collection provide helpers for macros, syntax, and 6 | languages. 7 | 8 | @include-section{syntax/module-reader.scrbl} 9 | @include-section{syntax/monsters.scrbl} 10 | -------------------------------------------------------------------------------- /scribblings/parsers.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{@tt{parsers}} 4 | 5 | This collection contains parsers that support various @(hash-lang)s. 6 | 7 | @include-section{parsers/foes.scrbl} 8 | @include-section{parsers/formula.scrbl} 9 | @include-section{parsers/monster.scrbl} 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | \#* 3 | .\#* 4 | compiled/ 5 | /doc/ 6 | /docs/ 7 | /FrosthavenManager.app/ 8 | /macOS-FrosthavenManager/ 9 | /linux-FrosthavenManager/ 10 | /windows-FrosthavenManager/ 11 | macOS-FrosthavenManager.tar.gz 12 | linux-FrosthavenManager.tar.gz 13 | windows-FrosthavenManager.zip 14 | .frosthaven-manager-port 15 | -------------------------------------------------------------------------------- /testfiles/sample-foes.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/foes 2 | 3 | import-monsters "sample-bestiary-import.rkt" 4 | 5 | begin-foe 6 | "wyrmling archer" 7 | <[2 absent] [3 normal] [4 elite]> 8 | <[2 normal] [3 elite] [4 elite]> 9 | end-foe 10 | 11 | begin-foe 12 | "hynox guard" ("guard") (random numbering) 13 | <[2 elite] [3 elite] [4 elite]> 14 | end-foe 15 | -------------------------------------------------------------------------------- /manager.rkt: -------------------------------------------------------------------------------- 1 | #lang reprovide 2 | 3 | frosthaven-manager/manager/state 4 | frosthaven-manager/manager/ability-decks 5 | frosthaven-manager/manager/modifier-decks 6 | frosthaven-manager/manager/db 7 | frosthaven-manager/manager/loot 8 | frosthaven-manager/manager/round-prompts 9 | frosthaven-manager/manager/elements 10 | frosthaven-manager/manager/transition 11 | frosthaven-manager/manager/save 12 | -------------------------------------------------------------------------------- /defns.rkt: -------------------------------------------------------------------------------- 1 | #lang reprovide 2 | 3 | frosthaven-manager/defns/level 4 | frosthaven-manager/defns/loot 5 | (submod frosthaven-manager/defns/loot deserialize-info) 6 | frosthaven-manager/defns/monsters 7 | (submod frosthaven-manager/defns/monsters deserialize-info) 8 | frosthaven-manager/defns/players 9 | (submod frosthaven-manager/defns/players deserialize-info) 10 | frosthaven-manager/defns/scenario 11 | -------------------------------------------------------------------------------- /scribblings/contracts.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket)) 4 | 5 | @title{@tt{contracts}} 6 | @defmodule[frosthaven-manager/contracts] 7 | 8 | @defproc[(unique-with/c [key (-> any/c any/c)] [c flat-contract?]) contract?]{ 9 | The contract @racket[(unique-with/c key c)] requires of a value @racket[_v] that 10 | the result of @racket[(map key _v)] is a @racket[(listof c)] with no duplicates. 11 | } 12 | -------------------------------------------------------------------------------- /testfiles/syntax/monsters.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require frosthaven-manager/defns 4 | frosthaven-manager/testfiles/sample-bestiary-import 5 | pict 6 | qi) 7 | 8 | (module+ test 9 | (require rackunit) 10 | (check-true 11 | (~> (ability-db) hash-values flatten sep 12 | (amp (~> monster-ability-abilities flatten sep)) 13 | (any pict?)) 14 | "at least one monster ability has a pict")) 15 | -------------------------------------------------------------------------------- /gui/counter.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [counter (-> (maybe-obs/c string?) 6 | (-> any) 7 | (-> any) 8 | (is-a?/c view<%>))])) 9 | 10 | (require racket/gui/easy 11 | racket/gui/easy/contract) 12 | 13 | (define (counter @label up down) 14 | (hpanel #:stretch '(#f #f) 15 | (button "-" down) 16 | (text @label) 17 | (button "+" up))) 18 | -------------------------------------------------------------------------------- /scribblings/frosthaven-manager.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "common.rkt") 4 | 5 | @title{Frosthaven Manager} 6 | @author{D. Ben Knoble} 7 | 8 | @(table-of-contents) 9 | 10 | @markdown-inline[ABOUT.md] 11 | 12 | @include-section{installation.scrbl} 13 | @include-section{how-to-play.scrbl} 14 | @include-section{troubleshooting.scrbl} 15 | @include-section{programming-scenario.scrbl} 16 | @include-section{contributing.scrbl} 17 | @include-section{reference.scrbl} 18 | 19 | @(index-section) 20 | -------------------------------------------------------------------------------- /scribblings/qi/utils.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | qi 5 | frosthaven-manager/qi/utils)) 6 | 7 | @title{@tt{qi/utils}} 8 | @defmodule[frosthaven-manager/qi/utils] 9 | 10 | @defproc[(list-remove [xs list?] [i natural-number/c]) 11 | (values list? any/c)]{ 12 | Returns a new list consisting of all elements of @racket[xs] excepth the 13 | @racket[i]th, and the @racket[i]th value. If @racket[i] is out of bounds, raises 14 | an exception. 15 | } 16 | -------------------------------------------------------------------------------- /observable-operator.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide (rename-out [gui:<~ <@] 4 | [gui:~> @>] 5 | [gui:λ<~ λ<@] 6 | [gui:obs-peek @!] 7 | [gui:define/obs define/obs] 8 | [gui:@ @] 9 | [gui::= :=] 10 | [gui:λ:= λ:=]) 11 | (all-from-out frosthaven-manager/curlique)) 12 | 13 | (require frosthaven-manager/curlique 14 | (prefix-in gui: (combine-in racket/gui/easy racket/gui/easy/operator))) 15 | -------------------------------------------------------------------------------- /scribblings/gui/counter.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | frosthaven-manager/gui/counter)) 7 | 8 | @title{@tt{gui/counter}} 9 | @defmodule[frosthaven-manager/gui/counter] 10 | 11 | @defproc[(counter [|@label| (maybe-obs/c string?)] 12 | [up (-> any)] 13 | [down (-> any)]) 14 | (is-a?/c view<%>)]{ 15 | A GUI component for a counter with a label and up and down callbacks. 16 | } 17 | -------------------------------------------------------------------------------- /contracts.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [unique-with/c (-> (-> any/c any/c) flat-contract? contract?)])) 6 | 7 | (require 8 | frosthaven-manager/curlique) 9 | 10 | (define-flow no-duplicates? 11 | (not (and check-duplicates #t))) 12 | 13 | (define (unique/c c) 14 | (flat-named-contract 15 | 'unique/c 16 | (and/c (listof c) no-duplicates?))) 17 | 18 | (define (unique-with/c key c) 19 | (define (ctc xs) 20 | ((unique/c c) (map key xs))) 21 | (flat-named-contract 22 | (list 'unique-with/c (object-name key) (object-name c)) 23 | ctc)) 24 | -------------------------------------------------------------------------------- /scribblings/gui/server.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket/gui/easy 4 | frosthaven-manager/manager 5 | (prefix-in server: frosthaven-manager/server) 6 | frosthaven-manager/gui/render)) 7 | 8 | @title{@tt{gui/server}} 9 | @defmodule[frosthaven-manager/gui/server] 10 | 11 | @defproc[(launch-server [s state?]) renderer?]{ 12 | Renders a window in a new closing eventspace with server information, and 13 | launches a server. See @racket[with-closing-custodian/eventspace] and 14 | @racket[server:launch-server]. 15 | } 16 | -------------------------------------------------------------------------------- /scribblings/gui/manager.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | frosthaven-manager/manager 7 | frosthaven-manager/gui/render)) 8 | 9 | @title{@tt{gui/manager}} 10 | @defmodule[frosthaven-manager/gui/manager] 11 | 12 | This module's main function is to run the Frosthaven Manager. It provides only 13 | a single binding: 14 | 15 | @defproc[(manager [s state?]) (is-a?/c window-view<%>)]{ 16 | A view for the Frosthaven Manager. Render with @racket[render/eventspace]. 17 | } 18 | -------------------------------------------------------------------------------- /rich-text-helpers.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide only-on-text 4 | match-loop) 5 | 6 | (require syntax/parse/define) 7 | 8 | ;; f: x -> listof y 9 | (define (only-on-text f . xs) 10 | (define f* (if (null? xs) f (apply curry f xs))) 11 | (λ (x) 12 | (cond 13 | [(string? x) (f* x)] 14 | [else (list x)]))) 15 | 16 | (define-syntax-parser match-loop 17 | [(_ input:expr [pat:expr e ... res:expr] ...) 18 | (syntax/loc this-syntax 19 | (let loop ([x input]) 20 | (match x 21 | [pat e ... (append-map loop res)] 22 | ... 23 | ;; break 24 | [_ (list x)])))]) 25 | -------------------------------------------------------------------------------- /scribblings/gui/formula-editor.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy 5 | frosthaven-manager/parsers/formula)) 6 | 7 | @title{@tt{gui/formula-editor}} 8 | @defmodule[frosthaven-manager/gui/formula-editor] 9 | 10 | This module provides GUI objects for interactive formula editing. 11 | 12 | @defproc[(formula-editor [|@|env env/c]) (is-a?/c view<%>)]{ 13 | A window containing an interactive formula editor. 14 | } 15 | 16 | @defproc[(formula-menu-item [|@|env env/c]) (is-a?/c view<%>)]{ 17 | A menu item that displays an interactive formula editor. 18 | } 19 | -------------------------------------------------------------------------------- /scribblings/server.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | frosthaven-manager/manager 5 | frosthaven-manager/server)) 6 | 7 | @title{@tt{server}} 8 | @defmodule[frosthaven-manager/server] 9 | 10 | @defproc[(launch-server [s state?] [send-event procedure?]) 11 | (values string? (-> any))]{ 12 | Launches the actual web server for @racket[s]. The callback protocol for 13 | @racket[send-event] is not yet formalized and very unstable. 14 | 15 | Returns the server address (on a best-guess basis) and a @code{stop} procedure 16 | that stops the server when called. 17 | } 18 | -------------------------------------------------------------------------------- /scribblings/manager/save.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | frosthaven-manager/manager)) 5 | 6 | @title{@tt{manager/save}} 7 | @defmodule[frosthaven-manager/manager/save] 8 | 9 | @defproc[(do-save-game [s state?]) any]{ 10 | Prompts the user to save the game to a file of their choice. 11 | } 12 | 13 | @defproc[(do-load-game [s state?]) any]{ 14 | Prompts the user to load the game from a file of their choice. 15 | } 16 | 17 | @defproc[((save-game [s state?]) [p path-string?]) any]{ 18 | Save a game to @racket[p]. 19 | } 20 | 21 | @defproc[((load-game [s state?]) [p path-string?]) any]{ 22 | Load a game from @racket[p]. 23 | } 24 | -------------------------------------------------------------------------------- /gui/level-picker.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [level-picker (->* (#:choose (-> level/c any) 6 | #:selection (maybe-obs/c level/c)) 7 | (#:label (maybe-obs/c maybe-label/c)) 8 | (is-a?/c view<%>))])) 9 | 10 | (require frosthaven-manager/defns 11 | frosthaven-manager/observable-operator 12 | racket/gui/easy 13 | racket/gui/easy/contract) 14 | 15 | (define (level-picker #:choose on-choose #:selection selection #:label [label #f]) 16 | (choice #:label (@ label) 17 | (build-list number-of-levels identity) 18 | #:choice->label ~a 19 | on-choose 20 | #:selection (@ selection))) 21 | -------------------------------------------------------------------------------- /qi/list2hash.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [list->hash (->* (list?) 6 | (#:->key (-> any/c any/c) 7 | #:->value (-> any/c any/c)) 8 | hash?)]) 9 | (for-space qi list~>hash)) 10 | 11 | (require qi 12 | syntax/parse/define) 13 | 14 | (define (list->hash xs #:->key [->key identity] #:->value [->value identity]) 15 | (for/hash ([x (in-list xs)]) 16 | (on (x) (-< ->key ->value)))) 17 | 18 | (define-qi-syntax-rule (list~>hash {~optional {~seq #:->key ->key}} 19 | {~optional {~seq #:->value ->value}}) 20 | (list->hash _ 21 | (~? (~@ #:->key (flow ->key))) 22 | (~? (~@ #:->value (flow ->value))))) 23 | -------------------------------------------------------------------------------- /scribblings/gui/elements.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | frosthaven-manager/elements 7 | frosthaven-manager/manager)) 8 | 9 | @title{@tt{gui/elements}} 10 | @defmodule[frosthaven-manager/gui/elements] 11 | 12 | @defproc[(elements-cycler 13 | [|@|states (listof (obs/c element-state/c))] 14 | [es (listof element-pics?)] 15 | [panel (unconstrained-domain-> (is-a?/c view<%>)) hpanel]) 16 | (is-a?/c view<%>)]{ 17 | Returns a GUI view displaying the @racket[element-pics]. Each element of 18 | @racket[es] is controlled by the corresponding element of @racket[|@|states]. 19 | } 20 | -------------------------------------------------------------------------------- /gui/number-players.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [number-players-picker (->* (#:choose (-> level/c any) 6 | #:selection (maybe-obs/c level/c)) 7 | (#:label (maybe-obs/c maybe-label/c)) 8 | (is-a?/c view<%>))])) 9 | 10 | (require frosthaven-manager/defns 11 | frosthaven-manager/observable-operator 12 | racket/gui/easy 13 | racket/gui/easy/contract) 14 | 15 | (define (number-players-picker #:choose on-choose #:selection selection #:label [label "Number of Players"]) 16 | (choice #:label (@ label) 17 | (build-list (sub1 max-players) (curry + 2)) 18 | #:choice->label ~a 19 | on-choose 20 | #:selection (@ selection))) 21 | -------------------------------------------------------------------------------- /scribblings/defns.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | frosthaven-manager/parsers/formula)) 6 | 7 | @title{@tt{defns}} 8 | @defmodule[frosthaven-manager/defns] 9 | 10 | This module reprovides everything from 11 | @racketmodname[frosthaven-manager/defns/level], 12 | @racketmodname[frosthaven-manager/defns/loot], 13 | @racketmodname[frosthaven-manager/defns/monsters], 14 | @racketmodname[frosthaven-manager/defns/players], and 15 | @racketmodname[frosthaven-manager/defns/scenario]. 16 | 17 | @include-section{defns/level.scrbl} 18 | @include-section{defns/loot.scrbl} 19 | @include-section{defns/monsters.scrbl} 20 | @include-section{defns/players.scrbl} 21 | @include-section{defns/scenario.scrbl} 22 | -------------------------------------------------------------------------------- /scribblings/manager/db.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | frosthaven-manager/manager)) 5 | 6 | @title{@tt{manager/db}} 7 | @defmodule[frosthaven-manager/manager/db] 8 | 9 | This module provides facilities for manipulating the active monster databases. 10 | 11 | @defproc[(init-dbs [db path-string?] [s state?]) any]{ 12 | Initialize the active monster databases. 13 | } 14 | 15 | @defproc[(init-dbs-and-foes [db path-string?] [s state?]) any]{ 16 | Initialize the active monster databases, exactly as @racket[init-dbs]. 17 | Additionally, initialize the foes from @racket[db] if it provides a foes 18 | specification. This manipulates @racket[(state-@creatures s)]; see also 19 | @racket[add-or-remove-monster-group] and 20 | @racketmodname[frosthaven-manager/foes]. 21 | } 22 | -------------------------------------------------------------------------------- /files.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/gui 2 | 3 | (provide 4 | (contract-out 5 | [get-file/filter (-> label-string? (list/c string? string?) (or/c path? #f))] 6 | [put-file/filter (->* {label-string? (list/c string? string?)} 7 | {(or/c path-string? #f) (or/c path-string? #f)} 8 | (or/c path? #f))])) 9 | 10 | (require frosthaven-manager/curlique) 11 | 12 | (define (get-file/filter message filter) 13 | (get-file message #f #f #f (->extension (second filter)) empty (list filter '("Any" "*.*")))) 14 | 15 | (define (put-file/filter message filter [directory #f] [file #f]) 16 | (put-file message #f directory file (->extension (second filter)) empty (list filter '("Any" "*.*")))) 17 | 18 | (define ->extension 19 | {~> path-get-extension (and _ (~> bytes->string/utf-8 (substring 1)))}) 20 | -------------------------------------------------------------------------------- /scribblings/gui/table.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket)) 4 | 5 | @title{@tt{gui/table}} 6 | @defmodule[frosthaven-manager/gui/table] 7 | 8 | @defproc[(make-preview-rows [xs list?] [n (or/c 'all natural-number/c)] 9 | [#:reveal reveal (-> any/c (vectorof string?))] 10 | [#:hide hide (-> any/c (vectorof string?))]) 11 | (vectorof (vectorof string?))]{ 12 | Separates @racket[xs] into @racket[n] revealed rows and otherwise hidden rows. 13 | Rows are generated by applying the corresponding functions to elements of 14 | @racket[xs]. 15 | 16 | If @racket[n] is @racket['all] or greater than the length of @racket[xs], all 17 | elements are considered revealed. 18 | 19 | Rows correspond to the notion of rows or entries in @racket[table]. 20 | } 21 | -------------------------------------------------------------------------------- /scribblings/gui/level-picker.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | frosthaven-manager/defns)) 7 | 8 | @title{@tt{gui/level-picker}} 9 | @defmodule[frosthaven-manager/gui/level-picker] 10 | 11 | @defproc[(level-picker 12 | [#:choose on-choose (-> level/c any)] 13 | [#:selection selection (maybe-obs/c level/c)] 14 | [#:label label (maybe-obs/c maybe-label/c) #f]) 15 | (is-a?/c view<%>)]{ 16 | A GUI view that presents a choice of Frosthaven level values; @racket[on-choose] 17 | is invoked whenever the choice changes. The selection may be controlled with 18 | @racket[selection]. The optional @racket[label] is used as with @racket[choice]. 19 | } 20 | -------------------------------------------------------------------------------- /scribblings/manager/transition.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy 5 | frosthaven-manager/manager)) 6 | 7 | @title{@tt{manager/transition}} 8 | @defmodule[frosthaven-manager/manager/transition] 9 | 10 | @defthing[transition/c contract? #:value (-> state? (-> any))]{ 11 | A transition function consumes a @racket[state?] and produces a thunk typically 12 | used as the action for a @racket[button]. 13 | } 14 | 15 | @deftogether[( 16 | @defthing[next-round transition/c] 17 | @defthing[draw-abilities transition/c] 18 | )]{ 19 | Transition functions that define how to progress through the round structure of 20 | the game. These are idempotent in that if they are called with the wrong 21 | @racket[state-@in-draw?], they do nothing. 22 | } 23 | -------------------------------------------------------------------------------- /scribblings/gui/number-players.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | frosthaven-manager/defns)) 7 | 8 | @title{@tt{gui/number-players}} 9 | @defmodule[frosthaven-manager/gui/number-players] 10 | 11 | @defproc[(number-players-picker 12 | [#:choose on-choose (-> level/c any)] 13 | [#:selection selection (maybe-obs/c level/c)] 14 | [#:label label (maybe-obs/c maybe-label/c) "Number of Players"]) 15 | (is-a?/c view<%>)]{ 16 | A GUI view that presents a choice of the number of players for Frosthaven; 17 | @racket[on-choose] is invoked whenever the choice changes. The selection may be 18 | controlled with @racket[selection]. The optional @racket[label] is used as with 19 | @racket[choice]. 20 | } 21 | -------------------------------------------------------------------------------- /syntax/module-reader.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | #%app #%datum #%top #%top-interaction 5 | (rename-out [mb #%module-begin])) 6 | 7 | (require syntax/parse/define 8 | (prefix-in syntax/module-reader: syntax/module-reader)) 9 | 10 | (define-syntax-parser mb 11 | [(_ expander [parser:id {~datum from} parser-mod]) 12 | (syntax/loc this-syntax 13 | (syntax/module-reader:#%module-begin 14 | expander 15 | #:whole-body-readers? #t 16 | #:read-syntax read-syntax 17 | #:read read 18 | (require parser-mod) 19 | (define read-syntax (make-read-syntax parser)) 20 | (define read (make-read parser))))]) 21 | 22 | (define ((make-read-syntax parser) src in) 23 | (port-count-lines! in) 24 | (parser src in #:syntax? #t)) 25 | 26 | (define ((make-read parser) in) 27 | (port-count-lines! in) 28 | (parser (object-name in) in #:syntax? #f)) 29 | -------------------------------------------------------------------------------- /manager/db.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [init-dbs (-> path-string? state? any)] 6 | [init-dbs-and-foes (-> path-string? state? any)])) 7 | 8 | (require frosthaven-manager/manager/state 9 | frosthaven-manager/observable-operator) 10 | 11 | (define (init-dbs db s) 12 | ;; remove all monster groups from creatures 13 | (<@ (state-@creatures s) {(remf* creature-is-mg*? _)}) 14 | (:= (state-@bestiary-path s) db) 15 | (:= (state-@ability-decks s) (hash))) 16 | 17 | (define (init-foes db s) 18 | (define make-foes (dynamic-require db 'make-foes (const #f))) 19 | (when make-foes 20 | (define mgs (make-foes (@! (state-@level s)) (@! (state-@num-players s)))) 21 | (define events (map (λ (mg) `(add ,mg)) mgs)) 22 | (for-each (add-or-remove-monster-group s) events))) 23 | 24 | (define (init-dbs-and-foes db s) 25 | (init-dbs db s) 26 | (init-foes db s)) 27 | -------------------------------------------------------------------------------- /qi/utils.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [list-remove (-> list? natural-number/c (values list? any/c))])) 6 | 7 | (require frosthaven-manager/curlique) 8 | 9 | (module+ test (require rackunit)) 10 | 11 | (define list-remove 12 | {~> split-at 13 | (-< (~> (== _ cdr) append) 14 | (~> 2> car))}) 15 | 16 | (module+ test 17 | (test-case "list-remove" 18 | (define list-remove1 {~> list-remove 1>}) 19 | (define list-remove2 {~> list-remove 2>}) 20 | (check-equal? (list-remove1 '(a b c) 0) '(b c)) 21 | (check-equal? (list-remove1 '(a b c) 1) '(a c)) 22 | (check-equal? (list-remove1 '(a b c) 2) '(a b)) 23 | (check-equal? (list-remove2 '(a b c) 0) 'a) 24 | (check-equal? (list-remove2 '(a b c) 1) 'b) 25 | (check-equal? (list-remove2 '(a b c) 2) 'c) 26 | (for ([i '(-1 3 4 5 10)]) 27 | (check-exn exn:fail? (thunk (list-remove '(a b c) i)))))) 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Frosthaven Manager 2 | 3 | GUI for running Frosthaven scenarios. For more details about the project see 4 | [the documentation](https://benknoble.github.io/frosthaven-manager). 5 | 6 | ## Related Papers & Talks 7 | 8 | - [Functional Shell and Reusable Components for Easy GUIs](https://racket.discourse.group/t/funarch-2023-functional-shell-and-reusable-components-for-easy-guis/2288), 9 | with [pre-formatted citation](https://benknoble.github.io/papers/) 10 | - [FUNARCH '23 talk](https://benknoble.github.io/workshops/gui-easy-funarch/) 11 | - [14th RacketCon: Frosthaven Manager: Built by the Community](https://benknoble.github.io/workshops/14th-racket-con/) 12 | 13 | ## Screenshots 14 | 15 | ![Desktop manager](screenshots/fh-desktop-01.png) 16 | ![Desktop manager (dark mode)](screenshots/fh-desktop-02.png) 17 | ![Mobile manager](screenshots/fh-mobile-01.png) 18 | ![Mobile manager](screenshots/fh-mobile-02.jpg) 19 | -------------------------------------------------------------------------------- /scribblings/files.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket/gui 4 | frosthaven-manager/files)) 5 | 6 | @title{@tt{files}} 7 | @defmodule[frosthaven-manager/files] 8 | 9 | @defproc[(get-file/filter [message label-string?] [filter (list/c string? string?)]) 10 | (or/c path? #f)]{ 11 | Returns @racket[get-file] with @racket[message] and @racket[filter]. 12 | Additionally permits an "Any" filter. The Windows extensions is provided from 13 | @racket[(second filter)]. 14 | } 15 | 16 | @defproc[(put-file/filter [message label-string?] [filter (list/c string? string?)] 17 | [directory path-string? #f] 18 | [file path-string? #f]) 19 | (or/c path? #f)]{ 20 | Returns @racket[put-file] with @racket[message] and @racket[filter]. 21 | Additionally permits an "Any" filter. The Windows extensions is provided from 22 | @racket[(second filter)]. 23 | } 24 | -------------------------------------------------------------------------------- /.github/workflows/docs.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: Deploy documentation to GH Pages 3 | on: 4 | push: 5 | branches: 6 | - main 7 | paths: 8 | - 'scribblings/**' 9 | - '.github/workflows/docs.yml' 10 | 11 | jobs: 12 | publish: 13 | runs-on: ubuntu-latest 14 | steps: 15 | - name: Checkout 16 | uses: actions/checkout@v4 17 | - name: Install Racket 18 | uses: Bogdanp/setup-racket@v1.11 19 | with: 20 | architecture: 'x64' 21 | distribution: 'full' 22 | variant: 'CS' 23 | version: 'stable' 24 | - name: Install Package 25 | run: make install RACO_INSTALL_ARGS=--batch 26 | - name: Build docs 27 | run: make docs/frosthaven-manager/index.html 28 | - name: Push to GH Pages 29 | uses: JamesIves/github-pages-deploy-action@v4.5.0 30 | with: 31 | folder: docs/frosthaven-manager 32 | branch: gh-pages 33 | -------------------------------------------------------------------------------- /scribblings/gui/rewards.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket/gui null) 4 | frosthaven-manager/defns 5 | racket/gui/easy 6 | racket/gui/easy/contract)) 7 | 8 | @title{@tt{gui/rewards}} 9 | @defmodule[frosthaven-manager/gui/rewards] 10 | 11 | This module contains views for end-of-scenario rewards. 12 | 13 | @defproc[(player-rewards-view [|@|num-players (obs/c num-players/c)] 14 | [|@|level (obs/c level/c)] 15 | [|@|players (obs/c (listof player?))] 16 | [#:mixin mix (make-mixin-contract top-level-window<%>) values]) 17 | (is-a?/c view<%>)]{ 18 | Produces a @racket[window] for displaying a players rewards, such as loot, gold, 19 | and XP. The selected player's loot cards are also displayed. The mixin 20 | @racket[mix] is applied to the @racket[window]. 21 | } 22 | -------------------------------------------------------------------------------- /scribblings/gui/round-number.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | frosthaven-manager/gui/round-number)) 7 | 8 | @title{@tt{gui/round-number}} 9 | @defmodule[frosthaven-manager/gui/round-number] 10 | 11 | This module contains GUI components for interacting with the round number. 12 | 13 | @defproc[(round-number-modifier [|@|round (obs/c natural-number/c)] 14 | [#:new-round-number new-round-number 15 | (-> (-> natural-number/c natural-number/c) any) 16 | void]) 17 | (is-a?/c window-view<%>)]{ 18 | This dialog, when rendered, provides buttons to set the displayed 19 | @racket[|@|round]. The action passed up by @racket[new-round-number] is a 20 | procedure that computes a new round value from the old one. 21 | } 22 | -------------------------------------------------------------------------------- /scribblings/elements.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | pict 5 | frosthaven-manager/elements)) 6 | 7 | @title{@tt{elements}} 8 | @defmodule[frosthaven-manager/elements] 9 | 10 | @defthing[size natural-number/c]{ 11 | The size of the element pictures. 12 | } 13 | 14 | @defstruct*[element-pics 15 | ([name string?] 16 | [infused pict?] 17 | [waning pict?] 18 | [unfused pict?] 19 | [consume pict?]) 20 | #:transparent]{ 21 | A container for a named set of element pictures. 22 | } 23 | 24 | @defproc[(elements) (listof element-pics?)]{ 25 | Returns all of the elements bundled together. This module also provides bindings 26 | from the names of the elemnts to procedures returning @racket[element-pics] 27 | values, but they are not documented here. See @secref{Elements_tracker} for the 28 | various element names and pictures. 29 | } 30 | -------------------------------------------------------------------------------- /scribblings/parsers/formula.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | megaparsack 5 | frosthaven-manager/parsers/formula)) 6 | 7 | @title{@tt{parsers/formula}} 8 | @defmodule[frosthaven-manager/parsers/formula] 9 | 10 | This module contains parsers for arithmetic formulas over addition, subtraction, 11 | multiplication, division, rounding, and a limited set of variables. The parse 12 | result is a function from an environment of variables to a number. 13 | 14 | @deftogether[( 15 | @defthing[env/c flat-contract? #:value (hash/c (or/c "L" "C") number? #:flat? #t)] 16 | @defthing[expr/pc contract? #:value (-> env/c number?)] 17 | )]{ 18 | Contracts for the parse results of formulas. 19 | } 20 | 21 | @defthing[expr/p (parser/c char? expr/pc)]{ 22 | Textual parser for formulas. 23 | } 24 | 25 | @defproc[(parse-expr [in string?]) expr/pc]{ 26 | Parses a string as a formula or fails. 27 | } 28 | -------------------------------------------------------------------------------- /gui/round-number.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [round-number-modifier (->* ((obs/c natural-number/c)) 6 | (#:new-round-number (-> (-> natural-number/c natural-number/c) any)) 7 | (is-a?/c window-view<%>))])) 8 | 9 | (require frosthaven-manager/gui/counter 10 | frosthaven-manager/gui/mixins 11 | frosthaven-manager/observable-operator 12 | racket/gui/easy 13 | racket/gui/easy/contract) 14 | 15 | (define (round-number-modifier @round #:new-round-number [send-new-round void]) 16 | (define-close! close! closing-mixin) 17 | (dialog 18 | #:title "Edit round number" 19 | #:mixin closing-mixin 20 | (vpanel 21 | (hpanel 22 | (button "1" (thunk (send-new-round (const 1)))) 23 | (counter (@> @round {(~a "Round: " _)}) 24 | (thunk (send-new-round add1)) 25 | (thunk (send-new-round {(if (> 1) sub1 1)})))) 26 | (button "Ok" close!)))) 27 | -------------------------------------------------------------------------------- /scribblings/constants.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label frosthaven-manager/constants)) 4 | 5 | @title{Constant Formatting and Parsing} 6 | @defmodule[frosthaven-manager/constants] 7 | 8 | This module provides forms for binding formatters and parsers where the mapping 9 | from constant to string and vice-versa is static. 10 | 11 | @defform[(define-constant-format/parse 12 | formatter-id parser-id 13 | ([constant-id string] ...))]{ 14 | Combines @racket[define-constant-format] and @racket[define-constant-parse]. 15 | } 16 | 17 | @defform[(define-constant-format formatter-id ([constant-id string] ...))]{ 18 | Binds @racket[_formatter-id] to a function accepting constants @racket[_constant-id] 19 | and producing the corresponding strings. 20 | } 21 | 22 | @defform[(define-constant-parse parser-id ([constant-id string] ...))]{ 23 | Binds @racket[_parser-id] to a function accepting strings and producing the 24 | corresponding @racket[_constant-id]s. 25 | } 26 | -------------------------------------------------------------------------------- /scribblings/pp/bestiary.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../common.rkt") 4 | @(require (for-label racket 5 | (prefix-in pretty: pretty-expressive) 6 | frosthaven-manager/parsers/monster 7 | pict)) 8 | 9 | @title{@tt{pp/bestiary}} 10 | @defmodule[frosthaven-manager/pp/bestiary] 11 | 12 | This module pretty-prints bestiary files. It can be run as a program with 13 | 14 | @terminal|{ 15 | racket -l- frosthaven-manager/pp/bestiary 16 | }| 17 | 18 | to format standard in or a provided file to standard out. Use @DFlag{help} for 19 | more options. 20 | 21 | @defproc[(pretty-bestiary [bestiary bestiary/c] [#:lang-line? lang-line? any/c #t]) pretty:doc?]{ 22 | Creates a document for pretty printing from the results of a parsed bestiary. 23 | The document starts with a @(hash-lang) line preceding the result if 24 | @racket[lang-line?] is not @racket[#f]. 25 | 26 | The @racket[bestiary] must not contain any @racket[pict] values, so it composes 27 | best with @racket[parse-bestiary]. 28 | } 29 | -------------------------------------------------------------------------------- /.github/workflows/resyntax-autofixer.yml: -------------------------------------------------------------------------------- 1 | name: Resyntax Autofixer 2 | 3 | on: 4 | workflow_dispatch: 5 | schedule: 6 | - cron: "0 0 * * 6" 7 | 8 | jobs: 9 | autofix: 10 | runs-on: ubuntu-latest 11 | env: 12 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 13 | permissions: 14 | pull-requests: write 15 | contents: write 16 | steps: 17 | - name: Checkout code 18 | uses: actions/checkout@v3.0.2 19 | - name: Install Racket 20 | uses: Bogdanp/setup-racket@v1.9.1 21 | with: 22 | version: current 23 | - name: Installing frosthaven-manager and its dependencies 24 | run: make install 25 | - name: Compiling frosthaven-manager and building its docs 26 | run: make setup 27 | - name: Create a Resyntax pull request 28 | uses: jackfirth/create-resyntax-pull-request@v0.5.1 29 | with: 30 | private-key: ${{ secrets.RESYNTAX_APP_PRIVATE_KEY }} 31 | max-fixes: '50' 32 | max-modified-files: '20' 33 | max-modified-lines: '500' 34 | -------------------------------------------------------------------------------- /scribblings/monster-db.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | frosthaven-manager/monster-db)) 5 | 6 | @title{@tt{monster-db}} 7 | @defmodule[frosthaven-manager/monster-db] 8 | 9 | See @secref{Programming_a_Scenario} for more information on custom monster 10 | databases. 11 | 12 | @deftogether[( 13 | @defthing[info-db/c contract?] 14 | @defthing[ability-db/c contract?] 15 | )]{ 16 | Contracts recognizing monster databases of @racket[monster-info] and 17 | @racket[monster-ability] values. 18 | } 19 | 20 | @defproc[(datums->dbs [xs (listof any/c)]) 21 | (values info-db/c ability-db/c)]{ 22 | Filters the @racket[monster-info] and @racket[monster-ability] values out of 23 | @racket[xs] and produces monster databases. 24 | } 25 | 26 | @defproc[(get-dbs [db-file path-string?]) 27 | (values info-db/c ability-db/c)]{ 28 | Reads @racket[db-file] and produces the monster databases. 29 | } 30 | 31 | @defthing[default-monster-db path-string?]{ 32 | The demo, default monster database included with Frosthaven Manager. 33 | } 34 | -------------------------------------------------------------------------------- /scribblings/qi/list2hash.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | qi 5 | frosthaven-manager/qi/list2hash)) 6 | 7 | @title{@tt{qi/list2hash}} 8 | @defmodule[frosthaven-manager/qi/list2hash] 9 | 10 | @defform[(list~>hash maybe->key maybe->value) 11 | #:grammar 12 | [(maybe->key (code:line) 13 | (code:line #:->key ->key-flo)) 14 | (maybe->value (code:line) 15 | (code:line #:->value ->value-flo))]]{ 16 | This Qi form transforms the input value (a list) into a hash, where each element 17 | of the list is mapped into a key via @racket[->key-flo] and a value via 18 | @racket[->value-flo]. It uses @racket[list->hash] as implementation. 19 | } 20 | 21 | @defproc[(list->hash [xs list?] 22 | [#:->key ->key (-> any/c any/c) identity] 23 | [#:->value ->value (-> any/c any/c) identity]) 24 | hash?]{ 25 | Transforms @racket[xs] to a hash by mapping each element into a key via 26 | @racket[->key] and a value via @racket[->value]. 27 | } 28 | -------------------------------------------------------------------------------- /scribblings/icons.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label pict 4 | frosthaven-manager/icons) 5 | frosthaven-manager/icons) 6 | 7 | @title{@tt{icons}} 8 | @defmodule[frosthaven-manager/icons] 9 | 10 | This module provides various icons that are spliced into ability card texts. 11 | All replacements are case insensitive; any numbers or other accompanying text 12 | are preserved. The signifier @racket[_N] denotes where a number is expected. 13 | 14 | @(require (for-syntax racket/base) 15 | syntax/parse/define) 16 | 17 | @(define-syntax-parser deficon 18 | [(_ proc:id replacement:expr ...) 19 | (syntax/loc this-syntax 20 | @defproc[(proc) pict?]{@para[(proc)] Provides replacements for @itemlist[@item{@replacement} ...]})]) 21 | 22 | @deficon[target "Target N" "Target all" "+N target(s)"] 23 | @deficon[range "Range N"] 24 | @deficon[push "Push N"] 25 | @deficon[pull "Pull N"] 26 | @deficon[move "Move +N" "Move -N"] 27 | @deficon[jump "Jump"] 28 | @deficon[teleport "Teleport"] 29 | @deficon[attack "Attack +N" "Attack -N"] 30 | @deficon[pierce "Pierce N"] 31 | -------------------------------------------------------------------------------- /scribblings/gui/level-info.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | frosthaven-manager/defns)) 7 | 8 | @title{@tt{gui/level-info}} 9 | @defmodule[frosthaven-manager/gui/level-info] 10 | 11 | @defproc[(level-stats 12 | [|@level| (obs/c level/c)] 13 | [|@num-players| (obs/c num-players/c)]) 14 | (is-a?/c view<%>)]{ 15 | A GUI view that displays the @racket[level-info] corresponding to 16 | @racket[|@level|] and @racket[|@num-players|]. 17 | } 18 | 19 | @defproc[(level-table [|@level| (obs/c level/c)]) 20 | (is-a?/c view<%>)]{ 21 | A GUI view of a button that shows a table of @racket[level-info] values for each 22 | level. The current @racket[|@level|] starts selected. 23 | } 24 | 25 | @defproc[(inspiration-table [|@num-players| (obs/c num-players/c)]) 26 | (is-a?/c view<%>)]{ 27 | A GUI view of a button that shows a table of inspiration rewards for each 28 | possible number of players. The current @racket[|@num-players|] starts selected. 29 | } 30 | -------------------------------------------------------------------------------- /scribblings/observable-operator.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy 5 | (except-in racket/gui/easy/operator 6 | ~> 7 | <~) 8 | racket/gui/easy/contract 9 | qi)) 10 | 11 | @title{@tt{observable-operator}} 12 | @defmodule[frosthaven-manager/observable-operator] 13 | 14 | In addition to the shorthands below, this module exports @racket[define/obs], 15 | @racket[|@|], @racket[:=], and @racket[λ:=] from 16 | @racketmodname[racket/gui/easy/operator] and everything from @racketmodname[qi] 17 | via @racketmodname[frosthaven-manager/curlique]. 18 | 19 | @defproc[(|<@| [|@o| obs?] [f (-> any/c any/c)]) any/c]{ 20 | An alias for @racket[obs-update!]. 21 | } 22 | 23 | @defproc[(|@>| [|@o| obs?] [f (-> any/c any/c)]) obs?]{ 24 | An alias for @racket[obs-map]. 25 | } 26 | 27 | @defproc[(|λ<@| [|@o| obs?] [f (-> any/c any/c)]) (-> any/c)]{ 28 | An alias for @racket[λ<~]. 29 | } 30 | 31 | @defproc[(|@!| [|@o| obs?]) any/c]{ 32 | An alias for @racket[obs-peek]. 33 | } 34 | -------------------------------------------------------------------------------- /scribblings/gui/mixins.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../common.rkt") 4 | @(require (for-label racket/gui)) 5 | 6 | @title{@tt{gui/mixins}} 7 | @defmodule[frosthaven-manager/gui/mixins] 8 | 9 | @defproc[(make-closing-proc-mixin [out (-> (-> any) any)]) 10 | (make-mixin-contract top-level-window<%>)]{ 11 | Produces a @tech[#:doc ref-doc]{mixin} that calls @racket[out] on instantiation 12 | with a procedure that closes the window. Many uses of @racket[out] are to store 13 | a local binding to this "close" procedure. 14 | } 15 | 16 | @defproc[(make-on-close-mixin [proc (-> any)]) 17 | (make-mixin-contract top-level-window<%>)]{ 18 | Produces a @tech[#:doc ref-doc]{mixin} that @racket[augment]s @racket[on-close] 19 | to call @racket[proc]. 20 | } 21 | 22 | @defform[(define-close! close!-id set-close-mixin-id)]{ 23 | If the mixin @racket[set-close-mixin-id] is applied to a 24 | @racket[top-level-window<%>] then @racket[close!-id] is a nullary procedure that 25 | closes it. 26 | } 27 | 28 | @defmixin[hide-caret/selection (text%) (text%)]{ 29 | Augments the text editor to hide the caret but still permit and show selections. 30 | } 31 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | frosthaven-manager 2 | 3 | MIT License 4 | 5 | Copyright (c) 2022 D. Ben Knoble 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in all 15 | copies or substantial portions of the Software. 16 | 17 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 18 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 20 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 21 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 23 | SOFTWARE. 24 | -------------------------------------------------------------------------------- /scribblings/gui/common-menu.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy 5 | frosthaven-manager/gui/common-menu)) 6 | 7 | @title{@tt{gui/common-menu}} 8 | @defmodule[frosthaven-manager/gui/common-menu] 9 | 10 | @deftogether[( 11 | @defthing[about-menu-item (-> (is-a?/c view<%>))] 12 | @defthing[issue-menu-item (-> (is-a?/c view<%>))] 13 | @defthing[feature-menu-item (-> (is-a?/c view<%>))] 14 | @defthing[contribute-menu-item (-> (is-a?/c view<%>))] 15 | @defthing[send-feedback-menu-item (-> (is-a?/c view<%>))] 16 | @defthing[how-to-play-menu-item (-> (is-a?/c view<%>))] 17 | @defthing[launch-server-menu-item (-> (is-a?/c view<%>))] 18 | @defthing[gc-menu-item (-> (is-a?/c view<%>))] 19 | )]{ 20 | Menu items for Frosthaven Manager. 21 | } 22 | 23 | @defproc[(do-about) renderer?]{ 24 | Renders an About window, as in @racket[about-menu-item]. Useful with 25 | @racket[application-about-handler]. 26 | } 27 | 28 | @defproc[(logs-widget [|@error-logs| (obs/c (or/c #f path?))]) 29 | (is-a?/c view<%>)]{ 30 | A GUI view to tell the user where logs can be found. 31 | } 32 | -------------------------------------------------------------------------------- /scribblings/reference.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title{Developer Reference} 4 | 5 | None of these APIs should be considered stable enough for use in projects other 6 | than Frosthaven Manager. They should be considered stable enough for use in 7 | Frosthaven Manager. Changes to an internally-used API should be made with care 8 | and compelling reason. 9 | 10 | @include-section{aoe.scrbl} 11 | @include-section{aoe-images.scrbl} 12 | @include-section{constants.scrbl} 13 | @include-section{contracts.scrbl} 14 | @include-section{curlique.scrbl} 15 | @include-section{defns.scrbl} 16 | @include-section{elements.scrbl} 17 | @include-section{enum-helpers.scrbl} 18 | @include-section{icons.scrbl} 19 | @include-section{manager.scrbl} 20 | @include-section{gui.scrbl} 21 | @include-section{files.scrbl} 22 | @include-section{bestiary.scrbl} 23 | @include-section{monster-db.scrbl} 24 | @include-section{parsers.scrbl} 25 | @include-section{observable-operator.scrbl} 26 | @include-section{pp.scrbl} 27 | @include-section{qi/list2hash.scrbl} 28 | @include-section{qi/utils.scrbl} 29 | @include-section{rich-text-helpers.scrbl} 30 | @include-section{server.scrbl} 31 | @include-section{syntax.scrbl} 32 | -------------------------------------------------------------------------------- /scribblings/manager.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | frosthaven-manager/manager)) 5 | 6 | @title{@tt{manager}} 7 | @defmodule[frosthaven-manager/manager] 8 | 9 | This module reprovides all the bindings from 10 | @racketmodname[frosthaven-manager/manager/state], 11 | @racketmodname[frosthaven-manager/manager/ability-decks], 12 | @racketmodname[frosthaven-manager/manager/modifier-decks], 13 | @racketmodname[frosthaven-manager/manager/db], 14 | @racketmodname[frosthaven-manager/manager/elements], 15 | @racketmodname[frosthaven-manager/manager/loot], 16 | @racketmodname[frosthaven-manager/manager/round-prompts], 17 | @racketmodname[frosthaven-manager/manager/transition], and 18 | @racketmodname[frosthaven-manager/manager/save]. 19 | 20 | @include-section{manager/state.scrbl} 21 | @include-section{manager/ability-decks.scrbl} 22 | @include-section{manager/modifier-decks.scrbl} 23 | @include-section{manager/db.scrbl} 24 | @include-section{manager/elements.scrbl} 25 | @include-section{manager/loot.scrbl} 26 | @include-section{manager/round-prompts.scrbl} 27 | @include-section{manager/transition.scrbl} 28 | @include-section{manager/save.scrbl} 29 | -------------------------------------------------------------------------------- /scribblings/troubleshooting.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "common.rkt") 4 | 5 | @title{Troubleshooting} 6 | 7 | @margin-note{At the moment this section is weak. 8 | 9 | I need to know what problems you run into! Let me know via issues or email. 10 | 11 | Frosthaven Manager lacks tools that might help troubleshoot complex issues, like 12 | logs that can be captured for issues or a debugging mode. Help contribute to 13 | Frosthaven Manager by making it easier to understand and resolve problems.} 14 | 15 | If the resources on this page don't answer your question or solve your problem, 16 | @link["https://github.com/benknoble/frosthaven-manager/issues/new/choose"]{report 17 | an issue} or @link["mailto:ben.knoble+frosthaven@gmail.com"]{send an email}. 18 | 19 | It helps to attach logs if you have them; see @secref{Other_utilities}. 20 | 21 | @section{Reference Material} 22 | 23 | For help with installation, see @secref{Installing_Frosthaven_Manager}. 24 | 25 | For help using Frosthaven Manager, see @secref{How_to_play}. 26 | 27 | For help with bestiaries and scenario programs, such as when they won't load, 28 | see @secref{Programming_a_Scenario}. 29 | 30 | @section{FAQs} 31 | -------------------------------------------------------------------------------- /scribblings/gui.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @title[#:tag "frosthaven-manager/gui"]{@tt{gui}} 4 | 5 | This collection provides modules for operating GUIs. 6 | 7 | @include-section{gui/common-menu.scrbl} 8 | @include-section{gui/counter.scrbl} 9 | @include-section{gui/elements.scrbl} 10 | @include-section{gui/font.scrbl} 11 | @include-section{gui/formula-editor.scrbl} 12 | @include-section{gui/helpers.scrbl} 13 | @include-section{gui/level-info.scrbl} 14 | @include-section{gui/level-picker.scrbl} 15 | @include-section{gui/loot.scrbl} 16 | @include-section{gui/manager.scrbl} 17 | @include-section{gui/markdown.scrbl} 18 | @include-section{gui/mixins.scrbl} 19 | @include-section{gui/monster-modifier.scrbl} 20 | @include-section{gui/monsters.scrbl} 21 | @include-section{gui/number-players.scrbl} 22 | @include-section{gui/player-info.scrbl} 23 | @include-section{gui/render.scrbl} 24 | @include-section{gui/rewards.scrbl} 25 | @include-section{gui/rich-text-display.scrbl} 26 | @include-section{gui/round-number.scrbl} 27 | @include-section{gui/round-prompts.scrbl} 28 | @include-section{gui/server.scrbl} 29 | @include-section{gui/stacked-tables.scrbl} 30 | @include-section{gui/static-table.scrbl} 31 | @include-section{gui/table.scrbl} 32 | -------------------------------------------------------------------------------- /scribblings/gui/helpers.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket/gui 4 | racket/gui/easy)) 5 | 6 | @title{@tt{gui/helpers}} 7 | @defmodule[frosthaven-manager/gui/helpers] 8 | 9 | @defproc[(translate-to-top-coords 10 | [this (is-a?/c area<%>)] 11 | [top (is-a?/c area<%>)] 12 | [x position-integer?] 13 | [y position-integer?]) 14 | (values position-integer? position-integer?)]{ 15 | Returns translated @racket[x] and @racket[y] coordinates relative to 16 | @racket[top], assuming they were originally relative to @racket[this]. 17 | } 18 | 19 | @defproc[(escape-text [s string?]) string?]{ 20 | Escapes @racket[s] for use in @racket[text]; only needed when @racket[s] is 21 | derived from user input. 22 | } 23 | 24 | @defform[(define-error-text |@error-text-id| with-error-text-id)]{ 25 | Binds @racket[|@error-text-id|] to an observable string and 26 | @racket[with-error-text-id] to a form accepting arbitrarily many expressions. 27 | The form resets @racket[|@error-text-id|] evaluates all of its body expressions 28 | and returns the result of the last one; if any raise an exception, instead, the 29 | exception's error message is stored in @racket[|@error-text-id|] and returned 30 | from the form. 31 | } 32 | -------------------------------------------------------------------------------- /aoe.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide (rename-out [mb #%module-begin]) #%app #%datum #%top #%top-interaction) 4 | 5 | (require frosthaven-manager/aoe-images 6 | syntax/parse/define) 7 | 8 | (define-syntax-parser mb 9 | [(_ spec:expr) 10 | (syntax/loc this-syntax 11 | (#%module-begin 12 | (provide aoe) 13 | (define (aoe) 14 | (spec->shape 'spec)) 15 | (module+ main 16 | (require racket/gui pict) 17 | (show-pict (aoe)))))]) 18 | 19 | (module reader syntax/module-reader 20 | frosthaven-manager/aoe 21 | #:module-wrapper 22 | (λ (make-module stx?) 23 | (cond 24 | [stx? (syntax-parse (make-module) 25 | [(module name module-path 26 | (#%module-begin x:aoe-spec ...)) 27 | (define xs (syntax->list #'(x ...))) 28 | (define spec (datum->syntax #'(x ...) (syntaxes->spec xs) #'(x ...))) 29 | (strip-context 30 | #`(module name module-path 31 | (#%module-begin #,spec)))])] 32 | [else (make-module)])) 33 | (require frosthaven-manager/aoe-images 34 | syntax/parse 35 | syntax/strip-context) 36 | (define-syntax-class aoe-spec 37 | [pattern {~or {~datum s} {~datum x} {~datum o} {~datum m} {~datum g}}])) 38 | -------------------------------------------------------------------------------- /scribblings/manager/elements.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/gui/easy/contract 5 | frosthaven-manager/manager/elements)) 6 | 7 | @title{@tt{manager/elements}} 8 | @defmodule[frosthaven-manager/manager/elements] 9 | 10 | @defthing[element-state/c 11 | contract? 12 | #:value (or/c 'unfused 'infused 'waning)]{ 13 | A contract recognizing valid element states. 14 | } 15 | 16 | @defproc[(make-states [es (listof any/c)]) 17 | (listof (obs/c element-state/c))]{ 18 | Builds an equally-sized list of element states to control @racket[es] in 19 | @racket[elements-cycler]. 20 | } 21 | 22 | @deftogether[(@defproc[(infuse-all [es (listof (obs/c element-state/c))]) any] 23 | @defproc[(consume-all [es (listof (obs/c element-state/c))]) any])]{ 24 | Set all element states @racket[es] to @racket['infused] or @racket['unfused], 25 | respectively. 26 | } 27 | 28 | @defproc[(wane-element [state element-state/c]) 29 | element-state/c]{ 30 | Returns the new element state after waning for one cycle. 31 | } 32 | 33 | @defproc[(transition-element-state [state element-state/c]) element-state/c]{ 34 | Returns the new element state after cycling once, with unfused wrapping around 35 | to infused. 36 | } 37 | -------------------------------------------------------------------------------- /ABOUT.md: -------------------------------------------------------------------------------- 1 | # About Frosthaven Manager 2 | 3 | Programmed by D. Ben Knoble. © D. Ben Knoble 2022. 4 | 5 | All parts of Frosthaven Manager are licensed under the [MIT License](https://github.com/benknoble/frosthaven-manager/blob/543fc2d961ab8c8830840e62b1080f80483845d9/LICENSE). 6 | 7 | Frosthaven and all related properties, images and text are owned by [Cephalofair Games](https://cephalofair.com). 8 | 9 | ## Thanks 10 | 11 | Thank you to Derrick Franklin, John Hines, Jake Hicks, and Savannah Knoble for 12 | initial play-testing. Try not to let John have all the loot. 13 | 14 | Thank you to [Isaac Childres](https://twitter.com/Cephalofair), [Cephalofair Games](https://cephalofair.com), and 15 | the entire Frosthaven design and development team for giving us this wonderful 16 | game to play. 17 | 18 | ## Get Involved 19 | 20 | Development happens [on GitHub under `benknoble/frosthaven-manager`](https://github.com/benknoble/frosthaven-manager). 21 | Get involved by: 22 | 23 | - [Reporting an Issue](https://github.com/benknoble/frosthaven-manager/issues/new/choose) 24 | - [Requesting a Feature](https://github.com/benknoble/frosthaven-manager/issues/new/choose) 25 | - [Opening a Pull Request](https://github.com/benknoble/frosthaven-manager/compare) 26 | - [Sending Feedback of any kind](mailto:ben.knoble+frosthaven@gmail.com) 27 | 28 | 29 | -------------------------------------------------------------------------------- /scribblings/enum-helpers.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | racket/serialize 5 | rebellion/type/enum 6 | frosthaven-manager/enum-helpers)) 7 | 8 | @title{@tt{enum-helpers}} 9 | @defmodule[frosthaven-manager/enum-helpers] 10 | 11 | @defform[(define-serializable-enum-type id (constant-id ...) enum-option ...) 12 | #:grammar ([enum-option #:omit-root-binding 13 | (code:line #:descriptor-name descriptor-id) 14 | (code:line #:predicate-name predicate-id) 15 | (code:line #:discriminator-name discriminator-id) 16 | (code:line #:selector-name selector-id) 17 | (code:line #:property-maker prop-maker-expr) 18 | (code:line #:inspector inspector-expr)]) 19 | #:contracts ([prop-maker-expr (-> uninitialized-enum-descriptor? 20 | (listof (cons/c struct-type-property? any/c)))] 21 | [inspector-expr inspector?])]{ 22 | Exactly like @racket[define-enum-type], but with the addition of 23 | @racket[prop:serializable] via a deserialize-info named 24 | @racketidfont{deserialize-info:}@racket[id]. 25 | } 26 | -------------------------------------------------------------------------------- /scribblings/common.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (provide markdown-inline 4 | markdown-part 5 | ABOUT.md 6 | 7 | terminal 8 | 9 | select-monster-db-tag 10 | 11 | ref-doc 12 | gui-doc) 13 | 14 | (require markdown 15 | markdown/scrib 16 | racket/match 17 | racket/runtime-path 18 | scribble/base 19 | scribble/decode) 20 | 21 | (define-runtime-path ABOUT.md "../ABOUT.md") 22 | 23 | (define (markdown-inline file) 24 | (xexprs->scribble-pres 25 | (strip-html-comments 26 | (with-input-from-file file read-markdown)))) 27 | 28 | (define (markdown-part file) 29 | (decode 30 | (xexprs->scribble-pres 31 | (strip-html-comments 32 | (with-input-from-file file read-markdown))))) 33 | 34 | (define (strip-html-comments xexpr) 35 | (match xexpr 36 | [(cons '!HTML-COMMENT _) ""] 37 | [(list tag (list (list attr val) ...) x ...) 38 | (list* tag (map list attr val) 39 | (map strip-html-comments x))] 40 | [(list tag x ...) (list* tag (map strip-html-comments x))] 41 | [else xexpr])) 42 | 43 | (define (terminal . args) 44 | (nested #:style 'code-inset 45 | (apply verbatim args))) 46 | 47 | (define select-monster-db-tag "select-monster-db") 48 | 49 | (define ref-doc '(lib "scribblings/reference/reference.scrbl")) 50 | (define gui-doc '(lib "scribblings/gui/gui.scrbl")) 51 | -------------------------------------------------------------------------------- /manager/save.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [do-save-game (-> state? any)] 6 | [do-load-game (-> state? any)] 7 | [save-game (-> state? (-> path-string? any))] 8 | [load-game (-> state? (-> path-string? any))])) 9 | 10 | (require frosthaven-manager/files 11 | frosthaven-manager/manager/state 12 | frosthaven-manager/observable-operator) 13 | 14 | (define ((save-game s) p) 15 | (call-with-output-file* p (curry serialize-state s) #:exists 'replace)) 16 | 17 | (define (do-save-game s) 18 | (cond [(put-file/filter "Save Game" '("Saved Games" "*.fasl")) => (save-game s)])) 19 | 20 | (define ((load-game s) p) 21 | (define saved-state (call-with-input-file* p deserialize-state)) 22 | (copy-state saved-state s) 23 | ;; Restore error logs, unless there was no file but now stderr isn't hooked up 24 | ;; to a TTY. See gui/manager.rkt startup sequence. 25 | (cond 26 | [(@! (state-@error-logs s)) 27 | => 28 | (λ (logs) 29 | (current-error-port (open-output-file logs #:exists 'append #:mode 'text)))] 30 | [(not (terminal-port? (current-error-port))) 31 | (define temp (make-temporary-file "frosthaven-manager-~a")) 32 | (current-error-port (open-output-file temp #:exists 'truncate #:mode 'text)) 33 | (:= (state-@error-logs s) temp)])) 34 | 35 | (define (do-load-game s) 36 | (cond [(get-file/filter "Load Game" '("Saved Games" "*.fasl")) => (load-game s)])) 37 | -------------------------------------------------------------------------------- /defns/level.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [struct level-info ([monster-level natural-number/c] 6 | [gold natural-number/c] 7 | [trap-damage natural-number/c] 8 | [hazardous-terrain natural-number/c] 9 | [exp natural-number/c])] 10 | [number-of-levels natural-number/c] 11 | [max-level natural-number/c] 12 | [level/c contract?] 13 | [max-players natural-number/c] 14 | [num-players/c contract?] 15 | [get-level-info (-> level/c level-info?)] 16 | [inspiration-reward (-> num-players/c natural-number/c)])) 17 | 18 | (define max-players 4) 19 | 20 | (define num-players/c (integer-in 2 max-players)) 21 | 22 | (struct level-info [monster-level gold trap-damage hazardous-terrain exp] #:transparent) 23 | 24 | (define level-table 25 | (list (level-info 0 2 2 1 4) 26 | (level-info 1 2 3 2 6) 27 | (level-info 2 3 4 2 8) 28 | (level-info 3 3 5 2 10) 29 | (level-info 4 4 6 3 12) 30 | (level-info 5 4 7 3 14) 31 | (level-info 6 5 8 3 16) 32 | (level-info 7 6 9 4 18))) 33 | 34 | (define number-of-levels (length level-table)) 35 | 36 | (define max-level (sub1 number-of-levels)) 37 | 38 | (define level/c (integer-in 0 max-level)) 39 | 40 | (define (get-level-info level) 41 | (list-ref level-table level)) 42 | 43 | (define (inspiration-reward num-players) 44 | (- 4 num-players)) 45 | -------------------------------------------------------------------------------- /bestiary.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | #%app #%datum #%top #%top-interaction 5 | (rename-out [mb #%module-begin])) 6 | 7 | (require (for-syntax frosthaven-manager/syntax/monsters) 8 | frosthaven-manager/syntax/monsters 9 | syntax/parse/define) 10 | 11 | (define-syntax-parser mb 12 | [(_ ({~datum import} imports:string ...) 13 | ({~datum info} infos ...) 14 | ({~datum ability} actions ...)) 15 | #:do [(define-values (imported-info-dbs imported-ability-dbs) 16 | (imports->dbs (syntax->datum #'(imports ...))))] 17 | #:fail-unless (check-monsters-have-abilities imported-info-dbs imported-ability-dbs 18 | (syntax->datum #'(infos ...)) 19 | (syntax->datum #'(actions ...))) 20 | (check-monsters-have-abilities-message imported-info-dbs imported-ability-dbs 21 | (syntax->datum #'(infos ...)) 22 | (syntax->datum #'(actions ...))) 23 | ;;=> 24 | (syntax/loc this-syntax 25 | (#%module-begin 26 | (make-dbs (provide info-db ability-db) 27 | (import imports ...) 28 | (info infos ...) 29 | (ability actions ...))))]) 30 | 31 | (module reader frosthaven-manager/syntax/module-reader 32 | frosthaven-manager/bestiary 33 | [parse-bestiary from frosthaven-manager/parsers/monster]) 34 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | on: [push, pull_request] 2 | name: CI 3 | jobs: 4 | build: 5 | name: "Build on Racket '${{ matrix.racket-version }}' (${{ matrix.racket-variant }})" 6 | runs-on: ubuntu-latest 7 | continue-on-error: ${{ matrix.experimental || false }} 8 | strategy: 9 | fail-fast: false 10 | matrix: 11 | racket-version: ["stable", "current"] 12 | racket-variant: ["BC", "CS"] 13 | include: 14 | - racket-version: current 15 | experimental: true 16 | exclude: 17 | # CI failing on BC stable lately, possible TR bug: 18 | # https://github.com/bennn/rackunit-abbrevs/issues/6 19 | - racket-variant: BC 20 | racket-version: stable 21 | steps: 22 | - uses: actions/checkout@v4 23 | - uses: Bogdanp/setup-racket@v1.11 24 | with: 25 | architecture: x64 26 | distribution: full 27 | variant: ${{ matrix.racket-variant }} 28 | version: ${{ matrix.racket-version }} 29 | - name: Installing frosthaven-manager and its dependencies 30 | run: make install 31 | - name: Compiling frosthaven-manager and building its docs 32 | run: make check-deps RACO_SETUP_ARGS=--unused-pkg-deps 33 | - name: Install xvfb to run headless tests 34 | run: sudo apt-get install xvfb 35 | - name: Testing frosthaven-manager 36 | run: xvfb-run make test RACO_TEST_ARGS=--no-run-if-absent 37 | -------------------------------------------------------------------------------- /scribblings/manager/ability-decks.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | frosthaven-manager/manager)) 6 | 7 | @title{@tt{manager/ability-decks}} 8 | @defmodule[frosthaven-manager/manager/ability-decks] 9 | 10 | @defstruct*[ability-decks ([current (or/c #f monster-ability?)] 11 | [draw (listof monster-ability?)] 12 | [discard (listof monster-ability?)]) 13 | #:transparent]{ 14 | Monster ability deck, with currently active card, draw pile, and discard pile. 15 | 16 | Serializable. 17 | } 18 | 19 | @defproc[(ability-decks-draw-next [ad ability-decks?]) ability-decks?]{ 20 | Draws a card from the ability deck. The value of @racket[(ability-decks-current ad)] 21 | is silently discarded; if it is a @racket[monster-ability?], it is effectively 22 | lost. 23 | } 24 | 25 | @defproc[(ability-decks-discard-and-maybe-shuffle [ad ability-decks?]) 26 | ability-decks?]{ 27 | Discards the active card and shuffles the ability deck if necessary. 28 | } 29 | 30 | @defproc[(update-ability-decks [f (-> string? ability-decks? ability-decks?)]) 31 | (-> (hash/c string? ability-decks?) (hash/c string? ability-decks?))]{ 32 | Updates each deck via @racket[f], which is called with the monster set and deck. 33 | } 34 | 35 | @defproc[(move-top-draw-to-bottom [ad ability-decks?]) ability-decks?]{ 36 | Moves the top card of the draw pile to its bottom. 37 | } 38 | -------------------------------------------------------------------------------- /constants.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide define-constant-format/parse 4 | define-constant-format 5 | define-constant-parse) 6 | 7 | (require syntax/parse/define) 8 | 9 | (begin-for-syntax 10 | (define-syntax-class clause 11 | #:attributes (constant string) 12 | [pattern [constant:id string:string]])) 13 | 14 | (define-syntax-parser define-constant-format/parse 15 | [(_ formatter:id parser:id (c:clause ...)) 16 | (syntax/loc this-syntax 17 | (begin 18 | (define-constant-format formatter (c ...)) 19 | (define-constant-parse parser (c ...))))]) 20 | 21 | (define-syntax-parser define-constant-format 22 | [(_ formatter:id (c:clause ...)) 23 | (syntax/loc this-syntax 24 | (define formatter 25 | (let ([table (hash {~@ c.constant c.string} ...)]) 26 | (λ (x) 27 | (hash-ref table x (λ () 28 | (raise-arguments-error 'formatter 29 | "value not eligible for formatting" 30 | "value" x)))))))]) 31 | 32 | (define-syntax-parser define-constant-parse 33 | [(_ parser:id (c:clause ...)) 34 | (syntax/loc this-syntax 35 | (define parser 36 | (let ([table (hash {~@ c.string c.constant} ...)]) 37 | (λ (x) 38 | (hash-ref table x (λ () 39 | (raise-arguments-error 'parser 40 | "string not eligible for parsing" 41 | "string" x)))))))]) 42 | -------------------------------------------------------------------------------- /scribblings/parsers/foes.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | megaparsack 5 | frosthaven-manager/defns 6 | frosthaven-manager/parsers/foes)) 7 | 8 | @title{@tt{parsers/foes}} 9 | @defmodule[frosthaven-manager/parsers/foes] 10 | 11 | This module contains parsers for @(hash-lang) 12 | @racketmodname[frosthaven-manager/foes]. See 13 | @secref{Programming_a_Scenario} for more details. 14 | 15 | @defproc[(parse-foes [src any/c] [in input-port?] [#:syntax? syn? any/c]) 16 | (or/c syntax? foes/pc)]{ 17 | The result is @racket[syntax?] with source @racket[src] if @racket[syn?] is 18 | true, and the datum it contains matches @racket[foes/pc]. 19 | } 20 | 21 | @deftogether[(@defthing[foes/pc flat-contract? #:value (list/c (cons/c 'import (listof string?)) (cons/c 'info (listof monster-info?)) (cons/c 'ability (listof monster-ability?)) (cons/c 'foe (listof foe/pc)))] 22 | @defthing[foe/pc flat-contract? #:value (list/c string? string? numbering/pc (listof spec/pc))] 23 | @defthing[spec/pc flat-contract? #:value (hash/c num-players/c monster-type/pc #:immutable #t)] 24 | @defthing[numbering/pc flat-contract? #:value (or/c "ordered" "random" #f)] 25 | @defthing[monster-type/pc flat-contract? #:value (or/c "absent" "normal" "elite")])]{ 26 | Contracts for foes values. 27 | } 28 | 29 | @deftogether[(@defthing[foes/p (parser/c char? foes/pc)] 30 | @defthing[foe/p (parser/c char? foe/pc)])]{ 31 | Textual parsers for parts of the foes language. 32 | } 33 | -------------------------------------------------------------------------------- /testfiles/bosses.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/bestiary 2 | 3 | begin-monster "giant squid" ("boss") 4 | [0 normal [HP "C * 10"] [Move 3] [Attack "C"] ] 5 | [0 elite [HP "C * 10"] [Move 3] [Attack "C"] ] 6 | [1 normal [HP "C * 12"] [Move 3] [Attack "C + 1"] ] 7 | [1 elite [HP "C * 12"] [Move 3] [Attack "C + 1"] ] 8 | [2 normal [HP "C * 15"] [Move 3] [Attack "C + 1"] ] 9 | [2 elite [HP "C * 15"] [Move 3] [Attack "C + 1"] ] 10 | [3 normal [HP "C * 17"] [Move 3] [Attack "C + 2"] ] 11 | [3 elite [HP "C * 17"] [Move 3] [Attack "C + 2"] ] 12 | [4 normal [HP "C * 22"] [Move 3] [Attack "C + 2"] ] 13 | [4 elite [HP "C * 22"] [Move 3] [Attack "C + 2"] ] 14 | [5 normal [HP "C * 25"] [Move 3] [Attack "C + 3"] ] 15 | [5 elite [HP "C * 25"] [Move 3] [Attack "C + 3"] ] 16 | [6 normal [HP "C * 35"] [Move 3] [Attack "C + 4"] ] 17 | [6 elite [HP "C * 35"] [Move 3] [Attack "C + 4"] ] 18 | [7 normal [HP "C * 35"] [Move 3] [Attack "C + 5"] ] 19 | [7 elite [HP "C * 35"] [Move 3] [Attack "C + 5"] ] 20 | end-monster 21 | 22 | begin-ability-deck "boss" 23 | ["I'm a boss" 45 {"move +1" "attack -1 aoe(aoes/ring1.rkt)"}] 24 | ["I'm a boss" 45 {"move +1" "attack -1 aoe(aoes/ring1.rkt)"}] 25 | ["I'm a boss" 45 {"move +1" "attack -1 aoe(aoes/ring1.rkt)"}] 26 | ["I'm a boss" 45 {"move +1" "attack -1 aoe(aoes/ring1.rkt)"}] 27 | ["I'm a boss" 45 {"move +1" "attack -1 aoe(aoes/ring1.rkt)"}] 28 | ["I'm a boss" 45 {"move +1" "attack -1 aoe(aoes/ring1.rkt)"}] 29 | ["I'm a boss" 45 {"move +1" "attack -1 aoe(aoes/ring1.rkt)"}] 30 | ["Special" 11 shuffle {"move +1" "attack +3"}] 31 | end-ability-deck 32 | -------------------------------------------------------------------------------- /scribblings/gui/font.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket/gui)) 4 | 5 | @title{@tt{gui/font}} 6 | @defmodule[frosthaven-manager/gui/font] 7 | 8 | This module provides helpers for manipulating font objects, as in 9 | @racket[font%]. 10 | 11 | @defproc[(copy-font 12 | [f (is-a?/c font%)] 13 | [#:size size (real-in 0.0 1024.0) (send f get-size size-in-pixels?)] 14 | [#:face face (or/c string? #f) (send f get-face)] 15 | [#:family family (or/c 'default 'decorative 'roman 'script 'swiss 'modern 'symbol 'system) 16 | (send f get-family)] 17 | [#:style style (or/c 'normal 'italic 'slant) (send f get-style)] 18 | [#:weight weight font-weight/c (send f get-weight)] 19 | [#:underlined? underlined? any/c (send f get-underlined)] 20 | [#:smoothing smoothing (or/c 'default 'partly-smoothed 'smoothed 'unsmoothed) 21 | (send f get-smoothing)] 22 | [#:size-in-pixels? size-in-pixels? any/c (send f get-size-in-pixels)] 23 | [#:hinting hinting (or/c 'aligned 'unaligned) (send f get-hinting)] 24 | [#:feature-settings feature-settings font-feature-settings/c 25 | (send f get-feature-settings)] 26 | [#:font-list font-list (or/c (is-a?/c font-list%) #f) (current-font-list)]) 27 | (is-a?/c font%)]{ 28 | Copy all the features of font @racket[f] to a brand new font object. Supply 29 | modified values via the keyword arguments. 30 | } 31 | 32 | @defthing[big-control-font (is-a?/c font%)]{ 33 | A font bigger than @racket[normal-control-font] and italic, but otherwise the 34 | same. 35 | } 36 | -------------------------------------------------------------------------------- /scribblings/gui/round-prompts.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | racket/gui/easy 6 | racket/gui/easy/contract 7 | frosthaven-manager/manager 8 | frosthaven-manager/gui/round-prompts)) 9 | 10 | @title{@tt{gui/round-prompts}} 11 | @defmodule[frosthaven-manager/gui/round-prompts] 12 | 13 | This module contains GUI utilities for 14 | @racketmodname[frosthaven-manager/manager/round-prompts]. 15 | 16 | @defproc[(prompts-input-view [|@|prompts (obs/c (listof prompt/c))] 17 | [#:on-add on-add (-> prompt/c any) void] 18 | [#:on-remove on-remove (-> natural-number/c prompt/c any) void]) 19 | (is-a?/c view<%>)]{ 20 | Views and constructs a list of round prompt values. The @racket[on-add] event is 21 | emitted when a round prompt is added, and @racket[on-remove] when a round prompt 22 | is removed. The @racket[on-remove] event signals both the index of the round 23 | prompt and the prompt value to be removed. 24 | } 25 | 26 | @defproc[(manage-prompt-menu-item [|@|prompts (obs/c (listof prompt/c))] 27 | [#:on-add on-add (-> prompt/c any) void] 28 | [#:on-remove on-remove (-> natural-number/c prompt/c any) void]) 29 | (is-a?/c view<%>)]{ 30 | Renders a dialog for managing round prompts in the same style as 31 | @racket[prompts-input-view]. 32 | } 33 | 34 | @defproc[(do-round-prompt [t time/c] [round natural-number/c]) any]{ 35 | Renders a dialog prompting players to check the rules based on the timing of the 36 | current round. 37 | } 38 | -------------------------------------------------------------------------------- /testfiles/guards.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/bestiary 2 | 3 | begin-monster "hynox guard" 4 | [0 normal [HP 2] [Move 2] [Attack 2] ] 5 | [0 elite [HP 2] [Move 2] [Attack 3] [Bonuses {"shield 1"}] ] 6 | [1 normal [HP 3] [Move 3] [Attack 3] ] 7 | [1 elite [HP 3] [Move 3] [Attack 4] [Bonuses {"shield 1"}] ] 8 | [2 normal [HP 4] [Move 4] [Attack 4] ] 9 | [2 elite [HP 4] [Move 4] [Attack 5] [Bonuses {"shield 1"}] ] 10 | [3 normal [HP 5] [Move 5] [Attack 5] ] 11 | [3 elite [HP 5] [Move 5] [Attack 6] [Bonuses {"shield 2"}] ] 12 | [4 normal [HP 6] [Move 6] [Attack 6] ] 13 | [4 elite [HP 6] [Move 6] [Attack 7] [Bonuses {"shield 2"}] ] 14 | [5 normal [HP 7] [Move 7] [Attack 7] ] 15 | [5 elite [HP 7] [Move 7] [Attack 8] [Bonuses {"shield 2"}] ] 16 | [6 normal [HP 8] [Move 8] [Attack 8] ] 17 | [6 elite [HP 8] [Move 8] [Attack 9] [Bonuses {"shield 3"}] ] 18 | [7 normal [HP 9] [Move 9] [Attack 9] ] 19 | [7 elite [HP 9] [Move 9] [Attack 10] [Bonuses {"shield 3"}] ] 20 | end-monster 21 | 22 | begin-ability-deck "guard" 23 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 24 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 25 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 26 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 27 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 28 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 29 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 30 | ["stand tall" 80 shuffle {"shield 3"}] 31 | end-ability-deck 32 | -------------------------------------------------------------------------------- /manager/elements.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [element-state/c contract?] 6 | [make-states (-> (listof any/c) (listof (obs/c element-state/c)))] 7 | [infuse-all (-> (listof (obs/c element-state/c)) any)] 8 | [consume-all (-> (listof (obs/c element-state/c)) any)] 9 | [wane-element (-> element-state/c element-state/c)] 10 | [transition-element-state (-> element-state/c element-state/c)])) 11 | 12 | (require frosthaven-manager/observable-operator 13 | racket/gui/easy/contract) 14 | 15 | (module+ test (require rackunit)) 16 | 17 | (define element-state/c (or/c 'unfused 'infused 'waning)) 18 | 19 | (define (make-states es) 20 | ;; don't use const; we don't want them to all be eq? 21 | (map (λ (_) (@ 'unfused)) es)) 22 | 23 | (module+ test 24 | (test-case "make-states" 25 | (check-equal? (length (make-states (range 6))) 6) 26 | (check-false (let ([states (make-states (range 6))]) 27 | (andmap eq? (drop-right states 1) (cdr states)))))) 28 | 29 | (define ((make-all state) es) 30 | (for ([@e (in-list es)]) 31 | (:= @e state))) 32 | 33 | (define infuse-all (make-all 'infused)) 34 | (define consume-all (make-all 'unfused)) 35 | 36 | (module+ test 37 | (test-case "*-all" 38 | (define states (make-states (range 6))) 39 | (infuse-all states) 40 | (check-true (andmap {(equal? 'infused)} (map @! states))) 41 | (consume-all states) 42 | (check-true (andmap {(equal? 'unfused)} (map @! states))))) 43 | 44 | (define wane-element 45 | (match-lambda 46 | ['infused 'waning] 47 | ['waning 'unfused] 48 | [_ 'unfused])) 49 | 50 | (define transition-element-state 51 | (match-lambda 52 | ['unfused 'infused] 53 | ['infused 'waning] 54 | ['waning 'unfused] 55 | [_ 'infused])) 56 | -------------------------------------------------------------------------------- /scribblings/defns/level.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | frosthaven-manager/parsers/formula)) 6 | 7 | @title{Level Info} 8 | @defmodule[frosthaven-manager/defns/level] 9 | 10 | @defstruct*[level-info 11 | ([monster-level natural-number/c] 12 | [gold natural-number/c] 13 | [trap-damage natural-number/c] 14 | [hazardous-terrain natural-number/c] 15 | [exp natural-number/c]) 16 | #:transparent]{ 17 | An instance of @racket[level-info] exposes characteristics of the level, such as 18 | the monster level, value of gold, damage caused by traps and hazardous terrain, 19 | and end-of-scenario experience. 20 | } 21 | 22 | @defthing[number-of-levels natural-number/c]{ 23 | A constant representing the number of possible levels, as opposed to what the 24 | levels are. 25 | } 26 | 27 | @defthing[max-level natural-number/c]{ 28 | A constant representing the maximum level. The minimum level is 0. 29 | } 30 | 31 | @defthing[level/c contract?]{ 32 | A contract recognizing valid level numbers, used for both the scenario level and 33 | monster levels. 34 | } 35 | 36 | @defthing[max-players natural-number/c]{ 37 | A constant representing the maximum number of players. 38 | } 39 | 40 | @defthing[num-players/c contract?]{ 41 | A contract recognizing a valid number of players. 42 | } 43 | 44 | @defproc[(get-level-info [level level/c]) level-info?]{ 45 | Returns the @racket[level-info] for the given @racket[level] number. 46 | } 47 | 48 | @defproc[(inspiration-reward [num-players num-players/c]) natural-number/c]{ 49 | Returns the amount of inspiration rewarded for completing a scenario based on 50 | how many players participated in the scenario. 51 | } 52 | -------------------------------------------------------------------------------- /scribblings/parsers/monster.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | megaparsack 6 | frosthaven-manager/parsers/monster)) 7 | 8 | @title{@tt{parsers/monster}} 9 | @defmodule[frosthaven-manager/parsers/monster] 10 | 11 | This module contains parsers for @(hash-lang) 12 | @racketmodname[frosthaven-manager/bestiary]. See 13 | @secref{Programming_a_Scenario} for more details. 14 | 15 | @defproc[(parse-bestiary [src any/c] [in input-port?] [#:syntax? syn? any/c]) 16 | (or/c syntax? bestiary/c)]{ 17 | The result is @racket[syntax?] with source @racket[src] if @racket[syn?] is 18 | true, and the datum it contains matches @racket[bestiary/c]. 19 | } 20 | 21 | @defthing[bestiary/c flat-contract? 22 | #:value 23 | (list/c (cons/c 'import (listof string?)) 24 | (cons/c 'info (listof monster-info?)) 25 | (cons/c 'ability (listof monster-ability?)))]{ 26 | A contract for bestiary values. 27 | } 28 | 29 | @deftogether[(@defthing[monster/p (parser/c char? monster-info?)] 30 | @defthing[ability-deck/p (parser/c char? (listof monster-ability?))] 31 | @defthing[import-monsters/p (parser/c char? (list/c 'import string?))] 32 | @defthing[bestiary/p (parser/c char? bestiary/c)])]{ 33 | Textual parsers for parts of the bestiary language. 34 | } 35 | 36 | @defproc[(bestiary-dupes [xs (listof any/c)]) 37 | (values (or/c #f (listof string?)) 38 | (or/c #f (listof string?)))]{ 39 | Returns duplicate monster names from bestiaries and ability decks in 40 | @racket[xs]. The first value is based on any @racket[monster-info]s and the 41 | second on @racket[monster-ability] decks. 42 | } 43 | -------------------------------------------------------------------------------- /scribblings/curlique.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | (prefix-in qi: qi) 5 | (except-in frosthaven-manager/curlique #%app)) 6 | scribble/example) 7 | 8 | @(define my-eval 9 | (make-base-eval '(require racket frosthaven-manager/curlique))) 10 | 11 | @title{@tt{curlique}} 12 | @defmodule[frosthaven-manager/curlique] 13 | 14 | This module provides a shorthand notation for Qi flows. It overrides Racket's 15 | @racket[#%app]: forms written in curly braces like @racket[{(all positive?)}] 16 | are implictly wrapped in @racket[flow] from Qi. 17 | 18 | In addition, it provides the following overrides: 19 | 20 | @deftogether[(@defidform[~>] @defidform[~>>] @defidform[switch])]{ 21 | Like equivalent forms from Qi, @racket[qi:~>], @racket[qi:~>>], 22 | @racket[qi:switch], but if written with curly braces, they are implicitly 23 | wrapped in @racket[flow] instead of acting on specified values. 24 | 25 | @examples[#:eval my-eval #:hidden 26 | (define-syntax (CB stx) 27 | (syntax-case stx () 28 | [(_ input ...) 29 | #'(eval (syntax-property #'(#%app input ...) 'paren-shape #\{ ))])) 30 | (define-syntax (CB-mac stx) 31 | (syntax-case stx () 32 | [(_ input ...) 33 | #'(eval (syntax-property #'(input ...) 'paren-shape #\{ ))])) 34 | ] 35 | @examples[#:eval my-eval 36 | (code:comment "A very small identity") 37 | (eval:alts (map {} (range 10)) 38 | (map (CB) (range 10))) 39 | (eval:alts (define all-good? {(all positive?)}) 40 | (define all-good? (CB (all positive?)))) 41 | (all-good? 1 2 3 4) 42 | (all-good? 1 -2 3 4) 43 | (~> (1 2 3) (-< + count) /) 44 | (eval:alts (define average {~> (-< + count) /}) 45 | (define average (CB-mac ~> (-< + count) /))) 46 | (average 1 2 3) 47 | ] 48 | } 49 | 50 | @(close-eval my-eval) 51 | -------------------------------------------------------------------------------- /scribblings/manager/modifier-decks.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | racket/gui/easy 5 | frosthaven-manager/defns 6 | frosthaven-manager/manager 7 | frosthaven-manager/gui/monster-modifier)) 8 | 9 | @title{@tt{manager/modifier-decks}} 10 | @defmodule[frosthaven-manager/manager/modifier-decks] 11 | 12 | This module provides facilities for manipulating the modifier deck. 13 | 14 | @defproc[(reshuffle-modifier-deck [s state?]) any]{ 15 | Reshuffle the monster modifier deck. 16 | } 17 | 18 | @defproc[(discard [s state?] [card monster-modifier?]) any]{ 19 | Discard a card to the appropriate pile. 20 | } 21 | 22 | @defproc[(draw-modifier [s state?]) (-> any)]{ 23 | Draws and discards a single modifier card. 24 | } 25 | 26 | @defproc[(draw-modifier* [s state?] [keep (-> monster-modifier? monster-modifier? monster-modifier?)]) 27 | (-> any)]{ 28 | Draws two modifier cards and discards them with the kept card on top. 29 | } 30 | 31 | @deftogether[(@defproc[(do-curse-monster [s state?]) (-> any)] 32 | @defproc[(do-bless-monster [s state?]) (-> any)] 33 | @defproc[(do-bless-player [s state?]) (-> any)] 34 | @defproc[(do-unbless-player [s state?]) (-> any)])]{ 35 | Add a curse or bless to the appropriate deck. 36 | } 37 | 38 | @deftogether[(@defproc[(add-monster-modifier [s state?]) (-> monster-modifier? any)] 39 | @defproc[(remove-monster-modifier [s state?]) (-> exact-nonnegative-integer? any)])]{ 40 | Handles events emitted by @racket[card-swapper]. These are intended for use when 41 | the deck handed to @racket[card-swapper] consists of something like this: 42 | @racketblock[ 43 | (obs-combine append (state-@monster-modifier-deck s) (state-@monster-discard s)) 44 | ] 45 | In particular, @racket[remove-monster-modifier] translates indexes to both the 46 | modifier deck and the discard pile. 47 | } 48 | -------------------------------------------------------------------------------- /gui/server.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [launch-server (-> state? renderer?)])) 6 | 7 | (require frosthaven-manager/gui/render 8 | frosthaven-manager/manager 9 | frosthaven-manager/observable-operator 10 | net/sendurl 11 | racket/gui/easy 12 | (except-in racket/gui #%app) 13 | (prefix-in server: frosthaven-manager/server)) 14 | 15 | (define (launch-server s) 16 | (define gui-eventspace (current-eventspace)) 17 | (define (handler evt) 18 | (parameterize ([current-eventspace gui-eventspace]) 19 | (handle s evt))) 20 | (define-values (addr stopper) 21 | (server:launch-server s handler)) 22 | (define stop (box stopper)) 23 | (define/obs @addr addr) 24 | (define (restart) 25 | ((unbox stop)) 26 | (define-values (addr stopper) 27 | (server:launch-server s handler)) 28 | (set-box! stop stopper) 29 | (:= @addr addr)) 30 | (with-closing-custodian/eventspace 31 | (render/eventspace 32 | #:eventspace closing-eventspace 33 | (window 34 | #:title "Running Server" 35 | #:mixin close-custodian-mixin 36 | (text (@> @addr {(~a "Server: " _)})) 37 | (hpanel 38 | (button "Open in browser" (thunk (send-url (@! @addr)))) 39 | (button "Copy address to clipboard" 40 | (thunk 41 | (send the-clipboard set-clipboard-string (@! @addr) 0)))) 42 | (button "Restart Server" restart))))) 43 | 44 | (define (handle s evt) 45 | (queue-callback 46 | (cond 47 | [(procedure-arity-includes? evt 1) (thunk (evt s))] 48 | [else evt]))) 49 | 50 | (module+ main 51 | (require frosthaven-manager/testfiles/data) 52 | ;; gui/manager depends on gui/server… 53 | (define manager (dynamic-require 'frosthaven-manager/gui/manager 'manager)) 54 | (define s (make-sample-state)) 55 | (make-sample-loot-deck s) 56 | (void (reshuffle-modifier-deck s)) 57 | (void (launch-server s) 58 | (render/eventspace (manager s)))) 59 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | 3 | (define collection "frosthaven-manager") 4 | (define racket-launcher-names '("frosthaven-manager")) 5 | (define racket-launcher-libraries '("gui/manager")) 6 | (define gracket-launcher-names '("FrosthavenManager")) 7 | (define gracket-launcher-libraries '("gui/manager")) 8 | (define deps '("dbg" 9 | "syntax-classes-lib" 10 | "snip-lib" 11 | "pict-snip-lib" 12 | "pretty-expressive" 13 | "alexis-multicast" 14 | "nat-traversal" 15 | "web-server-lib" 16 | "functional-lib" 17 | ("megaparsack-lib" #:version "1.8") 18 | "reprovide-lang-lib" 19 | "draw-lib" 20 | "markdown" 21 | "net-lib" 22 | "txexpr" 23 | "gui-lib" 24 | "htdp-lib" 25 | "pict-lib" 26 | ("qi-lib" #:version "4.0") 27 | ("gui-easy-lib" #:version "0.18") 28 | "rebellion" 29 | "base")) 30 | (define build-deps '("draw-doc" 31 | "pict-doc" 32 | "gui-doc" 33 | "gui-easy" 34 | "megaparsack-doc" 35 | ("qi-doc" #:version "4.0") 36 | "rackunit-lib" 37 | "scribble-lib" 38 | "racket-doc")) 39 | (define scribblings '(("scribblings/frosthaven-manager.scrbl" (multi-page)))) 40 | (define pkg-desc "Frosthaven Scenario Manager") 41 | (define version "0.27.1") 42 | (define pkg-authors '(benknoble)) 43 | (define license 'MIT) 44 | 45 | (define compile-omit-paths '("FrosthavenManager.app" 46 | "macOS-FrosthavenManager" 47 | "linux-FrosthavenManager" 48 | "windows-FrosthavenManager" 49 | "docs" 50 | "screenshots")) 51 | (define test-omit-paths compile-omit-paths) 52 | -------------------------------------------------------------------------------- /gui/helpers.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | translate-to-top-coords 5 | escape-text 6 | define-error-text) 7 | 8 | (require racket/class 9 | racket/gui/easy/operator 10 | syntax/parse/define) 11 | 12 | (module+ test (require racket/gui/easy 13 | rackunit 14 | syntax/macro-testing)) 15 | 16 | (define (translate-to-top-coords this top x y) 17 | (define-values (xs ys) (send this client->screen x y)) 18 | (send top screen->client xs ys)) 19 | 20 | (define (escape-text s) 21 | (regexp-replace* #px"&(?!&)" s "&&")) 22 | 23 | (module+ test 24 | (test-case "escape-text" 25 | (check-equal? (escape-text "foo") "foo") 26 | (check-equal? (escape-text "Flourish & Fletch & Foo") "Flourish && Fletch && Foo") 27 | (check-equal? (escape-text "Flourish && Fletch") "Flourish &&& Fletch"))) 28 | 29 | (define-syntax-parser define-error-text 30 | [(_ @error-text:id with-error-text:id) 31 | #:fail-when (equal? 'expression (syntax-local-context)) "not allowed in an expression context" 32 | (syntax/loc this-syntax 33 | (begin 34 | (define/obs @error-text "") 35 | (define-syntax with-error-text (-with-error-text #'@error-text))))]) 36 | 37 | (define-for-syntax (-with-error-text error-text-id) 38 | (syntax-parser 39 | [(_ e:expr ...+) 40 | (quasisyntax/loc this-syntax 41 | (call-with-error-text #,error-text-id (thunk e ...)))])) 42 | 43 | (define (call-with-error-text @error-text th) 44 | (:= @error-text "") 45 | (with-handlers ([exn:fail? (λ (e) (:= @error-text (exn-message e)))]) 46 | (th))) 47 | 48 | (module+ test 49 | (let () 50 | (define-error-text @e wet) 51 | (check-equal? (obs-peek @e) "") 52 | (check-equal? (wet (add1 2)) 3) 53 | (check-equal? (obs-peek @e) "") 54 | (check-not-exn (thunk (wet (/ 1 0)))) 55 | (check-regexp-match #rx"division by zero" (obs-peek @e))) 56 | (check-exn #rx"expression context" 57 | (thunk 58 | (convert-syntax-error (if 1 (define-error-text @x wxt) 2))))) 59 | -------------------------------------------------------------------------------- /curlique.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide (rename-out [curlique-app #%app] 4 | [curlique~> ~>] 5 | [curlique~>> ~>>] 6 | [curlique-switch switch]) 7 | (except-out (all-from-out qi) 8 | ~> 9 | ~>> 10 | switch)) 11 | 12 | (require (for-syntax syntax/parse/class/paren-shape) 13 | qi 14 | syntax/parse/define 15 | (only-in racket [#%app racket:app])) 16 | 17 | (define-syntax-parser curlique-app 18 | [{~braces _ x ...} 19 | (syntax/loc this-syntax 20 | (flow x ...))] 21 | [(_ x ...) 22 | (syntax/loc this-syntax 23 | (racket:app x ...))]) 24 | 25 | (define-syntax-parse-rule (define-curlique-syntax name:id qi-form:id) 26 | #:with ooo #'(... ...) 27 | (define-syntax-parser name 28 | [{~braces _ x ooo} 29 | (syntax/loc this-syntax 30 | (flow (qi-form x ooo)))] 31 | [(_ x ooo) 32 | (syntax/loc this-syntax 33 | (qi-form x ooo))])) 34 | 35 | (define-syntax-parse-rule (define-curlique-syntaxes [name:id qi-form:id] ...) 36 | (begin (define-curlique-syntax name qi-form) ...)) 37 | 38 | (define-curlique-syntaxes 39 | [curlique~> ~>] 40 | [curlique~>> ~>>] 41 | [curlique-switch switch]) 42 | 43 | (module* test racket 44 | (require (submod "..")) 45 | (require rackunit 46 | syntax/macro-testing) 47 | ;; flow errors 48 | (check-exn #rx"more terms" (thunk (convert-syntax-error {(><)}))) 49 | (check-exn #rx"flow" (thunk (convert-syntax-error {list 1 2 2}))) 50 | ;; handy identity 51 | (check-equal? {} values) 52 | ;; macros bypass #%app 53 | (check-equal? {on (1)} 1) 54 | (check-equal? ({thunk 123}) 123) 55 | ;; flow and curlique-syntax examples 56 | (check-equal? (map {~>} (range 10)) (range 10)) 57 | (check-equal? ({~> (-< add1 sub1) /} 5) 3/2) 58 | (check-equal? (~> (1 2 3) +) 6) 59 | (check-equal? (map {switch [positive? add1] [negative? sub1]} 60 | (inclusive-range -2 2)) 61 | '(-3 -2 0 2 3)) 62 | (check-true ({(all positive?)} 1 2 3 4))) 63 | -------------------------------------------------------------------------------- /scribblings/gui/monster-modifier.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | racket/gui/easy 6 | racket/gui/easy/contract 7 | frosthaven-manager/manager 8 | frosthaven-manager/gui/monster-modifier)) 9 | 10 | @title{@tt{gui/monster-modifier}} 11 | @defmodule[frosthaven-manager/gui/monster-modifier] 12 | 13 | @defproc[(modify-monster-deck-menu-item [|@|cards (obs/c (listof monster-modifier?))] 14 | [#:on-add on-add (-> monster-modifier? any) void] 15 | [#:on-remove on-remove (-> exact-nonnegative-integer? any) void] 16 | [#:on-shuffle on-shuffle (-> any)]) 17 | (is-a?/c view<%>)]{ 18 | A menu-item rendering @racket[favors-dialog]. 19 | } 20 | 21 | @defproc[(favors-dialog [|@|cards (obs/c (listof monster-modifier?))] 22 | [#:on-add on-add (-> monster-modifier? any) void] 23 | [#:on-remove on-remove (-> exact-nonnegative-integer? any) void] 24 | [#:on-shuffle on-shuffle (-> any)]) 25 | (is-a?/c window-view<%>)]{ 26 | A dialog that wraps @racket[card-swapper] and adds a @onscreen{Shuffle} button 27 | which emits @racket[on-shuffle]. 28 | } 29 | 30 | @defproc[(card-swapper [|@|cards (obs/c (listof monster-modifier?))] 31 | [#:on-add on-add (-> monster-modifier? any) void] 32 | [#:on-remove on-remove (-> exact-nonnegative-integer? any) void]) 33 | (is-a?/c view<%>)]{ 34 | A view that permits swapping cards in or out of @racket[|@|cards], a subset of 35 | @racket[monster-modifier-deck] according to @racket[absent-from-modifier-deck], 36 | by clicking @onscreen{<=} and @onscreen{=>} arrows. 37 | 38 | When a card is added via the @onscreen{<=} arrow, calls @racket[on-add] with the 39 | card. When a card is removed via the @onscreen{=>} arrow, calls @racket[on-remove] 40 | with the cards index. 41 | } 42 | -------------------------------------------------------------------------------- /testfiles/parsers/monster.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require frosthaven-manager/parsers/monster 4 | megaparsack) 5 | 6 | (define bestiary-bad-formula 7 | #< (f s) ~a) #:enabled? #f)) 12 | 13 | (define (pp-view lab f s) 14 | (input #:label lab (@> (f s) pretty-format) #:style '(multiple) #:enabled? #f 15 | #:min-size '(0 100))) 16 | 17 | (define (plain-view s) 18 | (vpanel 19 | #:style '(vscroll) 20 | (~a-view "level" state-@level s) 21 | (~a-view "num-players" state-@num-players s) 22 | (pp-view "creatures" state-@creatures s) 23 | (pp-view "type->number-of-cards" state-@type->number-of-cards s) 24 | (pp-view "loot-deck" state-@loot-deck s) 25 | (~a-view "num-loot-cards" state-@num-loot-cards s) 26 | (apply hpanel 27 | #:stretch '(#t #f) 28 | (for/list ([@es (state-@elements s)] 29 | [e (elements)]) 30 | (input #:label (element-pics-name e) (@> @es ~a) #:enabled? #f))) 31 | (~a-view "in-draw?" state-@in-draw? s) 32 | (~a-view "round" state-@round s) 33 | (pp-view "monster-modifier-deck" state-@monster-modifier-deck s) 34 | (pp-view "monster-discard" state-@monster-discard s) 35 | (pp-view "player-blesses" state-@player-blesses s) 36 | (pp-view "curses" state-@curses s) 37 | (pp-view "blesses" state-@blesses s) 38 | (pp-view "modifier" state-@modifier s) 39 | (pp-view "monster-prev-discard" state-@monster-prev-discard s) 40 | (pp-view "bestiary-path" state-@bestiary-path s) 41 | (pp-view "ability-decks" state-@ability-decks s) 42 | (apply hpanel 43 | #:stretch '(#t #f) 44 | (for/list ([key '("L" "C")]) 45 | (input #:label key (@> (state-@env s) {~> (hash-ref key) ~a}) #:enabled? #f))))) 46 | 47 | (module+ main 48 | (command-line 49 | #:args (file) 50 | (define s (call-with-input-file file deserialize-state)) 51 | (render (window #:size '(300 400) (plain-view s))))) 52 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .POSIX: 2 | SHELL = /bin/sh 3 | .SUFFIXES: 4 | 5 | PKG = frosthaven-manager 6 | COLLECT = frosthaven-manager 7 | LANGS = ++lang frosthaven-manager/bestiary \ 8 | ++lang frosthaven-manager/foes \ 9 | ++lang frosthaven-manager/aoe \ 10 | ++lang frosthaven-manager/loot-cards 11 | 12 | EXES = FrosthavenManager.app/Contents/MacOS/FrosthavenManager \ 13 | FrosthavenManager \ 14 | FrosthavenManager.exe 15 | 16 | RACO = raco 17 | 18 | setup: 19 | $(RACO) setup $(RACO_SETUP_ARGS) --pkgs $(PKG) 20 | 21 | install: 22 | $(RACO) pkg install --name $(PKG) --auto $(RACO_INSTALL_ARGS) 23 | 24 | uninstall: 25 | $(RACO) pkg remove $(PKG) 26 | 27 | test: 28 | $(RACO) test $(RACO_TEST_ARGS) --package $(PKG) 29 | 30 | check-deps: 31 | $(RACO) setup $(RACO_SETUP_ARGS) --check-pkg-deps --pkgs $(PKG) 32 | 33 | fix-deps: 34 | $(RACO) setup $(RACO_SETUP_ARGS) --fix-pkg-deps --pkgs $(PKG) 35 | 36 | fix-doc-index: 37 | $(RACO) setup $(RACO_SETUP_ARGS) --doc-index --pkgs $(PKG) 38 | 39 | clean: 40 | $(RACO) setup $(RACO_SETUP_ARGS) --fast-clean --pkgs $(PKG) 41 | 42 | docs/frosthaven-manager/index.html: 43 | scribble +m --redirect-main http://pkg-build.racket-lang.org/doc/ --redirect https://docs.racket-lang.org/local-redirect/index.html --htmls --dest ./docs ./scribblings/frosthaven-manager.scrbl 44 | 45 | $(EXES): gui/manager.rkt 46 | $(RACO) exe --gui -o FrosthavenManager $(LANGS) gui/manager.rkt 47 | 48 | # POSIX leaves $< unspecified in these target rules 49 | macOS-FrosthavenManager: FrosthavenManager.app/Contents/MacOS/FrosthavenManager 50 | $(RACO) distribute $@ FrosthavenManager.app 51 | linux-FrosthavenManager: FrosthavenManager 52 | $(RACO) distribute $@ FrosthavenManager 53 | windows-FrosthavenManager: FrosthavenManager.exe 54 | $(RACO) distribute $@ FrosthavenManager.exe 55 | 56 | linux-FrosthavenManager.tar.gz: linux-FrosthavenManager 57 | tar cvf - linux-FrosthavenManager | gzip >$@ 58 | macOS-FrosthavenManager.tar.gz: macOS-FrosthavenManager 59 | tar cvf - macOS-FrosthavenManager | gzip >$@ 60 | windows-FrosthavenManager.zip: windows-FrosthavenManager 61 | 7z a $@ windows-FrosthavenManager 62 | -------------------------------------------------------------------------------- /scribblings/gui/player-info.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | racket/gui/easy 6 | racket/gui/easy/contract 7 | frosthaven-manager/manager)) 8 | 9 | @title{@tt{gui/player-info}} 10 | @defmodule[frosthaven-manager/gui/player-info] 11 | 12 | @defproc[(player-view 13 | [|@player| (obs/c player?)] 14 | [#:on-condition on-condition (-> (list/c condition? boolean?) any) void] 15 | [#:on-hp on-hp (-> (-> number? number?) any) void] 16 | [#:on-xp on-xp (-> (-> number? number?) any) void] 17 | [#:on-initiative on-initiative (-> number? any) void] 18 | [#:on-update arbitrary-update (-> (-> player? player?) any)] 19 | [#:on-summon add-summon (-> string? positive-integer? any)] 20 | [#:on-summon-hp update-summon-hp (-> natural-number/c (-> number? number?) any)] 21 | [#:on-summon-condition update-summon-condition (-> natural-number/c (list/c condition? boolean?) any)] 22 | [#:kill-summon kill-summon (-> natural-number/c any)]) 23 | (is-a?/c view<%>)]{ 24 | A GUI view of a single player. See @secref{Player_controls}. The callback 25 | @racket[on-condition] is given an condition and value that determines whether 26 | the condition should be applied (@racket[#true]) or removed (@racket[#false]). 27 | The callbacks @racket[on-hp] and @racket[on-xp] are given procedures to modify 28 | @racket[player-current-hp] and @racket[player-xp], respectively. The callback 29 | @racket[on-initiative] is given a new initiative for @racket[player-initiative]. 30 | The number of players is used to format the player's loot appropriately. 31 | 32 | The summon callbacks are given the summon number, a list index, to indicate 33 | which summon to update. Adding a summon is done by name and max HP. 34 | 35 | The @racket[arbitrary-update] callback is invoked with a function that computes 36 | a new @racket[player?]; it is intended to update @racket[|@player|] for more 37 | complicated events that are logically a single step. 38 | } 39 | -------------------------------------------------------------------------------- /gui/font.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [copy-font 6 | (->* ((is-a?/c font%)) 7 | (#:size (real-in 0.0 1024.0) 8 | #:face (or/c string? #f) 9 | #:family (or/c 'default 'decorative 'roman 'script 'swiss 'modern 'symbol 'system) 10 | #:style (or/c 'normal 'italic 'slant) 11 | #:weight font-weight/c 12 | #:underlined? any/c 13 | #:smoothing (or/c 'default 'partly-smoothed 'smoothed 'unsmoothed) 14 | #:size-in-pixels? any/c 15 | #:hinting (or/c 'aligned 'unaligned) 16 | #:feature-settings font-feature-settings/c 17 | #:font-list (or/c (is-a?/c font-list%) #f)) 18 | (is-a?/c font%))] 19 | [big-control-font (is-a?/c font%)])) 20 | 21 | (require racket/gui) 22 | 23 | (define (copy-font f 24 | #:font-list [font-list (current-font-list)] 25 | #:face [face (send f get-face)] 26 | #:family [family (send f get-family)] 27 | #:size-in-pixels? [size-in-pixels? (send f get-size-in-pixels)] 28 | #:size [size (send f get-size size-in-pixels?)] 29 | #:style [style (send f get-style)] 30 | #:weight [weight (send f get-weight)] 31 | #:underlined? [underlined? (send f get-underlined)] 32 | #:smoothing [smoothing (send f get-smoothing)] 33 | #:hinting [hinting (send f get-hinting)] 34 | #:feature-settings [feature-settings (send f get-feature-settings)]) 35 | (make-font #:font-list font-list 36 | #:face face 37 | #:family family 38 | #:size-in-pixels? size-in-pixels? 39 | #:size size 40 | #:style style 41 | #:weight weight 42 | #:underlined? underlined? 43 | #:smoothing smoothing 44 | #:hinting hinting 45 | #:feature-settings feature-settings)) 46 | 47 | (define big-control-font 48 | (copy-font normal-control-font 49 | #:font-list the-font-list 50 | #:size (+ 10 (send normal-control-font get-size)) 51 | #:style 'italic)) 52 | -------------------------------------------------------------------------------- /scribblings/installation.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "common.rkt") 4 | 5 | @(define releases-page "https://github.com/benknoble/frosthaven-manager/releases") 6 | 7 | @title{Installing Frosthaven Manager} 8 | 9 | You can grab the latest version of Frosthaven Manager at the 10 | @link[releases-page]{release page}. Download the release for your operating 11 | system (Windows, Linux, or macOS) and follow the instructions below. 12 | 13 | If you get stuck, refer to @secref{Troubleshooting} for help. 14 | 15 | @margin-note{The following instructions use the terms "directory" and "folder" 16 | interchangeably. They are the same thing, and you can mentally substitute 17 | whichever is more comfortable for you.} 18 | 19 | @section{Windows} 20 | 21 | First, open the downloaded archive in the File Explorer. Double-click the 22 | archive to open it, which should uncompress the archive. You may wish to 23 | uncompress into a directory of your choosing by right-clicking and selecting the 24 | appropriate option. 25 | 26 | Among the uncompressed files you will find the application 27 | @filepath{FrosthavenManager.exe} and @filepath{lib} folder needed by the 28 | program. Click the @filepath{FrosthavenManager.exe} to play. 29 | 30 | @section{Linux} 31 | 32 | Extract the compressed archive via the usual method. For example, the following 33 | command-line should do: 34 | 35 | @terminal|{ 36 | gunzip -c /path/to/linux-FrosthavenManager.tar.gz | tar xvf - 37 | }| 38 | 39 | Inside the uncompressed archive should be an executable program and supporting 40 | libraries. Run the program to play. 41 | 42 | @section{macOS} 43 | 44 | First, open the downloaded archive in Finder. Double-click the archive to open 45 | it, which should uncompress files into a directory named 46 | @filepath{FrosthavenManager}. 47 | 48 | In the @filepath{FrosthavenManager} directory, you will find the application 49 | @filepath{FrosthavenManager.app}, which you can drag to your 50 | @filepath{Applications} folder. 51 | 52 | To open the Frosthaven Manager for the first time, you will need to right-click 53 | the app and select @onscreen{Open}. After agreeing to trust the app by clicking 54 | @onscreen{Open} again, you should see the application open. Next time, click on 55 | the app to launch it as normal! 56 | -------------------------------------------------------------------------------- /scribblings/manager/loot.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | frosthaven-manager/manager 6 | frosthaven-manager/gui/loot)) 7 | 8 | @title{@tt{manager/loot}} 9 | @defmodule[frosthaven-manager/manager/loot] 10 | 11 | This module provides facilities for manipulating the loot deck. 12 | 13 | @defproc[(update-loot-deck-and-num-loot-cards [s state?]) 14 | (-> (list/c (or/c 'add 'remove) loot-type/c) any)]{ 15 | Update the loot deck based on the @racket[loot-picker] event. 16 | } 17 | 18 | @defproc[(build-loot-deck 19 | [type->number-of-cards (hash/c loot-type/c natural-number/c)] 20 | [type->deck (hash/c loot-type/c (listof loot-card?))]) 21 | (listof loot-card?)]{ 22 | Converts two mappings into a shuffled deck of loot cards. This can be considered 23 | the interpreter for a language whose values are like those produced by 24 | @racket[loot-picker]; namely, mappings from decks to number of cards. 25 | 26 | The mapping @racket[type->number-of-cards] maps a loot card type to a number of 27 | loot cards of that type. The mapping @racket[type->deck] specifies which deck 28 | cards of that type should be drawn from. 29 | 30 | This function assumes, but does not check, that for all types @racket[_t] the 31 | number of cards for that type @racket[(hash-ref type->number-of-cards _t)] is 32 | less than or equal to the number of loot cards in that type's deck 33 | @racket[(length (hash-ref type->deck _t))]. 34 | } 35 | 36 | @defproc[(build-loot-deck! [s state?]) any]{ 37 | Updates @racket[s] by applying @racket[build-loot-deck]. 38 | } 39 | 40 | @defproc[((give-player-loot [s state?]) [k any/c]) any]{ 41 | Give player @racket[k] the top loot card. 42 | } 43 | 44 | @defproc[(place-loot-on-bottom [s state?]) any]{ 45 | Rotate the top loot card to the bottom of the deck. 46 | } 47 | 48 | @defproc[(player->rewards [p player?] [num-players num-players/c] [level level/c]) 49 | (listof string?)]{ 50 | Each string is a reward for player @racket[p] except the first, which is the 51 | player's name. The values are an indicator if the player got the random item, 52 | the player's XP, gold, each material amount, each herb amount, and a 53 | comma-separated list of special cards. 54 | } 55 | -------------------------------------------------------------------------------- /gui/render.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require racket/contract 4 | racket/gui/easy) 5 | (provide 6 | (contract-out 7 | [current-renderer (parameter/c (or/c #f renderer?))] 8 | [render/eventspace (->* ((is-a?/c view<%>)) 9 | (#:parent (or/c #f renderer?) 10 | #:eventspace eventspace?) 11 | renderer?)]) 12 | with-closing-custodian/eventspace 13 | closing-custodian closing-eventspace close-custodian-mixin) 14 | 15 | (require (for-syntax racket/base) 16 | racket/gui 17 | racket/stxparam 18 | syntax/parse/define) 19 | 20 | (define current-renderer (make-parameter #f)) 21 | 22 | (define (render/eventspace tree #:parent [parent #f] #:eventspace [es (current-eventspace)]) 23 | (parameterize ([current-eventspace es]) 24 | (define r (render tree parent)) 25 | ;; set current-renderer in handler-thread of es 26 | (queue-callback (thunk (current-renderer r)) 'high-priority) 27 | r)) 28 | 29 | (define-syntax-parser with-closing-custodian/eventspace 30 | [(_ body:expr ...+) 31 | (syntax/loc this-syntax 32 | (let* ([cust (make-custodian)] 33 | [es (parameterize ([current-custodian cust]) (make-eventspace))] 34 | [shutdown-cust (shutdown-on-close cust)]) 35 | (syntax-parameterize ([closing-custodian (make-rename-transformer #'cust)] 36 | [closing-eventspace (make-rename-transformer #'es)] 37 | [close-custodian-mixin (make-rename-transformer #'shutdown-cust)]) 38 | body ...)))]) 39 | 40 | (begin-for-syntax 41 | (define (only-in-with-closing-custodian/eventspace stx) 42 | (raise-syntax-error #f "can only be used inside with-closing-custodian/eventspace" stx))) 43 | (define-syntax-parameter closing-custodian only-in-with-closing-custodian/eventspace) 44 | (define-syntax-parameter closing-eventspace only-in-with-closing-custodian/eventspace) 45 | (define-syntax-parameter close-custodian-mixin only-in-with-closing-custodian/eventspace) 46 | 47 | (define (shutdown-on-close cust) 48 | (mixin (top-level-window<%>) () 49 | (super-new) 50 | (define/augment (on-close) 51 | ;; shutdown the custodian after processing remaining events 52 | (queue-callback (thunk (custodian-shutdown-all cust)))))) 53 | -------------------------------------------------------------------------------- /scribblings/manager/round-prompts.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | frosthaven-manager/manager)) 5 | 6 | @title{@tt{manager/round-prompts}} 7 | @defmodule[frosthaven-manager/manager/round-prompts] 8 | 9 | This module provides facilities for manipulating round prompt values. 10 | 11 | @defform[#:literals (even odd every starting-at) 12 | (prompt [time rule] ...) 13 | #:grammar ([rule m-expr 14 | even 15 | odd 16 | (code:line every n-expr starting-at start-expr)]) 17 | #:contracts ([time time/c] 18 | [m-expr natural-number/c] 19 | [n-expr natural-number/c] 20 | [start-expr natural-number/c])]{ 21 | Notation for describing round prompt values. The result of a @racket[prompt] 22 | expression is a list of @racket[prompt/c] values. 23 | 24 | Each round prompt value is denoted by a @racket[time] and @racket[rule]. 25 | @itemlist[ 26 | @item{A rule consisting of @racket[m-expr] means to prompt at round @racket[m-expr].} 27 | @item{A rule consisting of @racket[even] means to prompt at every even round.} 28 | @item{A rule consisting of @racket[odd] means to prompt at every odd round.} 29 | @item{A rule consisting of @racket[every n-expr starting-at start-expr] means to prompt at every @racket[n-expr]th round, starting at the @racket[start-expr]th round.} 30 | ] 31 | } 32 | 33 | @defproc[(should-do-prompt? [t time/c] [current-round natural-number/c] [prompts (listof prompt/c)]) 34 | any/c]{ 35 | Returns true iff at time @racket[t] and round @racket[current-round] the round 36 | prompt rules in @racket[prompts] determine that a prompt should happen. 37 | } 38 | 39 | @defthing[prompt/c flat-contract?]{ 40 | A serializable round prompt value. A round prompt value expresses rules both for 41 | which round(s) to prompt in and when. 42 | } 43 | 44 | @deftogether[( 45 | @defthing[time/c flat-contract?] 46 | @defthing[beginning-of time/c] 47 | @defthing[end-of time/c] 48 | )]{ 49 | Times for round prompts representing the beginning of the round and the end of 50 | the round. 51 | } 52 | 53 | @defproc[(prompt->string [p prompt/c]) string?]{ 54 | A textual description of a round prompt value meant for human use. 55 | } 56 | -------------------------------------------------------------------------------- /scribblings/syntax/module-reader.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | frosthaven-manager/parsers/monster 5 | frosthaven-manager/parsers/foes 6 | (only-in frosthaven-manager/syntax/module-reader))) 7 | 8 | @title{@tt{syntax/module-reader}} 9 | @defmodule[frosthaven-manager/syntax/module-reader] 10 | 11 | This expander language wraps @racketmodname[syntax/module-reader] by assuming a 12 | specific reading protocol. 13 | 14 | This module does not have a reader of its own, so should be used with 15 | @racket[module] or @(hash-lang) @racketmodname[s-exp]. 16 | 17 | @defform[#:literals (from) 18 | (#%module-begin expander-mod-path 19 | [parser-id from parser-mod-path])]{ 20 | The following example demonstrates the entire grammer of the expander language: 21 | @codeblock|{ 22 | #lang s-exp frosthaven-manager/syntax/module-reader 23 | frosthaven-manager/foes 24 | [parse-foes from frosthaven-manager/parsers/foes] 25 | }| 26 | 27 | Or with @racket[module]: 28 | @codeblock|{ 29 | #lang racket 30 | (module reader frosthaven-manager/syntax/module-reader 31 | frosthaven-manager/foes 32 | [parse-foes from frosthaven-manager/parsers/foes]) 33 | }| 34 | 35 | The semantics are as follows. The resulting module satisfies the language reader 36 | extension protocol from @secref["parse-reader" #:doc '(lib "scribblings/reference/reference.scrbl")] 37 | via @racketmodname[syntax/module-reader] with a few specifications. The 38 | @racket[expander-mod-path] is used as in @racketmodname[syntax/module-reader] to 39 | determine the module-path for the initial bindings of modules produced by the 40 | reader. The @racket[parser-id], which must be provided by 41 | @racket[parser-mod-path], is assumed to parse the whole body as with the 42 | @racket[#:whole-body-readers?] keyword for @racketmodname[syntax/module-reader]. 43 | In addition, it should support the following protocol: the parser accepts 2 44 | positional arguments. The first is the same name-value as @racket[read-syntax]; 45 | the second is the same input port as for @racket[read] and @racket[read-syntax] 46 | with line-counting enabled. Then it must accept a keyword option 47 | @racket[#:syntax?], whose value is a boolean indicating whether or not to 48 | produce a syntax object. 49 | 50 | Examples of valid parsers include @racket[parse-foes] and 51 | @racket[parse-bestiary]. 52 | } 53 | -------------------------------------------------------------------------------- /scribblings/gui/static-table.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket/gui 4 | racket/gui/easy 5 | racket/gui/easy/contract)) 6 | 7 | @title{@tt{gui/static-table}} 8 | @defmodule[frosthaven-manager/gui/static-table] 9 | 10 | @defproc[(static-table 11 | [columns (listof label-string?)] 12 | [num-rows natural-number/c] 13 | [entry->columns (listof (-> any/c any/c))] 14 | [#:index->entry index->entry (-> natural-number/c natural-number/c) values] 15 | [#:entry->value entry->value (-> natural-number/c any/c) values] 16 | [#:selection |@selection| (maybe-obs/c 17 | (or/c #f 18 | exact-nonnegative-integer? 19 | (listof exact-nonnegative-integer?))) 20 | #f] 21 | [#:widths widths 22 | (maybe-obs/c 23 | (or/c #f 24 | (listof 25 | (or/c (list/c exact-nonnegative-integer? 26 | dimension-integer?) 27 | (list/c exact-nonnegative-integer? 28 | dimension-integer? 29 | dimension-integer? 30 | dimension-integer?))))) 31 | #f]) 32 | (is-a?/c view<%>)]{ 33 | A GUI view for static tables. The columns are labelled by @racket[columns], and 34 | there are exactly @racket[num-rows] rows. Each row is indexed by a natural 35 | number @racket[i] from @racket[0] to @racket[(sub1 num-rows)]; 36 | @racket[(entry->value (index->entry i))] computes a value @racket[v] on which 37 | the functions in @racket[entry->columns] are called to compute the values of the 38 | columns for that row. Each row is labelled with the entry @racket[(index->entry i)]. 39 | 40 | Summarizing: each row is indexed by a natural number in the range 41 | [0,@racket[num-rows]). An entry is computed by @racket[index->entry]. A value is 42 | computed from the entry by @racket[entry->value]. From this value, functions in 43 | @racket[entry->columns] compute the elements of the row. 44 | 45 | The selection is determined by @racket[|@selection|] as with @racket[table]. 46 | 47 | The column widths are calculated automatically based on @racket[columns], or are 48 | provided as @racket[widths]. 49 | } 50 | -------------------------------------------------------------------------------- /scribblings/rich-text-helpers.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | frosthaven-manager/rich-text-helpers) 5 | scribble/example) 6 | 7 | @(define my-eval 8 | (make-base-eval '(require frosthaven-manager/rich-text-helpers))) 9 | @(define-syntax-rule (submod-link mod sub ...) 10 | @racketmodlink[(submod mod sub ...)]{@racket[(submod mod sub ...)]}) 11 | 12 | @title{@tt{rich-text-helpers}} 13 | @defmodule[frosthaven-manager/rich-text-helpers] 14 | 15 | This module provides helpers for converting values to the rich text model of 16 | @submod-link[frosthaven-manager/gui/rich-text-display model]. In particular, 17 | these helpers work with functions that take single values to lists which are 18 | intended to be spliced into the resulting model list. 19 | 20 | @defproc[(only-on-text [f (-> any/c ... list?)] [arg any/c] ...) 21 | (-> any/c list?)]{ 22 | Returns a function over @racket[_x] that returns @racket[(f arg ... _x)] when 23 | @racket[_x] is a string, or @racket[(list _x)] otherwise. Particularly useful 24 | with @racket[append-map] over a model value and a function @racket[f] that can 25 | only handle strings. 26 | } 27 | 28 | @defform[(match-loop input-expr 29 | [match-pattern body-expr ... result-expr] ...) 30 | #:contracts ([result-expr list?])]{ 31 | Iterates like a fixed-point computation. First, match @racket[input-expr] 32 | against the @racket[match-pattern] and evalute the body and result expressions, 33 | like @racket[match]. If there is no match, the return @racket[(list input-expr)]. 34 | If there is a match, @racket[append-map] the same @racket[match-loop] 35 | computation over each of the elements of the result. 36 | 37 | @examples[#:eval my-eval 38 | (define (f x) 39 | (match-loop x 40 | [(regexp #rx"^(.*)body(.*)$" (list _ prefix suffix)) 41 | (list prefix 42 suffix)])) 42 | (f "begin; body 1; body 2; body 3; end") 43 | ] 44 | 45 | A major difference from something like @racket[regexp-replace*] or 46 | @racket[regexp-replaces] is that the inputs and replacements can be arbitrary 47 | values; this codifies the "replace all" loop. Many uses include the same kind of 48 | prefix/suffix matching seen in the example above, but the algorithm is more 49 | general and can find newly generated matches in @racket[result-expr]. Take care 50 | to avoid generating an infinite loop by unconditionally placing a new match in 51 | the result. 52 | } 53 | 54 | @(close-eval my-eval) 55 | -------------------------------------------------------------------------------- /gui/mixins.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; cf. https://github.com/Bogdanp/racket-gui-easy/issues/13#issuecomment-1093700596 4 | ;; cf. https://github.com/Bogdanp/racket-gui-easy/issues/13#issuecomment-1093153178 5 | 6 | (provide make-closing-proc-mixin 7 | make-on-close-mixin 8 | define-close! 9 | hide-caret/selection) 10 | 11 | (require syntax/parse/define 12 | (only-in racket/gui/base top-level-window<%>)) 13 | 14 | ;; Dialogs need to be closed, but rendering a dialog yields so there's 15 | ;; no way to retrieve a dialog's renderer from within itself. This 16 | ;; may be another argument for gui-easy providing a managed 17 | ;; `current-renderer'. In the mean time, we can abuse mixins for this 18 | ;; purpose. 19 | 20 | ;; calls `out` with `close-proc`, which closes the window when invoked 21 | (define (make-closing-proc-mixin out) 22 | (mixin (top-level-window<%>) (top-level-window<%>) (super-new) 23 | (out (λ () 24 | (when (send this can-close?) 25 | (send this on-close) 26 | (send this show #f)))))) 27 | 28 | ;; calls `proc` when the window closes 29 | (define (make-on-close-mixin proc) 30 | (mixin (top-level-window<%>) (top-level-window<%>) (super-new) 31 | (define/augment (on-close) 32 | (proc)))) 33 | 34 | (define-syntax-parser define-close! 35 | [(_ close!:id set-close-mixin:id) 36 | (syntax/loc this-syntax 37 | (begin 38 | (define close!- (box #f)) 39 | (define (set-close!- close) (set-box! close!- close)) 40 | (define set-close-mixin (make-closing-proc-mixin set-close!-)) 41 | ;; On η-expansion of close!: close! can be #f until it is set, so 42 | ;; expand the call to close! (by the time it is called it should 43 | ;; have the correct value, a procedure). 44 | (define-syntax close! (-close! #'close!-))))]) 45 | 46 | (define-for-syntax (-close! close!-id) 47 | (syntax-parser 48 | [_:id (quasisyntax/loc this-syntax 49 | (λ () ((unbox #,close!-id))))] 50 | [(_) (quasisyntax/loc this-syntax 51 | ((unbox #,close!-id)))])) 52 | 53 | (define (hide-caret/selection %) 54 | ;; not using mixin: after-set-position is a method of text% that is not 55 | ;; exposed by any interface that text% implements 56 | (class % (super-new) 57 | (send this hide-caret #t) 58 | (define/augment (after-set-position) 59 | (send this hide-caret (= (send this get-start-position) 60 | (send this get-end-position))) 61 | (inner (void) after-set-position)))) 62 | -------------------------------------------------------------------------------- /testfiles/data.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide make-sample-state 4 | make-sample-loot-deck 5 | jack 6 | frigg 7 | archers 8 | boss 9 | more-monsters) 10 | 11 | (require frosthaven-manager/defns 12 | frosthaven-manager/monster-db 13 | frosthaven-manager/observable-operator 14 | racket/runtime-path 15 | syntax/parse/define) 16 | 17 | ;; (submod manager/loot test) uses this module; break the cycle 18 | (define-syntax-parser define-manager-values 19 | [(_ (name:id ...)) 20 | (syntax/loc this-syntax 21 | (define-values (name ...) 22 | (values (dynamic-require 'frosthaven-manager/manager 'name) ...)))]) 23 | 24 | (define-manager-values 25 | (make-state 26 | init-dbs 27 | state-@num-players 28 | state-@creatures 29 | creature 30 | add-or-remove-monster-group 31 | update-loot-deck-and-num-loot-cards 32 | build-loot-deck!)) 33 | 34 | (define-runtime-path more-monsters "sample-bestiary-import.rkt") 35 | 36 | (define-values (info _abilities) (get-dbs more-monsters)) 37 | 38 | (define mg 39 | (make-monster-group (~> (info) (hash-ref "archer") (hash-ref "hynox archer")) 40 | 0 41 | '([1 . #t] [2 . #f] [3 . #t]) 42 | (hash "C" 2 "L" 0))) 43 | 44 | (define boss-mg 45 | (make-monster-group (~> (info) (hash-ref "boss") (hash-ref "giant squid")) 46 | 0 47 | '([1 . #f]) 48 | (hash "C" 2 "L" 0))) 49 | 50 | (define (make-sample-state) 51 | (define sample-state (make-state)) 52 | (void 53 | (init-dbs more-monsters sample-state) 54 | (:= (state-@num-players sample-state) 2) 55 | (:= (state-@creatures sample-state) 56 | (list (creature 0 (~> ((make-player "Jack Skellington" 8)) 57 | (player-summon "Corpse Bro" 4))) 58 | (creature 1 (~> ((player "Frigg" 12 10 3 (list muddle ward) 67 empty empty)) 59 | (player-summon "Banner of Courage" 7))))) 60 | ((add-or-remove-monster-group sample-state) `(add ,mg)) 61 | ((add-or-remove-monster-group sample-state) `(add ,boss-mg))) 62 | sample-state) 63 | 64 | (define jack 0) 65 | (define frigg 1) 66 | (define archers 2) 67 | (define boss 3) 68 | 69 | (define (make-sample-loot-deck s) 70 | (void 71 | (for ([type (append (list 'money) 72 | (hash-keys material-decks) 73 | (hash-keys herb-decks))]) 74 | ((update-loot-deck-and-num-loot-cards s) `(add ,type))) 75 | (build-loot-deck! s))) 76 | -------------------------------------------------------------------------------- /enum-helpers.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | define-serializable-enum-type) 5 | 6 | (require (for-syntax racket/syntax) 7 | frosthaven-manager/curlique 8 | racket/serialize 9 | rebellion/collection/keyset 10 | rebellion/type/enum 11 | syntax/parse/define) 12 | 13 | (module+ test (require rackunit)) 14 | 15 | (define-syntax-parser define-serializable-enum-type 16 | [(_ type:id 17 | (constant:id ...) 18 | {~alt 19 | {~optional {~and #:omit-root-binding omit-root-binding-kw}} 20 | {~optional {~seq #:descriptor-name descriptor:id}} 21 | {~optional {~seq #:predicate-name predicate:id}} 22 | {~optional {~seq #:discriminator-name discriminator:id}} 23 | {~optional {~seq #:selector-name selector:id}} 24 | {~optional {~seq #:inspector inspector:expr}} 25 | {~optional {~seq #:property-maker prop-maker:expr}}} ...) 26 | #:with deserialize-info (format-id #'type "deserialize-info:~a" #'type #:source #'type) 27 | #:with default-selector (format-id #'type "selector:~a" #'type) 28 | (syntax/loc this-syntax 29 | (begin 30 | (define-enum-type type 31 | (constant ...) 32 | {~? omit-root-binding-kw} 33 | {~? {~@ #:descriptor-name descriptor}} 34 | {~? {~@ #:predicate-name predicate}} 35 | {~? {~@ #:discriminator-name discriminator}} 36 | {~? {~@ #:selector-name selector}} 37 | {~? {~@ #:inspector inspector}} 38 | #:property-maker (compose-property-makers 39 | {~? prop-maker default-enum-properties} 40 | (serializable-property-maker #'deserialize-info))) 41 | (provide deserialize-info) 42 | (define deserialize-info 43 | (make-deserialize-info 44 | {~? selector default-selector} 45 | (thunk (error 'type "cycles not supported"))))))]) 46 | 47 | (module+ test 48 | (require racket/serialize) 49 | (define-serializable-enum-type slangs (j apl forth)) 50 | (define-simple-check (check-serializes x) 51 | (equal? x (deserialize (serialize x)))) 52 | (test-case "serializable enums" 53 | (check-serializes j "j") 54 | (check-serializes apl "apl") 55 | (check-serializes forth "forth"))) 56 | 57 | (define ((serializable-property-maker deserialize-info-binding) desc) 58 | (define discrim (enum-descriptor-discriminator desc)) 59 | (list (cons prop:serializable 60 | (make-serialize-info 61 | (λ (x) (vector (discrim x))) 62 | deserialize-info-binding 63 | #f 64 | (or (current-load-relative-directory) (current-directory)))))) 65 | 66 | (define ((compose-property-makers . ps) desc) 67 | (append-map (λ (p) (p desc)) ps)) 68 | -------------------------------------------------------------------------------- /static/style.css: -------------------------------------------------------------------------------- 1 | /* DEFAULT: Extra small devices (phones) */ 2 | /* @media only screen and (max-width: 600px) { */ 3 | /* } */ 4 | 5 | :root { 6 | color-scheme: light dark; 7 | } 8 | 9 | details.stats-summary { 10 | margin-left: 1%; 11 | display: inline; 12 | } 13 | 14 | details.stats-summary[open] { 15 | display: block; 16 | } 17 | 18 | ol.monster-ability-abilities { 19 | list-style-type: none; 20 | } 21 | 22 | .icon { 23 | padding: 0.3em; 24 | } 25 | 26 | /* Rewards style */ 27 | .table-wrapper table { 28 | width: 100%; 29 | border: 1px solid; 30 | border-collapse: collapse; 31 | } 32 | .table-wrapper th, 33 | .table-wrapper td { 34 | border: 1px solid; 35 | padding: 0.5em; 36 | } 37 | .table-wrapper tbody tr:hover { 38 | background-color: #8be9fd; 39 | } 40 | .table-wrapper { 41 | width: 100%; 42 | overflow-x: auto; 43 | } 44 | 45 | button { 46 | margin: 2px 5px; 47 | } 48 | 49 | #elements { 50 | position: sticky; 51 | top: 0; 52 | background-color: white; 53 | border-width: 2px; 54 | border-style: solid; 55 | border-color: lightgrey; 56 | padding: 8px; 57 | } 58 | 59 | .bottom-info { 60 | position: sticky; 61 | bottom: 0; 62 | background-color: white; 63 | border-width: 1px; 64 | border-style: solid; 65 | border-color: lightgrey; 66 | padding: 4px; 67 | font-size: 65%; 68 | } 69 | 70 | /* Small devices (portrait tablets and large phones) */ 71 | @media only screen and (min-width: 600px) { 72 | 73 | /* https://stackoverflow.com/q/2710764 */ 74 | html { 75 | /* Prevent iPhone font scaling in landscape */ 76 | -webkit-text-size-adjust: 100%; 77 | } 78 | 79 | details.stats-summary[open] { 80 | display: inline; 81 | } 82 | 83 | .smash-inline * { 84 | display: inline-block; 85 | } 86 | 87 | } 88 | 89 | /* Medium devices (landscape tablets) */ 90 | @media only screen and (min-width: 768px) { 91 | } 92 | 93 | /* Large devices (laptops/desktops) */ 94 | @media only screen and (min-width: 992px) { 95 | } 96 | 97 | /* Extra large devices (large laptops and desktops) */ 98 | @media only screen and (min-width: 1200px) { 99 | } 100 | 101 | @media (prefers-color-scheme: dark) { 102 | body { 103 | background: #282a36; 104 | color: #f8f8f2; 105 | } 106 | a, button, select { 107 | color: #8be9fd; 108 | } 109 | a:visited { 110 | color: #ff79c6; 111 | } 112 | .table-wrapper tbody tr:hover { 113 | color: #282a36; 114 | } 115 | #elements { 116 | background-color: #282a36; 117 | border-color: #6272a4; 118 | } 119 | .bottom-info { 120 | background-color: #282a36; 121 | border-color: #6272a4; 122 | } 123 | } 124 | 125 | .bottom-info button { 126 | font-size: 120%; 127 | } 128 | -------------------------------------------------------------------------------- /scribblings/aoe-images.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket 4 | pict 5 | frosthaven-manager/aoe-images)) 6 | 7 | @title{@tt{aoe-images}} 8 | @defmodule[frosthaven-manager/aoe-images] 9 | 10 | This module provides procedures for constructing area-of-effect diagrams. 11 | 12 | @defparam[hex-size size natural-number/c #:value 30]{ 13 | The size of the hexes built from this module. 14 | } 15 | 16 | @defproc[(r) (and/c positive? number?)]{ 17 | Returns the amount by which odd rows need shifted to align with even rows in a 18 | hex-grid (based on @racket[hex-size]). 19 | } 20 | 21 | @deftogether[( 22 | @defproc[(S) pict?] 23 | @defproc[(X) pict?] 24 | @defproc[(O) pict?] 25 | @defproc[(M) pict?] 26 | )]{ 27 | Hexes for an area-of-effect diagram: respectively, spacers, attacks, allies, and 28 | the initiating figure. 29 | } 30 | 31 | @defproc[(border-size [max-row natural-number/c] [max-col natural-number/c]) 32 | (and/c positive? number?)]{ 33 | Returns the side-length of a square rectangle which would encompass an 34 | area-of-effect diagram of @racket[max-row] rows and @racket[max-col] columns in 35 | a hex-grid, if the diagram were centered and superimposed on the rectangle à la 36 | @racket[cc-superimpose]. 37 | } 38 | 39 | @deftogether[( 40 | @defthing[spec-sym? flat-contract? #:value (or/c 's 'x 'o 'm 'g)] 41 | @defthing[spec? 42 | flat-contract? 43 | #:value 44 | (listof (list/c exact-positive-integer? 45 | boolean? 46 | (listof (list/c spec-sym? natural-number/c))))] 47 | @defproc[(spec->shape [s spec?]) pict?] 48 | )]{ 49 | Convert an AoE spec to a shape. The spec contains a list of rows; each row 50 | contains a line number, a flag indicating this line should be offset relative 51 | to the lines above and below it (which are not necessarily in the spec), and a 52 | list of column specifiers, pairing symbols with columns in sorted order. 53 | 54 | The symbols represent the corresponding shapes, with @racket['g] a 55 | @racket[ghost] hex. 56 | } 57 | 58 | @deftogether[( 59 | @defthing[syntaxes-can-be-spec? predicate/c] 60 | @defproc[(syntaxes->spec [stxs (and/c (listof syntax?) syntaxes-can-be-spec?)]) 61 | spec?] 62 | )]{ 63 | Convert a list of syntax objects to a @racket[spec?]. 64 | } 65 | 66 | @defproc[(string->spec [s string?]) spec?]{ 67 | Uses @racket[syntaxes->spec] on syntax read from @racket[s] by 68 | @racket[read-syntax] to produce an AoE spec. Fails if the resulting syntaxes 69 | cannot be a spec, as defined by @racket[syntaxes-can-be-spec?]. 70 | } 71 | -------------------------------------------------------------------------------- /scribblings/gui/rich-text-display.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket/gui newline) 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | (only-in pict pict?) 7 | frosthaven-manager/gui/rich-text-display)) 8 | 9 | @title{@tt{gui/rich-text-display}} 10 | @defmodule[frosthaven-manager/gui/rich-text-display] 11 | 12 | This module provides a view-based rich text display, suitable for certain 13 | replacements of @racket[text]. 14 | 15 | @defproc[(rich-text-display 16 | [|@|content (maybe-obs/c (listof (or/c string? 17 | pict? 18 | pict/alt-text? 19 | newline?)))] 20 | [#:font |@|font (maybe-obs/c (is-a?/c font%)) normal-control-font] 21 | [#:min-size |@|min-size (maybe-obs/c size/c) '(#f #f)] 22 | [#:stretch |@|stretch (maybe-obs/c stretch/c) '(#t #t)] 23 | [#:margin |@|margin (maybe-obs/c margin/c) '(0 0)] 24 | [#:inset |@|inset (maybe-obs/c margin/c) '(5 5)] 25 | [#:style style (listof (one-of/c 'no-border 'control-border 'combo 26 | 'no-hscroll 'no-vscroll 27 | 'hide-hscroll 'hide-vscroll 28 | 'auto-vscroll 'auto-hscroll 29 | 'resize-corner 'deleted 'transparent)) 30 | '(no-hscroll)]) 31 | (is-a?/c view<%>)]{ 32 | Displays @racket[|@|content] via a @racket[text%]. Keyword arguments except 33 | @racket[|@|font] control the @racket[text%]. The @racket[|@|font] controls the 34 | font at which text is displayed and to which pictures are scaled. 35 | 36 | Contents are selectable and copyable with the usual keyboard shortcuts, and can 37 | also be selected with mouse. Contents are automatically reflowed. 38 | } 39 | 40 | @section{Rich Text Model} 41 | @defmodule[(submod frosthaven-manager/gui/rich-text-display model)] 42 | 43 | @defthing[newline newline?]{ 44 | When used with @racket[rich-text-display], forces a hard newline. 45 | } 46 | 47 | @defstruct*[pict/alt-text ([p pict?] [alt-text string?])]{ 48 | When used with @racket[rich-text-display], displays a @racket[pict?]. Copying 49 | the pict copies the @racket[alt-text] instead. 50 | } 51 | 52 | @defproc[(newline? [x any/c]) boolean?]{ 53 | A predicate that recognizes the @racket[newline] value. 54 | } 55 | 56 | @defproc[(scale-icon [p pict?]) pict?]{ 57 | Produces a scaled pict suitable for an icon size. Note that this does not take a 58 | font object for scaling, so the size may not be correct when providing fonts to 59 | @racket[rich-text-display]. 60 | } 61 | -------------------------------------------------------------------------------- /testfiles/archers.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/bestiary 2 | 3 | begin-monster "hynox archer" 4 | [0 normal [HP 2] [Move 2] [Attack 2] ] 5 | [0 elite [HP 4] [Move 2] [Attack 3] [Bonuses {"shield 1"}] [Effects {"wound"}] ] 6 | [1 normal [HP 3] [Move 3] [Attack 3] [Effects {"wound"}] ] 7 | [1 elite [HP 5] [Move 3] [Attack 4] [Bonuses {"shield 1"}] [Effects {"wound"}] ] 8 | [2 normal [HP 4] [Move 4] [Attack 4] [Effects {"wound"}] ] 9 | [2 elite [HP 6] [Move 4] [Attack 5] [Bonuses {"shield 1"}] [Effects {"wound" "stun"}] ] 10 | [3 normal [HP 5] [Move 5] [Attack 5] [Effects {"wound" "muddle"}] ] 11 | [3 elite [HP 7] [Move 5] [Attack 6] [Bonuses {"shield 2"}] [Effects {"wound" "stun"}] ] 12 | [4 normal [HP 6] [Move 6] [Attack 6] ] 13 | [4 elite [HP 8] [Move 6] [Attack 7] [Bonuses {"shield 2"}] ] 14 | [5 normal [HP 7] [Move 7] [Attack 7] ] 15 | [5 elite [HP 9] [Move 7] [Attack 8] [Bonuses {"shield 2"}] ] 16 | [6 normal [HP 8] [Move 8] [Attack 8] ] 17 | [6 elite [HP 10] [Move 8] [Attack 9] [Bonuses {"shield 3"}] ] 18 | [7 normal [HP 9] [Move 9] [Attack 9] ] 19 | [7 elite [HP 11] [Move 9] [Attack 10] [Bonuses {"shield 3"}] ] 20 | end-monster 21 | 22 | begin-monster "wyrmling archer" 23 | [0 normal [HP 1] [Move 1] [Attack 1] ] 24 | [0 elite [HP 3] [Move 1] [Attack 2] [Bonuses {"shield 1"}] ] 25 | [1 normal [HP 2] [Move 2] [Attack 2] ] 26 | [1 elite [HP 4] [Move 2] [Attack 3] [Bonuses {"shield 1"}] ] 27 | [2 normal [HP 3] [Move 3] [Attack 3] ] 28 | [2 elite [HP 5] [Move 3] [Attack 4] [Bonuses {"shield 1"}] ] 29 | [3 normal [HP 4] [Move 4] [Attack 4] ] 30 | [3 elite [HP 6] [Move 4] [Attack 5] [Bonuses {"shield 2"}] ] 31 | [4 normal [HP 5] [Move 5] [Attack 5] ] 32 | [4 elite [HP 7] [Move 5] [Attack 6] [Bonuses {"shield 2"}] ] 33 | [5 normal [HP 6] [Move 6] [Attack 6] ] 34 | [5 elite [HP 8] [Move 6] [Attack 7] [Bonuses {"shield 2"}] ] 35 | [6 normal [HP 7] [Move 7] [Attack 7] ] 36 | [6 elite [HP 9] [Move 7] [Attack 8] [Bonuses {"shield 3"}] ] 37 | [7 normal [HP 8] [Move 8] [Attack 8] ] 38 | [7 elite [HP 10] [Move 8] [Attack 9] [Bonuses {"shield 3"}] ] 39 | end-monster 40 | 41 | begin-ability-deck "archer" 42 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 43 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 44 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 45 | ["explosive" 60 {"attack -1, range 3, aoe(aoes/ring1.rkt)"}] 46 | ["explosive" 60 {"attack -1, range 3, aoe(aoes/ring1.rkt)"}] 47 | ["explosive" 60 {"attack -1, range 3, aoe(aoes/ring1.rkt)"}] 48 | ["curved shot" 70 {"attack -1, aoe(aoes/drag-down.rkt)"}] 49 | ["take aim" 80 shuffle {"move +2" "strengthen self"}] 50 | end-ability-deck 51 | -------------------------------------------------------------------------------- /scribblings/gui/loot.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | racket/gui/easy 6 | racket/gui/easy/contract 7 | frosthaven-manager/gui/loot 8 | frosthaven-manager/manager/loot)) 9 | 10 | @title{@tt{gui/loot}} 11 | @defmodule[frosthaven-manager/gui/loot] 12 | 13 | @defproc[(loot-picker 14 | [|@|type->cards (obs/c (hash/c loot-type/c natural-number/c))] 15 | [|@|type->deck (obs/c (hash/c loot-type/c (listof loot-card?)))] 16 | [#:on-card on-card (-> (list/c (or/c 'add 'remove) loot-type/c) any) void] 17 | [#:on-deck on-deck (-> (hash/c loot-type/c (listof loot-card?)) any) void]) 18 | (is-a?/c view<%>)]{ 19 | A GUI view to build a loot deck by including certain loot cards. The callback 20 | @racket[on-card] is invoked with an "event" that specifies a type of cards from 21 | which one card should be added or removed. The callback @racket[on-deck] is 22 | invoked with a mapping from loot types to decks that should be used to interpret 23 | what decks to draw cards from. See @racket[build-loot-deck]. 24 | 25 | This picker allows loading new decks of loot cards and stickering cards on the 26 | fly with @onscreen{+ 1} stickers. It does not allow removing such stickers; 27 | reset the deck to start over. 28 | } 29 | 30 | @defproc[(loot-button 31 | [|@loot-deck| (obs/c (listof loot-card?))] 32 | [|@num-loot-cards| (obs/c natural-number/c)] 33 | [|@num-players| (obs/c num-players/c)] 34 | [|@players| (obs/c (listof (cons/c player? any/c)))] 35 | [#:on-player on-player (-> any/c any) void] 36 | [#:on-top on-top (-> any) void] 37 | [#:on-bottom on-bottom (-> any) void]) 38 | (is-a?/c view<%>)]{ 39 | A GUI view of a button that, when clicked, shows a view to assign the top loot 40 | card from @racket[|@loot-deck|] to one of @racket[|@players|] via buttons. The 41 | callback @racket[on-player] is invoked with the ID (@racket[cdr]) of the player 42 | from @racket[|@players|] whose button is clicked to assign loot; it can be used 43 | to, @italic{e.g.}, assign the loot card. After @racket[on-player] is invoked, 44 | the view is closed. 45 | 46 | Additionally, buttons for the top and bottom of the deck trigger the 47 | @racket[on-top] and @racket[on-bottom] callbacks, which then also close the 48 | view. 49 | 50 | See @secref{Scenario_information_and_loot} for how @racket[loot-button] 51 | functions in Frosthaven Manager. 52 | } 53 | 54 | @defproc[(loot-preview [|@loot-deck| (obs/c (listof loot-card?))] 55 | [|@num-players| (obs/c num-players/c)]) 56 | (is-a?/c view<%>)]{ 57 | A button that, when clicked, shows a loot deck previewer. 58 | } 59 | -------------------------------------------------------------------------------- /gui/static-table.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [static-table (->* ((listof label-string?) 6 | natural-number/c 7 | (listof (-> any/c any/c))) 8 | (#:selection (maybe-obs/c 9 | (or/c #f 10 | exact-nonnegative-integer? 11 | (listof exact-nonnegative-integer?))) 12 | #:widths (maybe-obs/c 13 | (or/c #f 14 | (listof 15 | (or/c (list/c exact-nonnegative-integer? 16 | dimension-integer?) 17 | (list/c exact-nonnegative-integer? 18 | dimension-integer? 19 | dimension-integer? 20 | dimension-integer?))))) 21 | #:index->entry (-> natural-number/c natural-number/c) 22 | #:entry->value (-> natural-number/c any/c)) 23 | (is-a?/c view<%>))])) 24 | 25 | (require frosthaven-manager/curlique 26 | racket/gui/easy 27 | racket/gui/easy/contract 28 | (only-in racket/gui label-string? dimension-integer?)) 29 | 30 | ;; index->entry computes the "row index", which is always the first column 31 | ;; entry->value computes the value that each function in entry->columns will be 32 | ;; given; the result of each function is stringified by ~a. 33 | (define (static-table columns 34 | num-rows 35 | entry->columns 36 | #:selection [selection #f] 37 | #:widths [widths #f] 38 | #:index->entry [index->entry values] 39 | #:entry->value [entry->value values]) 40 | (define column-widths (or widths 41 | (for/list ([(e i) (in-indexed columns)]) 42 | (list i (* 10 (string-length e)))))) 43 | (define (make-row i) 44 | (define v (entry->value i)) 45 | (for/vector #:length (add1 (length entry->columns)) ([f (in-list (cons (const i) entry->columns))]) 46 | (~a (f v)))) 47 | (table 48 | columns 49 | (for/vector #:length num-rows ([i (in-range num-rows)]) 50 | (index->entry i)) 51 | #:selection selection 52 | #:min-size (list (~> (column-widths) (sep second) (+ 40)) 53 | (* 30 num-rows)) 54 | #:column-widths column-widths 55 | #:stretch '(#f #f) 56 | #:entry->row make-row)) 57 | 58 | (module+ main 59 | ;; level-table uses static-table 60 | ;; dynamic-require breaks the cycle 61 | (dynamic-require '(submod frosthaven-manager/gui/level-info main) #f)) 62 | -------------------------------------------------------------------------------- /static/events.js: -------------------------------------------------------------------------------- 1 | const evtSource = new EventSource("events"); 2 | 3 | evtSource.addEventListener("element", (event) => { 4 | const {name, state} = JSON.parse(event.data); 5 | const element = document.getElementById(name); 6 | element.src = `/element-pics/${name}/${state}`; 7 | }); 8 | 9 | evtSource.addEventListener('player', (event) => { 10 | const {id, data, summons, xexpr} = JSON.parse(event.data); 11 | if (document.querySelector(`#${id}`) !== null) { 12 | for (const css_class in data) { 13 | const element = document.querySelector(`#${id} .${css_class}`); 14 | const d = data[css_class]; 15 | const typ = typeof d; 16 | if (typ === 'string') { 17 | element.innerHTML = d; 18 | } else if (typ === 'object') { 19 | for (const attr in d) { 20 | element[attr] = d[attr]; 21 | } 22 | } 23 | } 24 | summons_element = document.querySelector(`#${id} ol.summons`); 25 | summons_element.innerHTML = summons.join(''); 26 | } else { 27 | const players = document.querySelector('ul.creatures'); 28 | players.insertAdjacentHTML('afterbegin', xexpr); 29 | } 30 | }); 31 | 32 | evtSource.addEventListener('monster-group', (event) => { 33 | const {id, data, xexpr} = JSON.parse(event.data); 34 | if (document.querySelector(`#${id}`) !== null) { 35 | for (const css_class in data) { 36 | const element = document.querySelector(`#${id} .${css_class}`); 37 | const d = data[css_class]; 38 | const typ = typeof d; 39 | if (typ === 'string') { 40 | element.innerHTML = d; 41 | } else if (typ === 'object' && Array.isArray(d)) { 42 | element.innerHTML = d.join(''); 43 | } 44 | } 45 | } else { 46 | const monsters = document.querySelector('ul.creatures'); 47 | monsters.insertAdjacentHTML('beforeend', xexpr); 48 | } 49 | }); 50 | 51 | evtSource.addEventListener('reorder-ids', (event) => { 52 | const ids = JSON.parse(event.data); 53 | const creatures = document.querySelector('ul.creatures'); 54 | let newCreatures = []; 55 | for (const id of ids) { 56 | newCreatures.push(document.querySelector(`#${id}`)); 57 | } 58 | creatures.innerHTML = ''; 59 | for (const c of newCreatures) { 60 | creatures.appendChild(c); 61 | } 62 | }); 63 | 64 | evtSource.addEventListener('number', (event) => { 65 | const {id, n} = JSON.parse(event.data); 66 | document.querySelector(`#${id}`).innerHTML = n; 67 | }); 68 | 69 | evtSource.addEventListener('text', (event) => { 70 | const {id, text} = JSON.parse(event.data); 71 | document.querySelector(`#${id}`).innerHTML = text; 72 | }); 73 | 74 | evtSource.addEventListener('alert', (event) => { 75 | const text = JSON.parse(event.data); 76 | showDialog(text); 77 | }); 78 | 79 | let dialog; 80 | function showDialog(text) { 81 | if (!dialog) { 82 | dialog = document.getElementById('dialog'); 83 | if (!dialog) return; 84 | } 85 | dialog.innerHTML = text; 86 | dialog.showModal(); 87 | setTimeout(function () { 88 | dialog.close(); 89 | }, 5000); 90 | } 91 | -------------------------------------------------------------------------------- /parsers/formula.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | ; vim: lw-=do 3 | 4 | (provide 5 | (contract-out 6 | [env/c flat-contract?] 7 | [expr/pc contract?] 8 | [expr/p (parser/c char? expr/pc)] 9 | [parse-expr (-> string? expr/pc)])) 10 | 11 | (require frosthaven-manager/parsers/base) 12 | 13 | (module+ test (require rackunit)) 14 | 15 | #| formulas syntax 16 | 17 | ::= product ([+-] product)* 18 | ::= term ([*/] term)* 19 | ::= "up(" ") | "down(" ")" | "(" ")" | | 20 | ::= "L" | "C" |# 21 | 22 | (define env/c (hash/c (or/c "L" "C") number? #:flat? #t)) 23 | (define expr/pc (-> env/c number?)) 24 | 25 | (define var/p 26 | (do [var <- (or/p (string/p "L") (string/p "C"))] 27 | (pure (λ (env) (hash-ref env var))))) 28 | 29 | (define num/p 30 | (do [num <- number/p] 31 | (pure (const num)))) 32 | 33 | (define bracketed-expr/p 34 | (fmap second 35 | (list/p (char/p #\() (delay/p expr/p) (char/p #\)) 36 | #:sep skip-ws))) 37 | 38 | (define up/p 39 | (do (string/p "up(") 40 | [e <- expr/p] 41 | (string/p ")") 42 | (pure (λ (env) (exact-ceiling (e env)))))) 43 | 44 | (define down/p 45 | (do (string/p "down(") 46 | [e <- expr/p] 47 | (string/p ")") 48 | (pure (λ (env) (exact-floor (e env)))))) 49 | 50 | (define term/p 51 | (or/p var/p num/p up/p down/p bracketed-expr/p)) 52 | 53 | (define product/p 54 | (do [p <- term/p] skip-ws 55 | [ps <- (many/p (list/p (or/p (string/p "*") (string/p "/")) term/p #:sep skip-ws) #:sep skip-ws)] skip-ws 56 | (pure 57 | (for/fold ([res p]) 58 | ([op-p (in-list ps)]) 59 | (match-define (list op p) op-p) 60 | (case op 61 | [("*") (λ (env) (* (res env) (p env)))] 62 | [("/") (λ (env) (/ (res env) (p env)))]))))) 63 | 64 | (define expr/p 65 | (do [p <- product/p] skip-ws 66 | [ps <- (many/p (list/p (or/p (string/p "+") (string/p "-")) product/p #:sep skip-ws))] skip-ws 67 | (pure 68 | (for/fold ([res p]) 69 | ([op-p (in-list ps)]) 70 | (match-define (list op p) op-p) 71 | (case op 72 | [("+") (λ (env) (+ (res env) (p env)))] 73 | [("-") (λ (env) (- (res env) (p env)))]))))) 74 | 75 | (define whole-string-expr/p 76 | (do [p <- expr/p] 77 | eof/p 78 | (pure p))) 79 | 80 | (define (parse-expr s) 81 | (parse-result! (parse-string whole-string-expr/p s))) 82 | 83 | (module+ test 84 | (test-case "parse-expr" 85 | (check-equal? ((parse-expr "5-3-1") (hash)) 1) 86 | (check-equal? ((parse-expr "30/15/5") (hash)) 2/5) 87 | (check-equal? ((parse-expr "5*6-2") (hash)) 28) 88 | (check-equal? ((parse-expr "5 + 3 - 1") (hash)) 7) 89 | (check-equal? ((parse-expr "down(4 * 3 / 2)") (hash)) 6) 90 | (check-equal? ((parse-expr "4 * 3 / 2") (hash)) 6) 91 | (check-exn exn:fail:read:megaparsack? (thunk (parse-expr "(3*4))"))) 92 | (check-exn exn:fail:read:megaparsack? (thunk (parse-expr "down((C-1)/2) * (L+3))"))))) 93 | -------------------------------------------------------------------------------- /gui/level-info.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [level-stats (-> (obs/c level/c) 6 | (obs/c natural-number/c) 7 | (is-a?/c view<%>))] 8 | [level-table (-> (obs/c level/c) 9 | (is-a?/c view<%>))] 10 | [inspiration-table (-> (obs/c num-players/c) 11 | (is-a?/c view<%>))])) 12 | 13 | (require frosthaven-manager/defns 14 | frosthaven-manager/gui/render 15 | frosthaven-manager/gui/static-table 16 | frosthaven-manager/observable-operator 17 | racket/gui/easy 18 | racket/gui/easy/contract) 19 | 20 | (define (level-stats @level @num-players) 21 | (define @level-info (@> @level get-level-info)) 22 | (group 23 | (@> @level {(format "Level Stats (~a)" _)}) 24 | (hpanel 25 | #:stretch '(#f #f) 26 | (text (@> @level-info {~>> level-info-trap-damage (~a "Trap: ")})) 27 | (text (@> @level-info {~>> level-info-hazardous-terrain (~a "Hazardous Terrain: ")})) 28 | (text (@> @level-info {~>> level-info-gold (~a "Gold: ")})) 29 | (text (@> @level-info {~>> level-info-exp (~a "Bonus XP: ")})) 30 | (text (@> @num-players {~>> inspiration-reward (~a "Inspiration: ")}))))) 31 | 32 | (define (level-table @level) 33 | (define (table) 34 | (static-table 35 | '("Level" "Gold" "Bonus XP" "Trap Damage" "Hazardous Terrain Damage") 36 | number-of-levels 37 | (list level-info-gold 38 | level-info-exp 39 | level-info-trap-damage 40 | level-info-hazardous-terrain) 41 | #:entry->value get-level-info 42 | #:selection @level)) 43 | (define (action) 44 | (with-closing-custodian/eventspace 45 | (render/eventspace #:eventspace closing-eventspace 46 | (window #:mixin close-custodian-mixin 47 | #:title "Level Information" 48 | #:stretch '(#f #f) 49 | (table))))) 50 | (button "Level Table" action)) 51 | 52 | (define (inspiration-table @num-players) 53 | (define (table) 54 | (static-table 55 | '("Players" "Inspiration") 56 | (sub1 max-players) 57 | (list inspiration-reward) 58 | #:index->entry (curry + 2) 59 | #:selection (@> @num-players {(- 2)}))) 60 | (define (action) 61 | (with-closing-custodian/eventspace 62 | (render/eventspace #:eventspace closing-eventspace 63 | (window #:mixin close-custodian-mixin 64 | #:title "Inspiration" 65 | #:stretch '(#f #f) 66 | (table))))) 67 | (button "Inspiration Table" action)) 68 | 69 | (module+ main 70 | (define/obs @level 3) 71 | (define/obs @num-players 2) 72 | ;; no separate eventspace: block main until this window closed 73 | (render/eventspace 74 | (window (vpanel (level-stats @level @num-players) 75 | (level-table @level) 76 | (inspiration-table @num-players))))) 77 | -------------------------------------------------------------------------------- /scribblings/syntax/monsters.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | frosthaven-manager/monster-db 6 | frosthaven-manager/parsers/foes 7 | frosthaven-manager/syntax/monsters)) 8 | 9 | @title{@tt{syntax/monsters}} 10 | @defmodule[frosthaven-manager/syntax/monsters] 11 | 12 | @defform[#:literals (provide import info ability) 13 | (make-dbs (provide info-db-id ability-db-id) 14 | (import import-mod-path ...) 15 | (info monster-info ...) 16 | (ability monster-ability ...)) 17 | #:contracts ([monster-info monster-info?] 18 | [monster-ability monster-ability?])]{ 19 | Binds and provides @racket[info-db-id] and @racket[ability-db-id] to 20 | @racket[info-db/c] and @racket[ability-db/c] values, respectively, by importing 21 | all the monster information from each @racket[import-mod-path] and merging it 22 | with the provided @racket[monster-info] and @racket[monster-ability]. 23 | 24 | Each @racket[import-mod-path] is expected to provide the same 25 | @racket[info-db-id] and @racket[ability-db-id]. 26 | 27 | The @racket[provide] keyword in the provide specification is recognized by 28 | binding and must be the same as the one from @racketmodname[racket/base]. The 29 | @racket[import], @racket[info], and @racket[ability] keywords are recognized by 30 | datum identity. 31 | } 32 | 33 | @defproc[(imports->dbs [import-paths (listof string?)]) 34 | (values (listof info-db/c) (listof ability-db/c))]{ 35 | Produces all the monster information databases, one for each import in 36 | @racket[import-paths], using @racket[get-dbs]. 37 | } 38 | 39 | @defproc[(check-monsters-have-abilities 40 | [imported-info-dbs (listof info-db/c)] 41 | [imported-ability-dbs (listof ability-db/c)] 42 | [infos (listof monster-info?)] 43 | [actions (listof monster-ability?)]) 44 | boolean?]{ 45 | True iff the set names among all the given @racket[imported-info-dbs] and 46 | @racket[infos] is a subset of those among all the given 47 | @racket[imported-ability-dbs] and @racket[actions]. 48 | } 49 | 50 | @defproc[(check-monsters-have-abilities-message 51 | [imported-info-dbs (listof info-db/c)] 52 | [imported-ability-dbs (listof ability-db/c)] 53 | [infos (listof monster-info?)] 54 | [actions (listof monster-ability?)]) 55 | string?]{ 56 | An error message for when @racket[check-monsters-have-abilities] fails. 57 | } 58 | 59 | @defproc[(check-foes-have-monsters 60 | [imported-info-dbs (listof info-db/c)] 61 | [infos (listof monster-info?)] 62 | [foes (listof foe/pc)]) 63 | boolean?]{ 64 | True iff the foe names among all the given @racket[foes] is a subset of the 65 | monster names among all the given @racket[imported-info-dbs] and @racket[infos]. 66 | } 67 | 68 | @defproc[(check-foes-have-monsters-message 69 | [imported-info-dbs (listof info-db/c)] 70 | [infos (listof monster-info?)] 71 | [foes (listof foe/pc)]) 72 | string?]{ 73 | An error message for when @racket[check-foes-have-monsters] fails. 74 | } 75 | -------------------------------------------------------------------------------- /scribblings/gui/stacked-tables.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label racket/gui 4 | racket/gui/easy 5 | racket/gui/easy/contract 6 | frosthaven-manager/gui/stacked-tables 7 | (except-in frosthaven-manager/observable-operator #%app))) 8 | 9 | @title{@tt{gui/stacked-tables}} 10 | @defmodule[frosthaven-manager/gui/stacked-tables] 11 | 12 | @defproc[(stacked-tables 13 | [#:topleft? topleft? boolean? #t] 14 | [#:panel panel (-> (is-a?/c view<%>) ... (is-a?/c view<%>)) hpanel] 15 | [|@data| (obs/c (vectorof any/c))] 16 | [final-view (-> (obs/c (or/c #f any/c)) (is-a?/c view<%>))] 17 | [column1 column?] 18 | [column-spec column?] ...) 19 | (is-a?/c view<%>)]{ 20 | A view of @racket[|@data|] using stacked tables. The tables are horizontal, 21 | left-to-right by default. Supplying @racket[vpanel] for @racket[panel] makes the 22 | stack vertical. When @racket[topleft?] is true, the first table is on the left 23 | or top of the stack. Otherwise it is on the right or bottom, reversing the order 24 | of subsequent tables. 25 | 26 | The stack of tables is determined by @racket[column1] and each 27 | @racket[column-spec]. The first is always @racket[column1]. 28 | 29 | Starting with @racket[|@data|] and @racket[column1], a table is added to the 30 | stack. The table's title is given by @racket[column-title]. The labels for the 31 | items in the table come from applying @racket[column-entry->label] to the values 32 | in the data. When a value is selected, the data for the next table and 33 | @racket[column-spec] is produced by @racket[column-entry->next] on the 34 | selection. This value is automatically wrapped in @racket[vector] as needed. 35 | 36 | This process continues, adding tables to the stack whose data depends on 37 | previous data and selections, until the final table and @racket[column-spec] are 38 | added. The final selection, which is @emph{not} automatically vectorized, is 39 | given to @racket[final-view]. The resulting view is also added to the stack. 40 | 41 | The intermediate data produced by @racket[column-entry->next] is automatically 42 | emptied when no value is selected previously. In contrast, @racket[final-view] 43 | needs to handle the case that no data has yet been selected. A common pattern 44 | is to compute a default value: 45 | @codeblock|{ 46 | (stacked-tables 47 | @data 48 | (λ (@x?) ... (@> @x? {(or _ default)}) ...) 49 | ...) 50 | }| 51 | } 52 | 53 | @defstruct*[column ([title string?] 54 | [entry->label (-> any/c string?)] 55 | [entry->next (-> any/c (or/c any/c (vectorof any/c)))])]{ 56 | A column specification for @racket[stacked-tables], which explains how the 57 | specification is used. 58 | 59 | A note about @racket[column-entry->next]: you almost certainly want to return a 60 | @racket[vector] for all but (possibly) the last @racket[column.] Intermediate 61 | @racket[column]s likely have multiple choices. As a convenience, when there is 62 | only one, you may omit the vector. For the final @racket[column], you likely 63 | want to omit the vector unless the selected data is one: the data here is the 64 | final selection, of which there should probably be one. 65 | } 66 | -------------------------------------------------------------------------------- /scribblings/gui/markdown.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../common.rkt") 4 | @(require (for-label xml 5 | racket 6 | racket/gui/easy 7 | racket/gui/easy/contract 8 | frosthaven-manager/gui/markdown)) 9 | 10 | @title{@tt{gui/markdown}} 11 | @defmodule[frosthaven-manager/gui/markdown] 12 | 13 | @defproc[(markdown-text 14 | [|@content| (maybe-obs/c (or/c string? path?))] 15 | [#:min-size @min-size (maybe-obs/c size/c) '(#f #f)] 16 | [#:stretch @stretch (maybe-obs/c stretch/c) '(#t #t)] 17 | [#:margin @margin (maybe-obs/c margin/c) '(0 0)] 18 | [#:inset @inset (maybe-obs/c margin/c) '(5 5)] 19 | [#:style style 20 | (listof (one-of/c 'no-border 'control-border 'combo 21 | 'no-hscroll 'no-vscroll 22 | 'hide-hscroll 'hide-vscroll 23 | 'auto-vscroll 'auto-hscroll 24 | 'resize-corner 'deleted 'transparent)) 25 | '(no-hscroll)]) 26 | (is-a?/c view<%>)]{ 27 | A GUI view rendering the markdown in @racket[|@content|], which is either a 28 | @tech[#:doc ref-doc]{string} of Markdown or a path to a file containing Markdown. 29 | The view updates when @racket[|@content|] does---note that in the string case 30 | this means the Markdown content has changed, but in the path case this means the 31 | path has changed, not the contents of the file at the path! 32 | 33 | The following Markdown features are supported: 34 | @itemlist[ 35 | @item{Paragraphs;} 36 | @item{HTML comments;} 37 | @item{Hyperlinks;} 38 | @item{Blockquotes;} 39 | @item{Unordered and ordered lists;} 40 | @item{Horizontal rules;} 41 | @item{@bold{Bold}, @italic{italic}, and @tt{code} styles;} 42 | @item{and six levels of headings.} 43 | ] 44 | 45 | The following @racket[xexpr?]s are supported recursively in the parsed Markdown; 46 | these map to the Markdown features above: 47 | @itemlist[ 48 | @item{Any @tech[#:doc ref-doc]{string}} 49 | @item{Any expression tagged @tt{!HTML-COMMENT}, the tag for HTML comments} 50 | @item{Any expression tagged @tt{a}} 51 | @item{Any expression tagged @tt{blockquote}} 52 | @item{Any expression tagged @tt{ul}} 53 | @item{Any expression tagged @tt{ol}} 54 | @item{Any expression tagged @tt{li}} 55 | @item{Any expression tagged @tt{hr}} 56 | @item{Any expression tagged @tt{p}} 57 | @item{Any expression tagged @tt{strong}} 58 | @item{Any expression tagged @tt{em}} 59 | @item{Any expression tagged @tt{code}} 60 | @item{Any expression tagged @tt{h1}} 61 | @item{Any expression tagged @tt{h2}} 62 | @item{Any expression tagged @tt{h3}} 63 | @item{Any expression tagged @tt{h4}} 64 | @item{Any expression tagged @tt{h5}} 65 | @item{Any expression tagged @tt{h6}} 66 | ] 67 | Any other tag found in the parsed Markdown is a runtime error. 68 | 69 | Note that Markdown technically requires 4 spaces or a single tab as leading 70 | indent for nesting lists and other blocks; while many Markdown implementations 71 | (such as those used on GitHub) are more lenient, the implementation backing 72 | @racket[markdown-text] is stricter on this point. 73 | } 74 | -------------------------------------------------------------------------------- /manager/transition.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [transition/c contract?] 6 | [next-round transition/c] 7 | [draw-abilities transition/c])) 8 | 9 | (require frosthaven-manager/defns 10 | frosthaven-manager/gui/round-prompts 11 | frosthaven-manager/manager/ability-decks 12 | frosthaven-manager/manager/elements 13 | frosthaven-manager/manager/modifier-decks 14 | frosthaven-manager/manager/round-prompts 15 | frosthaven-manager/manager/save 16 | frosthaven-manager/manager/state 17 | frosthaven-manager/observable-operator) 18 | 19 | (module+ test (require rackunit 20 | frosthaven-manager/testfiles/data 21 | (submod frosthaven-manager/manager/state test-helpers))) 22 | 23 | (define transition/c (-> state? (-> any))) 24 | 25 | ;; Play (Draw -> Next Round -> …) 26 | 27 | (define ((next-round s)) 28 | (when (@! (state-@in-draw? s)) 29 | ;; autosave 30 | (when (@! (state-@autosave-dir s)) 31 | (do-autosave s)) 32 | ;; check prompts 33 | (let ([t end-of] 34 | [round (@! (state-@round s))]) 35 | (when (should-do-prompt? t round (@! (state-@prompts s))) 36 | (do-round-prompt t round))) 37 | ;; wane elements 38 | (for-each {(<@ wane-element)} (state-@elements s)) 39 | ;; reset player initiative 40 | (<@ (state-@creatures s) {(update-all-players player-clear-initiative)}) 41 | ;; discard monster cards 42 | (<@ (state-@ability-decks s) 43 | (update-ability-decks {~> 2> ability-decks-discard-and-maybe-shuffle})) 44 | ;; shuffle modifiers if required 45 | (when (shuffle-modifier-deck? (@! (state-@monster-discard s))) 46 | (reshuffle-modifier-deck s)) 47 | ;; increment round number 48 | (<@ (state-@round s) add1) 49 | ;; toggle state 50 | (<@ (state-@in-draw? s) not) 51 | ;; check prompts 52 | (let ([t beginning-of] 53 | [round (@! (state-@round s))]) 54 | (when (should-do-prompt? t round (@! (state-@prompts s))) 55 | (do-round-prompt t round))))) 56 | 57 | (define ((draw-abilities s)) 58 | (unless (@! (state-@in-draw? s)) 59 | ;; draw new monster cards 60 | (<@ (state-@ability-decks s) (update-ability-decks {~> 2> ability-decks-draw-next})) 61 | ;; toggle state 62 | (<@ (state-@in-draw? s) not))) 63 | 64 | (module+ test 65 | (test-case "Draw Abilities: Cards not drawn for dead monster groups" 66 | (define s (make-sample-state)) 67 | (define mg 68 | (~> (s archers) 69 | get-creature creature-v monster-group*-mg)) 70 | ;; kill all archers 71 | (for ([m (monster-group-monsters mg)]) 72 | (kill-monster s archers (monster-number m))) 73 | ;; fail: these cards no longer exist! 74 | (check-exn exn:fail? (thunk (get-ability-decks s archers))) 75 | ;; Draw should still succeed 76 | ((draw-abilities s)) 77 | ;; fail: these cards still don't exist! 78 | (check-exn exn:fail? (thunk (get-ability-decks s archers))))) 79 | 80 | (define current-base "frosthaven-manager-autosave-current.fasl") 81 | (define previous-base "frosthaven-manager-autosave-previous.fasl") 82 | 83 | (define (do-autosave s) 84 | (define dir (@! (state-@autosave-dir s))) 85 | (define ($ . xs) (apply build-path dir xs)) 86 | (when (file-exists? ($ current-base)) 87 | (rename-file-or-directory ($ current-base) ($ previous-base) 'exists-ok)) 88 | ((save-game s) ($ current-base))) 89 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | --- 2 | name: Deploy release with compiled applications 3 | on: 4 | push: 5 | tags: 6 | - "v*.*" 7 | - "v*.*.*" 8 | 9 | jobs: 10 | build_linux: 11 | name: "Build on Linux Racket CS Stable" 12 | runs-on: ubuntu-latest 13 | steps: 14 | - uses: actions/checkout@v4 15 | - uses: Bogdanp/setup-racket@v1.11 16 | with: 17 | architecture: x64 18 | distribution: full 19 | variant: CS 20 | version: stable 21 | - name: Installing frosthaven-manager and its dependencies 22 | run: make install RACO_INSTALL_ARGS=--no-docs 23 | - name: Bundling frosthaven-manager distribution 24 | run: make linux-FrosthavenManager.tar.gz 25 | - name: Upload FrosthavenManager artifact 26 | uses: actions/upload-artifact@v4 27 | with: 28 | name: linux-dist 29 | path: linux-FrosthavenManager.tar.gz 30 | build_macos: 31 | name: "Build on MacOS Racket CS Stable" 32 | runs-on: macos-latest 33 | steps: 34 | - uses: actions/checkout@v4 35 | - uses: Bogdanp/setup-racket@v1.11 36 | with: 37 | architecture: x64 38 | distribution: full 39 | variant: CS 40 | version: stable 41 | - name: Installing frosthaven-manager and its dependencies 42 | run: make install RACO_INSTALL_ARGS=--no-docs 43 | - name: Bundling frosthaven-manager distribution 44 | run: make macOS-FrosthavenManager.tar.gz 45 | - name: Upload FrosthavenManager.app artifact 46 | uses: actions/upload-artifact@v4 47 | with: 48 | name: macOS-dist 49 | path: macOS-FrosthavenManager.tar.gz 50 | build_windows: 51 | name: "Build on Windows Racket CS Stable" 52 | runs-on: windows-latest 53 | steps: 54 | - uses: actions/checkout@v4 55 | - uses: Bogdanp/setup-racket@v1.11 56 | with: 57 | architecture: x64 58 | distribution: full 59 | variant: CS 60 | version: stable 61 | - name: Install make 62 | run: choco install make -y 63 | - name: Installing frosthaven-manager and its dependencies 64 | run: make install RACO_INSTALL_ARGS=--no-docs 65 | - name: Bundling frosthaven-manager distribution 66 | run: make windows-FrosthavenManager.zip 67 | - name: Upload FrosthavenManager artifact 68 | uses: actions/upload-artifact@v4 69 | with: 70 | name: windows-dist 71 | path: windows-FrosthavenManager.zip 72 | release: 73 | name: "Release new version" 74 | runs-on: ubuntu-latest 75 | needs: 76 | - build_linux 77 | - build_macos 78 | - build_windows 79 | steps: 80 | - name: Download FrosthavenManager artifact 81 | uses: actions/download-artifact@v4 82 | with: 83 | name: linux-dist 84 | - name: Download FrosthavenManager.app artifact 85 | uses: actions/download-artifact@v4 86 | with: 87 | name: macOS-dist 88 | - name: Download FrosthavenManager.exe artifact 89 | uses: actions/download-artifact@v4 90 | with: 91 | name: windows-dist 92 | - name: Release 93 | uses: softprops/action-gh-release@v1 94 | with: 95 | fail_on_unmatched_files: true 96 | target_commitish: ${{github.sha}} 97 | generate_release_notes: true 98 | files: | 99 | macOS-FrosthavenManager.tar.gz 100 | linux-FrosthavenManager.tar.gz 101 | windows-FrosthavenManager.zip 102 | -------------------------------------------------------------------------------- /scribblings/gui/render.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require "../common.rkt") 4 | @(require (for-label racket/gui 5 | racket/gui/easy 6 | racket/gui/easy/contract 7 | frosthaven-manager/gui/render)) 8 | 9 | @title{@tt{gui/render}} 10 | @defmodule[frosthaven-manager/gui/render] 11 | 12 | @defparam[current-renderer 13 | r (or/c #f renderer?) 14 | #:value #f]{ 15 | A parameter for the current renderer. This can be set so that sub-views can 16 | access the top-level renderer. Note that it is not re-entrant, in the sense that 17 | to make it effective one must render an application by 18 | @codeblock{ 19 | (define root (render ...)) 20 | (current-renderer root) 21 | } 22 | Any other application running in the same thread cannot use 23 | @racket[current-renderer] or it will interfere with the previous application. 24 | This also holds more generally of sub-views @racket[render]ed on-the-fly. See 25 | @racket[render/eventspace] to avoid this. 26 | 27 | This will not affect multiple applications built and run separately that use 28 | this library, since they're in separate processes completely. 29 | } 30 | 31 | @defproc[(render/eventspace [tree (is-a?/c view<%>)] 32 | [#:parent parent (or/c #f renderer?) #f] 33 | [#:eventspace es eventspace? (current-eventspace)]) 34 | renderer?]{ 35 | Renders (as in @racket[render]) @racket[tree] with parent @racket[parent] in the 36 | eventspace @racket[es], then queues a high-priority callback in the 37 | handler-thread for @racket[es] to set @racket[current-renderer] to the resulting 38 | renderer, which is returned. 39 | 40 | Pass a new @tech[#:doc gui-doc]{eventspace} created with 41 | @racket[make-eventspace] to separate the rendered @racket[tree] and 42 | corresponding @racket[current-renderer] from other applications. 43 | 44 | This can be used to group windows in an application together, but note that 45 | subsequent calls with the same @racket[es] will override that eventspace's 46 | @tech[#:doc gui-doc]{handler thread}'s @racket[current-renderer]. 47 | 48 | For a short-lived window that should tear down the eventspace on closure, 49 | combine with @racket[with-closing-custodian/eventspace]. 50 | } 51 | 52 | @deftogether[( 53 | @defform[(with-closing-custodian/eventspace e ...+)] 54 | @defform[#:id closing-custodian closing-custodian] 55 | @defform[#:id closing-eventspace closing-eventspace] 56 | @defform[#:id close-custodian-mixin close-custodian-mixin] 57 | )]{ 58 | Evaluates the body expressions @racket[e ...] with the following special 59 | variables available: 60 | @itemize[ 61 | @item{@racket[closing-custodian] is a new @tech[#:doc ref-doc]{custodian} that manages @racket[closing-eventspace].} 62 | @item{@racket[closing-eventspace] is a new @tech[#:doc gui-doc]{eventspace} managed by @racket[closing-custodian].} 63 | @item{@racket[close-custodian-mixin] is a new @tech[#:doc ref-doc]{mixin} for @racket[top-level-window<%>]s that causes @racket[closing-custodian] to shutdown after the corresponding window is closed.} 64 | ] 65 | For example, the following produces either @racket[#t] or @racket[#f] depending 66 | on whether window A or window B was closed first. Note also the use of 67 | @racket[render/eventspace] to set @racket[current-renderer] correctly. 68 | @codeblock{ 69 | (require racket/gui/easy) 70 | (define main-es (make-eventspace)) 71 | (render/eventspace #:eventspace main-es (window #:title "A" (text "A"))) 72 | (define aux-es 73 | (with-closing-custodian/eventspace 74 | (render/eventspace 75 | #:eventspace closing-eventspace 76 | (window #:mixin close-custodian-mixin 77 | #:title "B" 78 | (text "B"))) 79 | closing-eventspace)) 80 | 81 | (sync main-es) ;; wait until window A is closed 82 | (eventspace-shutdown? aux-es) ;; true if window B was closed first 83 | } 84 | } 85 | -------------------------------------------------------------------------------- /parsers/foes.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | ; vim: lw-=do 3 | 4 | (provide 5 | (contract-out 6 | [foes/pc flat-contract?] 7 | [foe/pc flat-contract?] 8 | [spec/pc flat-contract?] 9 | [numbering/pc flat-contract?] 10 | [monster-type/pc flat-contract?] 11 | [parse-foes (-> any/c input-port? #:syntax? any/c 12 | (or/c syntax? foes/pc))] 13 | [foes/p (parser/c char? foes/pc)] 14 | [foe/p (parser/c char? foe/pc)])) 15 | 16 | (require frosthaven-manager/defns 17 | frosthaven-manager/parsers/base 18 | frosthaven-manager/parsers/monster) 19 | 20 | #| foes syntax 21 | - outside of elements, whitespace is ignored 22 | 23 | ::= ( | | )* 24 | 25 | ::= "begin-foe" 26 | ("(" ")")? 27 | ("[" ("ordered"|"random") "numbering" "]")? 28 | + 29 | "end-foe" 30 | 31 | ::= "<" "2:" "3:" "4:" ">" 32 | 33 | ::= "absent" | "normal" | "elite" 34 | 35 | , , exactly like in bestiary |# 36 | 37 | (define monster-type/pc (or/c "absent" "normal" "elite")) 38 | (define monster-type/p 39 | (or/p (string/p "absent") (string/p "normal") (string/p "elite"))) 40 | 41 | (define monster-name/p (non-empty-text/p "non-empty monster name")) 42 | 43 | (define numbering/pc (or/c "ordered" "random" #f)) 44 | (define numbering/p 45 | (opt/p (do [option <- (or/p (string/p "ordered") (string/p "random"))] skip-ws 46 | (string-ci/p "numbering") skip-ws 47 | (pure option)))) 48 | 49 | (define spec/pc (hash/c num-players/c monster-type/pc #:immutable #t)) 50 | (define valid-player-nums (inclusive-range 2 max-players)) 51 | (define spec/p 52 | (guard/p 53 | (fmap 54 | {(hash-map/copy {(== (~> string string->number) _)})} 55 | (map/p (char-in/p "234") monster-type/p)) 56 | {~> hash-keys (set=? valid-player-nums)} 57 | "entries for each of 2, 3, and 4 players" 58 | {~>> hash-keys (set-subtract valid-player-nums) 59 | (map ~a) (string-join _ ", " #:before-first "missing ")})) 60 | 61 | (define foe/pc (list/c string? string? numbering/pc (listof spec/pc))) 62 | (define foe/p 63 | (do (string/p "begin-foe") skip-ws 64 | [name <- monster-name/p] skip-ws 65 | [set-name <- (set-name?/p name)] skip-ws 66 | [numbering <- (or/p numbering/p (pure #f))] skip-ws 67 | [specs <- (fmap first (many+-until/p spec/p #:sep skip-ws #:end (try/p (do skip-ws (string/p "end-foe")))))] 68 | (pure (list set-name name numbering specs)))) 69 | 70 | (define foes/pc 71 | (list/c (cons/c 'import (listof string?)) 72 | (cons/c 'info (listof monster-info?)) 73 | (cons/c 'ability (listof monster-ability?)) 74 | (cons/c 'foe (listof foe/pc)))) 75 | 76 | (define-flow foe-dupes 77 | (~> sep (partition 78 | [foe/pc (~> (>< second) collect check-duplicates)]))) 79 | 80 | (define big-bag-foes/p 81 | (guard/p 82 | (ws-separated-whole-file/p (or/p import-monsters/p 83 | (try/p monster/p) 84 | (try/p ability-deck/p) 85 | foe/p)) 86 | {(and (~> bestiary-dupes none?) 87 | (~> foe-dupes none?))} 88 | "no duplicate monsters, ability decks, or foes" 89 | {~> (-< bestiary-dupes foe-dupes) (pass _) collect (string-join ",")})) 90 | 91 | (define-flow big-bag->structured 92 | (~> sep 93 | (partition 94 | [(esc (list/c 'import string?)) (~>> (>< second) collect (cons 'import))] 95 | [monster-info? (~>> collect (cons 'info))] 96 | [(esc (listof monster-ability?)) (~>> (>< sep) collect (cons 'ability))] 97 | [foe/pc (~>> collect (cons 'foe))]) 98 | collect)) 99 | 100 | (define foes/p (fmap big-bag->structured big-bag-foes/p)) 101 | 102 | (define parse-foes (make-reader-like foes/p)) 103 | -------------------------------------------------------------------------------- /gui/table.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [make-preview-rows (-> list? 6 | (or/c 'all natural-number/c) 7 | #:reveal (-> any/c (vectorof string?)) 8 | #:hide (-> any/c (vectorof string?)) 9 | (vectorof (vectorof string?)))])) 10 | 11 | (require frosthaven-manager/curlique) 12 | 13 | (module+ test (require rackunit)) 14 | 15 | (define (make-preview-rows xs n #:reveal reveal #:hide hide) 16 | (define-values {shown hidden} 17 | (match n 18 | ['all (values xs empty)] 19 | [(? number? n) (cond 20 | [(<= 0 n (length xs)) (split-at xs n)] 21 | [else (values xs empty)])])) 22 | (~> {shown hidden} 23 | (== (sep reveal) (sep hide)) 24 | vector)) 25 | 26 | (module+ test 27 | (require frosthaven-manager/defns 28 | frosthaven-manager/manager/loot 29 | frosthaven-manager/monster-db) 30 | 31 | (test-case "make-preview-rows for monster abilities" 32 | (define-values {_info abilities} (get-dbs default-monster-db)) 33 | (define in (shuffle (hash-ref abilities "archer"))) 34 | (define name-text 35 | (list->vector (map vector (map monster-ability-name->text in)))) 36 | (define reveal {~> monster-ability-name->text vector}) 37 | (define hide {(gen (vector "?"))}) 38 | (check-equal? (make-preview-rows in 0 #:reveal reveal #:hide hide) 39 | (vector-map (const (vector "?")) name-text)) 40 | (check-equal? (make-preview-rows in 5 #:reveal reveal #:hide hide) 41 | (vector-append 42 | (vector-take name-text 5) 43 | (vector-map (const (vector "?")) (vector-drop name-text 5)))) 44 | (check-equal? (make-preview-rows in 'all #:reveal reveal #:hide hide) 45 | name-text) 46 | (check-equal? (make-preview-rows in (length in) #:reveal reveal #:hide hide) 47 | name-text) 48 | (check-equal? (make-preview-rows in (add1 (length in)) #:reveal reveal #:hide hide) 49 | name-text) 50 | (check-equal? (make-preview-rows in -5 #:reveal reveal #:hide hide) 51 | name-text)) 52 | 53 | (test-case "make-preview-rows for loot deck" 54 | (define loot-deck (build-loot-deck 55 | (hash 'money 3 56 | lumber 2 57 | hide 2 58 | axenut 2) 59 | (hash 'money money-deck 60 | lumber (hash-ref material-decks lumber) 61 | hide (hash-ref material-decks hide) 62 | axenut (hash-ref herb-decks axenut)))) 63 | (define n-players 3) 64 | (define loot-text (list->vector (map vector (map (format-loot-card n-players) loot-deck)))) 65 | (define reveal {~> (esc (format-loot-card n-players)) vector}) 66 | (define hide-loot {(gen (vector "?"))}) 67 | (check-equal? (make-preview-rows loot-deck 0 #:reveal reveal #:hide hide-loot) 68 | (vector-map (const (vector "?")) loot-text)) 69 | ;; check that vector-map didn't modify loot-text 70 | (check-equal? loot-text 71 | (list->vector (map vector (map (format-loot-card n-players) loot-deck)))) 72 | (check-equal? (make-preview-rows loot-deck 5 #:reveal reveal #:hide hide-loot) 73 | (vector-append 74 | (vector-take loot-text 5) 75 | (vector-map (const (vector "?")) (vector-drop loot-text 5)))) 76 | (check-equal? (make-preview-rows loot-deck 'all #:reveal reveal #:hide hide-loot) 77 | loot-text) 78 | (check-equal? (make-preview-rows loot-deck (length loot-deck) #:reveal reveal #:hide hide-loot) 79 | loot-text) 80 | (check-equal? (make-preview-rows loot-deck (add1 (length loot-deck)) #:reveal reveal #:hide hide-loot) 81 | loot-text) 82 | (check-equal? (make-preview-rows loot-deck -5 #:reveal reveal #:hide hide-loot) 83 | loot-text))) 84 | -------------------------------------------------------------------------------- /gui/formula-editor.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [formula-editor (-> (obs/c env/c) (is-a?/c view<%>))] 6 | [formula-menu-item (-> (obs/c env/c) (is-a?/c view<%>))])) 7 | 8 | (require frosthaven-manager/gui/render 9 | frosthaven-manager/observable-operator 10 | frosthaven-manager/parsers/formula 11 | megaparsack 12 | racket/gui/easy 13 | racket/gui/easy/contract) 14 | 15 | (module+ test (require rackunit)) 16 | 17 | (define (formula-editor @env #:mix [mix values]) 18 | (define/obs @input "") 19 | (define @result (obs-combine eval-formula @input @env)) 20 | (define (@var-display var) 21 | (@> @env {(var-label-text var)})) 22 | (window 23 | #:title "Formula editor" 24 | #:mixin mix 25 | #:size '(300 200) 26 | (vpanel 27 | (input @input (λ (_evt inp) (:= @input inp)) 28 | #:style '(multiple) 29 | #:label "Formula") 30 | (input (@> @result ~a) void 31 | #:enabled? #f 32 | #:style '(multiple) 33 | #:label "Results") 34 | (hpanel 35 | (vpanel 36 | (text "Variables") 37 | (text (@var-display "L")) 38 | (text (@var-display "C"))) 39 | (vpanel 40 | (text "Operators") 41 | (text "+ Add") 42 | (text "- Subtract") 43 | (text "* Multiply") 44 | (text "/ Divide")))))) 45 | 46 | (define (formula-menu-item @env) 47 | (menu-item "Formula Editor" 48 | (thunk (with-closing-custodian/eventspace 49 | (render/eventspace 50 | #:eventspace closing-eventspace 51 | (formula-editor @env #:mix close-custodian-mixin)))))) 52 | 53 | (define (eval-formula f env) 54 | (with-handlers ([exn:fail:read:megaparsack? 55 | (λ (exn) 56 | (parse-error->string 57 | (message (match (exn:fail:read-srclocs exn) 58 | [(cons (srcloc _ line column posn span) _) 59 | (srcloc "Formula" line column posn span)] 60 | [_ (make-srcloc "Formula" #f #f #f #f)]) 61 | (exn:fail:read:megaparsack-unexpected exn) 62 | (exn:fail:read:megaparsack-expected exn))))] 63 | [exn:fail:contract? (const "reference to unavailable variable")]) 64 | ((parse-expr f) env))) 65 | 66 | (module+ test 67 | (test-case "eval-formula" 68 | (check-equal? (eval-formula "3+5" (hash)) 8) 69 | (check-equal? (eval-formula "2*L" (hash "L" 7)) 14) 70 | (check-regexp-match #rx"variable" (eval-formula "2*L" (hash 'C 7))) 71 | (check-regexp-match #rx"Formula:.*: parse error" (eval-formula "/3" (hash))))) 72 | 73 | (define (var-label-text env var) 74 | (~> (env) 75 | (hash-ref var #f) 76 | (or _ "unavailable") 77 | (~a var ": " _))) 78 | 79 | (module+ test 80 | (test-case "var-label-text" 81 | (check-equal? (var-label-text (hash "C" 4) "C") "C: 4") 82 | (check-equal? (var-label-text (hash) "C") "C: unavailable"))) 83 | 84 | (module+ main 85 | (define/obs @c 4) 86 | (define/obs @c? #t) 87 | (define/obs @l 2) 88 | (define/obs @l? #t) 89 | (render 90 | (window 91 | (hpanel 92 | (checkbox (λ:= @l?) #:checked? @l?) 93 | (slider #:label "L" @l (λ:= @l) #:min-value 0 #:max-value 7)) 94 | (hpanel 95 | (checkbox (λ:= @c?) #:checked? @c?) 96 | (slider #:label "C" @c (λ:= @c) #:min-value 2 #:max-value 4)) 97 | (menu-bar (menu "File" (formula-menu-item 98 | (obs-combine 99 | (λ (c c? l l?) 100 | (make-immutable-hash 101 | (append (if c? (list (cons "C" c)) null) 102 | (if l? (list (cons "L" l)) null)))) 103 | @c @c? @l @l?))))))) 104 | -------------------------------------------------------------------------------- /loot-cards.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | #%app #%datum #%top #%top-interaction 5 | (rename-out [mb #%module-begin]) 6 | extend-standard-deck 7 | sticker 8 | add-special-loot 9 | money 10 | lumber metal hide 11 | arrowvine axenut corpsecap flamefruit rockroot snowthistle) 12 | 13 | (require (for-syntax racket/syntax) 14 | frosthaven-manager/defns 15 | racket/hash 16 | syntax/parse/define) 17 | 18 | (module reader syntax/module-reader 19 | frosthaven-manager/loot-cards) 20 | 21 | (define-syntax-parser mb 22 | [(_ e:expr ...) 23 | #:with result (format-id this-syntax "loot-cards" #:source this-syntax) 24 | (syntax/loc this-syntax 25 | (#%module-begin 26 | (provide result) 27 | (define result 28 | (for/fold ([x (hash)]) 29 | ([f (list e ...)]) 30 | (f x)))))]) 31 | 32 | (define-syntax-parser extend-standard-deck 33 | [_ (syntax/loc this-syntax (-extend-standard-deck))] 34 | [(_) (syntax/loc this-syntax (-extend-standard-deck))]) 35 | 36 | (begin-for-syntax 37 | (define-syntax-class money-spec 38 | #:attributes {constructor} 39 | #:literals {money} 40 | [pattern [money amount:number] 41 | #:with constructor #'(money amount)]) 42 | (define-syntax-class material-spec 43 | #:attributes {constructor} 44 | #:literals {lumber metal hide} 45 | [pattern [{~and t {~or lumber metal hide}} 46 | 2player-amount:number 47 | 3player-amount:number 48 | 4player-amount:number] 49 | #:with constructor #'(material t (list 2player-amount 3player-amount 4player-amount))]) 50 | (define-syntax-class herb-spec 51 | #:attributes {constructor} 52 | #:literals {arrowvine axenut corpsecap flamefruit rockroot snowthistle} 53 | [pattern {~and t {~or arrowvine axenut corpsecap flamefruit rockroot snowthistle}} 54 | #:with constructor #'(herb t 1)] 55 | [pattern [{~and t {~or arrowvine axenut corpsecap flamefruit rockroot snowthistle}} amount:number] 56 | #:with constructor #'(herb t amount)]) 57 | (define-syntax-class card-spec 58 | #:attributes {constructor} 59 | [pattern m:money-spec #:with constructor #'m.constructor] 60 | [pattern m:material-spec #:with constructor #'m.constructor] 61 | [pattern h:herb-spec #:with constructor #'h.constructor])) 62 | 63 | (define-syntax-parser sticker 64 | [(_ [stickers:number c:card-spec] ...) 65 | (syntax/loc this-syntax 66 | (-sticker (list (cons stickers c.constructor) ...)))]) 67 | 68 | (define-syntax-parser add-special-loot 69 | [(_ name:string ...) 70 | (syntax/loc this-syntax 71 | (-add-special-loot (list name ...)))]) 72 | 73 | (define (-extend-standard-deck) 74 | (const standard-loot-deck)) 75 | 76 | (define ((-sticker stickers-per-card) x) 77 | (let loop ([res (hash)] 78 | [x x] 79 | [stickers-per-card stickers-per-card]) 80 | (match stickers-per-card 81 | ['() (hash-union res x #:combine append)] 82 | [(cons (cons n card) stickers-per-card) 83 | (define type (card->type card)) 84 | (define old-card 85 | (match (member card (hash-ref x type)) 86 | [(cons old-card _) old-card] 87 | [_ (raise-user-error 'sticker 88 | "card (~a ~a) does not exist in deck" 89 | type 90 | (match card 91 | [(money amount) amount] 92 | [(material _ amounts) (string-join (map ~a amounts))] 93 | [(herb _ amount) amount]))])) 94 | (define x* 95 | (hash-update x type (λ (old) (remove card old)))) 96 | (define new 97 | (for/fold ([card old-card]) 98 | ([_i (in-range n)]) 99 | (apply-sticker card))) 100 | (define res* 101 | (hash-update res type (λ (old) (cons new old)) '())) 102 | (loop res* x* stickers-per-card)]))) 103 | 104 | (define ((-add-special-loot names) x) 105 | (for/fold ([x x]) 106 | ([name (in-list names)]) 107 | (hash-update x 'special (λ (deck) (cons (special-loot name) deck)) '()))) 108 | -------------------------------------------------------------------------------- /scribblings/defns/scenario.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | frosthaven-manager/parsers/formula)) 6 | 7 | @title{Scenario} 8 | @defmodule[frosthaven-manager/defns/scenario] 9 | 10 | @deftogether[( 11 | @defthing[element? predicate/c] 12 | 13 | @defthing[fire element?] 14 | @defthing[ice element?] 15 | @defthing[air element?] 16 | @defthing[earth element?] 17 | @defthing[light element?] 18 | @defthing[dark element?] 19 | )]{ 20 | The elements. 21 | 22 | Serializable. 23 | } 24 | 25 | @deftogether[( 26 | @defthing[monster-modifier? predicate/c] 27 | 28 | @defthing[zero monster-modifier?] 29 | @defthing[minus1 monster-modifier?] 30 | @defthing[plus1 monster-modifier?] 31 | @defthing[minus2 monster-modifier?] 32 | @defthing[plus2 monster-modifier?] 33 | @defthing[null monster-modifier?] 34 | @defthing[crit monster-modifier?] 35 | @defthing[curse monster-modifier?] 36 | @defthing[bless monster-modifier?] 37 | )]{ 38 | Monster modifier cards. 39 | 40 | Serializable. 41 | } 42 | 43 | @deftogether[( 44 | @defthing[condition? predicate/c] 45 | 46 | @defthing[regenerate condition?] 47 | @defthing[ward condition?] 48 | @defthing[invisible condition?] 49 | @defthing[strengthen condition?] 50 | @defthing[wound condition?] 51 | @defthing[brittle condition?] 52 | @defthing[bane condition?] 53 | @defthing[poison condition?] 54 | @defthing[immobilize condition?] 55 | @defthing[disarm condition?] 56 | @defthing[impair condition?] 57 | @defthing[stun condition?] 58 | @defthing[muddle condition?] 59 | )]{ 60 | The @racket[condition?] predicate recognizes all valid conditions, which are 61 | listed here. 62 | 63 | Serializable. 64 | } 65 | 66 | @deftogether[( 67 | @defproc[(discriminator:condition [c condition?]) integer?] 68 | @defproc[(selector:condition [i integer?]) condition?] 69 | )]{ 70 | @tech[#:doc '(lib "rebellion/main.scrbl")]{Enum discriminator} and 71 | @tech[#:doc '(lib "rebellion/main.scrbl")]{enum selector} for 72 | @racket[condition?] values. Both contract error when the argument is outside the 73 | appropriate domain. 74 | } 75 | 76 | @defproc[(initiative? [v any/c]) boolean?]{ 77 | A predicate recognizing valid initiative values. 78 | } 79 | 80 | @defthing[conditions (listof condition?)]{ 81 | All the conditions together. 82 | } 83 | 84 | @defthing[expirable-conditions (setof conditions?)]{ 85 | The conditions that expire at end-of-next-turn. 86 | } 87 | 88 | @defproc[(conditions->string [cs (listof condition?)]) string?]{ 89 | Converts a set of conditions to a string. 90 | } 91 | 92 | @defthing[monster-modifier-deck (listof monster-modifier?)]{ 93 | A full deck of 20 monster modifier cards. 94 | } 95 | 96 | @deftogether[( 97 | @defthing[monster-curse-deck (listof monster-modifier?)] 98 | @defthing[bless-deck (listof monster-modifier?)] 99 | )]{ 100 | Full decks of 10 monster curse and bless cards. 101 | } 102 | 103 | @defproc[(shuffle-modifier-deck? [deck (listof monster-modifier?)]) boolean?]{ 104 | True if-and-only-if @racket[deck] contains a @racket[null] or @racket[crit]. 105 | } 106 | 107 | @deftogether[( 108 | @defproc[(better-modifier [a monster-modifier?] 109 | [b monster-modifier?]) 110 | monster-modifier?] 111 | @defproc[(worse-modifier [a monster-modifier?] 112 | [b monster-modifier?]) 113 | monster-modifier?] 114 | )]{ 115 | Returns the better or worse of the two modifier cards. 116 | } 117 | 118 | @defproc[(absent-from-modifier-deck [cards (listof monster-modifier?)]) 119 | (listof monster-modifier?)]{ 120 | Returns the cards in @racket[monster-modifier-deck] not in @racket[cards]. 121 | } 122 | -------------------------------------------------------------------------------- /gui/elements.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [elements-cycler (->* ((listof (obs/c element-state/c)) 6 | (listof element-pics?)) 7 | ((unconstrained-domain-> (is-a?/c view<%>))) 8 | (is-a?/c view<%>))])) 9 | (require frosthaven-manager/elements 10 | frosthaven-manager/gui/helpers 11 | frosthaven-manager/gui/render 12 | frosthaven-manager/manager 13 | frosthaven-manager/observable-operator 14 | racket/gui/easy 15 | racket/gui/easy/contract 16 | (except-in racket/gui #%app) 17 | (only-in pict inset pict-height scale)) 18 | 19 | (module+ test (require rackunit)) 20 | 21 | (define (elements-cycler @states es [panel hpanel]) 22 | (apply panel #:stretch '(#f #f) (element-cyclers @states es))) 23 | 24 | (define (element-cyclers @states es) 25 | (map element-cycler @states es)) 26 | 27 | (define (element-cycler @element-state e) 28 | (define (make-pict-for-canvas s) 29 | (~> (s) 30 | (esc (state->pict e)) 31 | (scale 2/3) 32 | (inset (/ size 2) 3 0 3))) 33 | (define cycle-element (make-transition-element-state @element-state)) 34 | (define pict-view 35 | (pict-canvas @element-state 36 | make-pict-for-canvas 37 | #:min-size (@> @element-state 38 | {~> make-pict-for-canvas 39 | pict-height exact-ceiling 40 | ;; BUG: pict-canvas -> area<%> can't handle 41 | ;; #f for min-width in make-item% in 42 | ;; make-canvas% 43 | (list 0 _)}) 44 | #:mixin (handle-element-clicks @element-state))) 45 | (vpanel 46 | #:stretch '(#f #f) 47 | pict-view 48 | (button (@> @element-state state->text) cycle-element))) 49 | 50 | (define (handle-element-clicks @state) 51 | (define cycle-element (make-transition-element-state @state)) 52 | (mixin (canvas<%>) () 53 | (super-new) 54 | (define/override (on-event e) 55 | (case (send e get-event-type) 56 | [(left-down) (cycle-element)] 57 | [(right-down) 58 | (define-values (x y) 59 | (translate-to-top-coords this 60 | (renderer-root (current-renderer)) 61 | (send e get-x) 62 | (send e get-y))) 63 | (when (and x y) 64 | (define pum 65 | (popup-menu (menu "Transition to…" 66 | (menu-item "Infused" (λ () (:= @state 'infused))) 67 | (menu-item "Waning" (λ () (:= @state 'waning))) 68 | (menu-item "Unfused" (λ () (:= @state 'unfused)))))) 69 | (render-popup-menu (current-renderer) pum x y))] 70 | [else (super on-event e)])))) 71 | 72 | (define (make-transition-element-state @state) 73 | (λ () 74 | (<@ @state transition-element-state))) 75 | 76 | (module+ test 77 | (test-case "transitions" 78 | (define/obs state 'infused) 79 | (define t (make-transition-element-state state)) 80 | (t) 81 | (check-equal? (@! state) 'waning) 82 | (t) 83 | (check-equal? (@! state) 'unfused) 84 | (t) 85 | (check-equal? (@! state) 'infused))) 86 | 87 | (define (state->pict e) 88 | (match-lambda 89 | ['unfused (element-pics-unfused e)] 90 | ['infused (element-pics-infused e)] 91 | ['waning (element-pics-waning e)] 92 | [_ (element-pics-unfused e)])) 93 | 94 | (define state->text 95 | (match-lambda 96 | ['unfused "Infuse"] 97 | ['infused "Wane"] 98 | ['waning "Unfuse"] 99 | [_ "Infuse"])) 100 | 101 | (module+ main 102 | (define es (elements)) 103 | (define @states (make-states es)) 104 | ;; demo 105 | (void (render/eventspace 106 | ;; no separate eventspace: block main until this window closed 107 | (window (vpanel (elements-cycler @states es) 108 | (button "Next Round" 109 | (thunk (for-each (curryr obs-update! wane-element) @states))))))) 110 | ;; testing errors 111 | #;(void (obs-update! (car @states) (thunk* 'gibberish)))) 112 | -------------------------------------------------------------------------------- /sample-bestiary.rkt: -------------------------------------------------------------------------------- 1 | #lang frosthaven-manager/bestiary 2 | 3 | begin-monster 4 | "hynox archer" 5 | 6 | [0 normal [hp 2] [move 2] [attack 2]] 7 | [1 normal [hp 3] [move 3] [attack 3]] 8 | [2 normal [hp 4] [move 4] [attack 4]] 9 | [3 normal [hp 5] [move 5] [attack 5]] 10 | [4 normal [hp 6] [move 6] [attack 6]] 11 | [5 normal [hp 7] [move 7] [attack 7]] 12 | [6 normal [hp 8] [move 8] [attack 8]] 13 | [7 normal [hp 9] [move 9] [attack 9]] 14 | 15 | [0 elite [HP 4] [Move 2] [Attack 3] [Bonuses {"shield 1"}]] 16 | [1 elite [HP 5] [Move 3] [Attack 4] [Bonuses {"shield 1"}]] 17 | [2 elite [HP 6] [Move 4] [Attack 5] [Bonuses {"shield 1"}]] 18 | [3 elite [HP 7] [Move 5] [Attack 6] [Bonuses {"shield 2"}]] 19 | [4 elite [HP 8] [Move 6] [Attack 7] [Bonuses {"shield 2"}]] 20 | [5 elite [HP 9] [Move 7] [Attack 8] [Bonuses {"shield 2"}]] 21 | [6 elite [HP 10] [Move 8] [Attack 9] [Bonuses {"shield 3"}]] 22 | [7 elite [HP 11] [Move 9] [Attack 10] [Bonuses {"shield 3"}]] 23 | end-monster 24 | 25 | begin-ability-deck 26 | "archer" 27 | 28 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 29 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 30 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 31 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 32 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 33 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 34 | ["double-shot" 25 {"attack +2, range 5" "attack +2, range 3, +1 if same target"}] 35 | ["take aim" 80 shuffle {"move +2" "strengthen self"}] 36 | end-ability-deck 37 | 38 | begin-monster 39 | "wyrmling archer" ("archer") 40 | 41 | [0 normal [hp 1] [move 1] [attack 1]] 42 | [1 normal [hp 2] [move 2] [attack 2]] 43 | [2 normal [hp 3] [move 3] [attack 3]] 44 | [3 normal [hp 4] [move 4] [attack 4]] 45 | [4 normal [hp 5] [move 5] [attack 5]] 46 | [5 normal [hp 6] [move 6] [attack 6]] 47 | [6 normal [hp 7] [move 7] [attack 7]] 48 | [7 normal [hp 8] [move 8] [attack 8]] 49 | 50 | [0 elite [hp 3] [move 1] [attack 2] [Bonuses {"shield 1"}]] 51 | [1 elite [hp 4] [move 2] [attack 3] [Bonuses {"shield 1"}]] 52 | [2 elite [hp 5] [move 3] [attack 4] [Bonuses {"shield 1"}]] 53 | [3 elite [hp 6] [move 4] [attack 5] [Bonuses {"shield 2"}]] 54 | [4 elite [hp 7] [move 5] [attack 6] [Bonuses {"shield 2"}]] 55 | [5 elite [hp 8] [move 6] [attack 7] [Bonuses {"shield 2"}]] 56 | [6 elite [hp 9] [move 7] [attack 8] [Bonuses {"shield 3"}]] 57 | [7 elite [hp 10] [move 8] [attack 9] [Bonuses {"shield 3"}]] 58 | end-monster 59 | 60 | begin-monster 61 | "hynox guard" 62 | 63 | [0 normal [hp 2] [move 2] [attack 2]] 64 | [1 normal [hp 3] [move 3] [attack 3]] 65 | [2 normal [hp 4] [move 4] [attack 4]] 66 | [3 normal [hp 5] [move 5] [attack 5]] 67 | [4 normal [hp 6] [move 6] [attack 6]] 68 | [5 normal [hp 7] [move 7] [attack 7]] 69 | [6 normal [hp 8] [move 8] [attack 8]] 70 | [7 normal [hp 9] [move 9] [attack 9]] 71 | 72 | [0 elite [hp 4] [move 2] [attack 3] [Bonuses {"shield 1"}]] 73 | [1 elite [hp 5] [move 3] [attack 4] [Bonuses {"shield 1"}]] 74 | [2 elite [hp 6] [move 4] [attack 5] [Bonuses {"shield 1"}]] 75 | [3 elite [hp 7] [move 5] [attack 6] [Bonuses {"shield 2"}]] 76 | [4 elite [hp 8] [move 6] [attack 7] [Bonuses {"shield 2"}]] 77 | [5 elite [hp 9] [move 7] [attack 8] [Bonuses {"shield 2"}]] 78 | [6 elite [hp 10] [move 8] [attack 9] [Bonuses {"shield 3"}]] 79 | [7 elite [hp 11] [move 9] [attack 10] [Bonuses {"shield 3"}]] 80 | end-monster 81 | 82 | begin-ability-deck 83 | "guard" 84 | 85 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 86 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 87 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 88 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 89 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 90 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 91 | ["rushing charge" 25 {"move +3" "attack +2 + number of spaces moved towards target"}] 92 | ["stand tall" 80 shuffle {"shield 3"}] 93 | end-ability-deck 94 | -------------------------------------------------------------------------------- /scribblings/defns/loot.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | 3 | @(require (for-label (except-in racket null) 4 | frosthaven-manager/defns 5 | frosthaven-manager/parsers/formula)) 6 | 7 | @title{Loot Deck} 8 | @defmodule[frosthaven-manager/defns/loot] 9 | 10 | @deftogether[( 11 | @defthing[material-kind? predicate/c] 12 | 13 | @defthing[lumber material-kind?] 14 | @defthing[metal material-kind?] 15 | @defthing[hide material-kind?] 16 | 17 | @defthing[material-kinds (listof material-kind?)] 18 | )]{ 19 | Represents materials for loot cards. 20 | 21 | Serializable. 22 | } 23 | 24 | @deftogether[( 25 | @defthing[herb-kind? predicate/c] 26 | 27 | @defthing[arrowvine herb-kind?] 28 | @defthing[axenut herb-kind?] 29 | @defthing[corpsecap herb-kind?] 30 | @defthing[flamefruit herb-kind?] 31 | @defthing[rockroot herb-kind?] 32 | @defthing[snowthistle herb-kind?] 33 | 34 | @defthing[herb-kinds (listof herb-kind?)] 35 | )]{ 36 | Represents herbs for loot cards. 37 | 38 | Serializable. 39 | } 40 | 41 | @deftogether[( 42 | @defthing[random-item? predicate/c] 43 | @defthing[random-item random-item?] 44 | )]{ 45 | Represents the random-item loot card. 46 | 47 | Serializable. 48 | } 49 | 50 | @defstruct*[money ([amount natural-number/c]) 51 | #:transparent]{ 52 | Represents a loot card worth 1 to 3 gold, but may have +1 stickers. 53 | 54 | Serializable. 55 | } 56 | 57 | @defstruct*[material 58 | ([name material-kind?] 59 | [amount (apply list/c (make-list (sub1 max-players) natural-number/c))]) 60 | #:transparent]{ 61 | Represents a loot card for a material; the amount varies by number of players. 62 | May have +1 stickers. 63 | 64 | Serializable. 65 | } 66 | 67 | @defproc[(material-amount* [m material?] [n num-players/c]) natural-number/c]{ 68 | Calculates the amount a material loot card @racket[m] is worth for the number of 69 | players @racket[n]. 70 | } 71 | 72 | @defstruct*[herb ([name herb-kind?] 73 | [amount natural-number/c]) 74 | #:transparent]{ 75 | Represents a loot card worth 1 @racket[name] herb, but may have +1 stickers. 76 | 77 | Serializable. 78 | } 79 | 80 | @defstruct*[special-loot ([name string?]) 81 | #:transparent]{ 82 | Represents a specially named loot card. This can be used for custom cards or for 83 | the standard loot cards with special properties. These loot cards are always 84 | included in the deck when available. 85 | 86 | Serializable. 87 | } 88 | 89 | @defthing[loot-card? 90 | predicate/c 91 | #:value (or/c money? material? herb? random-item? special-loot?)]{ 92 | This predicate recognizes valid loot cards. It is also a valid 93 | @racket[contract?]. 94 | } 95 | 96 | @defthing[loot-type/c 97 | flat-contract? 98 | #:value (or/c 'money material-kind? herb-kind? 'random-item 'special)]{ 99 | This contract recognizes the type of a loot card. 100 | } 101 | 102 | @defproc[(card->type [c loot-card?]) loot-type/c]{ 103 | Convert a loot card to its type. 104 | } 105 | 106 | @defproc[((format-loot-card [n num-players/c]) [card loot-card?]) string?]{ 107 | Formats a loot card for display. 108 | } 109 | 110 | @deftogether[( 111 | @defthing[max-money-cards natural-number/c] 112 | @defthing[max-material-cards natural-number/c] 113 | @defthing[max-herb-cards natural-number/c] 114 | @defthing[max-random-item-cards natural-number/c] 115 | )]{ 116 | Constants designating the maximum number of certain kinds of cards. 117 | } 118 | 119 | @deftogether[( 120 | @defthing[money-deck (apply list/c (make-list max-money-cards money?))] 121 | @defthing[material-decks (hash/c material-kind? (apply list/c (make-list max-material-cards material?)))] 122 | @defthing[herb-decks (hash/c herb-kind? (apply list/c (make-list max-herb-cards herb?)))] 123 | @defthing[standard-loot-deck (hash/c loot-type/c (listof loot-card?))] 124 | )]{ 125 | Standard decks of loot cards from which you draw to make the loot deck. 126 | } 127 | 128 | @defproc[(apply-sticker [card (and/c loot-card? 129 | (not/c random-item?) 130 | (not/c special-loot?))]) 131 | loot-card?]{ 132 | Returns @racket[card] with amounts increased by @racket[1]. 133 | } 134 | -------------------------------------------------------------------------------- /manager/ability-decks.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (provide 4 | (contract-out 5 | [struct ability-decks ([current (or/c #f monster-ability?)] 6 | [draw (listof monster-ability?)] 7 | [discard (listof monster-ability?)])] 8 | [ability-decks-draw-next (-> ability-decks? ability-decks?)] 9 | [ability-decks-discard-and-maybe-shuffle (-> ability-decks? ability-decks?)] 10 | [update-ability-decks 11 | (-> (-> string? ability-decks? ability-decks?) 12 | (-> (hash/c string? ability-decks?) 13 | (hash/c string? ability-decks?)))] 14 | [move-top-draw-to-bottom (-> ability-decks? ability-decks?)])) 15 | 16 | (require frosthaven-manager/curlique 17 | frosthaven-manager/defns 18 | racket/serialize) 19 | 20 | (module+ test (require rackunit)) 21 | 22 | (serializable-struct ability-decks [current draw discard] #:transparent) 23 | 24 | (define ability-decks-draw-next 25 | {~> (-< (~> ability-decks-draw (and (not empty?) first)) 26 | (~> ability-decks-draw (switch [(not empty?) rest])) 27 | ability-decks-discard) 28 | ability-decks}) 29 | 30 | (module+ test 31 | (test-case "ability-decks-draw-next" 32 | (check-equal? (ability-decks-draw-next (ability-decks #f '(3 4) '(1 2))) 33 | (ability-decks 3 '(4) '(1 2))) 34 | (check-equal? (ability-decks-draw-next (ability-decks #f '() '(1 2))) 35 | (ability-decks #f '() '(1 2))) 36 | ;; /!\ assumption that current is #f, or you lose a card: 37 | (check-equal? (ability-decks-draw-next (ability-decks 3 '(4) '(1 2))) 38 | (ability-decks 4 '() '(1 2))))) 39 | 40 | (define (ability-decks-discard-and-maybe-shuffle ad) 41 | (match-define (ability-decks current draw discard) ad) 42 | (define discard-with-current 43 | (if (monster-ability? current) 44 | (cons current discard) 45 | discard)) 46 | (define shuffle? 47 | (or (empty? draw) 48 | (on (current) 49 | (and monster-ability? monster-ability-shuffle?)))) 50 | (define-values (draw* discard*) 51 | (if shuffle? 52 | (values (shuffle (append draw discard-with-current)) empty) 53 | (values draw discard-with-current))) 54 | (ability-decks #f draw* discard*)) 55 | 56 | (module+ test 57 | (require frosthaven-manager/monster-db) 58 | (define-values {_info abilities} (get-dbs default-monster-db)) 59 | (define draw-pile (shuffle (hash-ref abilities "archer"))) 60 | (test-case "ability-decks-discard-and-maybe-shuffle" 61 | (for/fold ([ad (ability-decks #f draw-pile empty)]) 62 | ([_i (add1 (length draw-pile))]) 63 | (define ad* (ability-decks-discard-and-maybe-shuffle (ability-decks-draw-next ad))) 64 | ;; current card after drawing and discarding is always #f 65 | (check-equal? (ability-decks-current ad*) #f) 66 | (cond 67 | ;; discarding when draw is empty triggers shuffle 68 | [(= 1 (length (ability-decks-draw ad))) 69 | ;; |draw| = 1: after drawing, draw pile is empty 70 | (check-true (not (empty? (ability-decks-draw ad*)))) 71 | (check-equal? (length (ability-decks-draw ad*)) 72 | (length draw-pile)) 73 | (check-true (empty? (ability-decks-discard ad*)))] 74 | ;; when forced to shuffle, shuffle 75 | [(monster-ability-shuffle? (first (ability-decks-draw ad))) 76 | (check-true (not (empty? (ability-decks-draw ad*)))) 77 | (check-equal? (length (ability-decks-draw ad*)) 78 | (length draw-pile)) 79 | (check-true (empty? (ability-decks-discard ad*)))] 80 | ;; when draw pile wasn't empty and card didn't mandate shuffle, 81 | ;; drawn card should go in discard 82 | [else 83 | (check-not-false (member (first (ability-decks-draw ad)) 84 | (ability-decks-discard ad*))) 85 | (check-equal? (+ (length (ability-decks-draw ad*)) 86 | (length (ability-decks-discard ad*))) 87 | (length draw-pile))]) 88 | ad*) 89 | (void))) 90 | 91 | (define ((update-ability-decks f) ads) 92 | (for/fold ([result ads]) 93 | ([set (in-hash-keys ads)]) 94 | (hash-update result set (λ (ad) (f set ad))))) 95 | 96 | (define (move-top-draw-to-bottom ads) 97 | (define the-draw (ability-decks-draw ads)) 98 | (define new-draw 99 | (match the-draw 100 | ['() '()] 101 | [(cons top rest) (append rest (list top))])) 102 | (struct-copy ability-decks ads [draw new-draw])) 103 | --------------------------------------------------------------------------------