From 2d1c5c86f9edd36df5fd181dba1f798d1b418873 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Tue, 5 Dec 2023 14:12:23 -0800 Subject: [PATCH 01/22] (broken) wip, not compiling, still designing --- src/UI/DFRPG/Chargen.fs | 113 ++++++++++++++++++++++++++++++++++------ 1 file changed, 97 insertions(+), 16 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 58d060b..8b237c7 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -1,32 +1,113 @@ module UI.DFRPG.Chargen - +open Feliz +open Fable.React type Stuff = Foo | Bar type Weapon = Sword | Bow type Trait = WeaponMaster of Weapon | CombatReflexes | Skill of string * bonus:int -type Offer = Offer of Trait | OneOf of Offer list - with - static member skill(name, bonus) = Offer(Skill(name, bonus)) - static member skill(name, bonusRange) = bonusRange |> List.map (fun bonus -> Offer(Skill(name, bonus))) |> OneOf - static member either(offerings) = offerings |> OneOf +type Multimap<'key, 'value when 'key:comparison and 'value: comparison> = Map<'key, Set<'value>> +type OfferKey = System.Guid +let newKey() = System.Guid.NewGuid() +type SideEffects = unit +// payload will probably be a character in a given ruleset +type 'payload PendingChange = PendingChange of OfferKey * ('payload -> 'payload) + +type 'payload OfferOutput = { + stableState: 'payload // TODO: used for cost calculations + queuedChanges: 'payload PendingChange // TODO: used for cost calculations + mutable pickedOffers: OfferKey Set + mutable dataAugment: Map // some traits have levels + mutable children: Multimap + mutable parents: Map + mutable uiBuilder: Map ReactElement> + } + with static member root = System.Guid.NewGuid() // not persisted but that's okay -type Offers = ChooseN of int * Offer list | ChooseBudget of int * Offer list - with - member this.renderedOfferings() = notImpl() +// for scope-like properties as opposed to preorder output, e.g. whether we're within a "grant all these things" block +type OfferScope = { + autogrant: bool + remainingBudget: int option + } +type 'payload Offer = OfferScope -> 'payload OfferOutput -> SideEffects + +type Skill = { // stub, doesn't even have attribute + name: string + difficulty: int + } + +type DFRPGCharacter = { // stub + traits: Trait Set + } + +let checkbox (txt: string) (id: string) selected onChange = Html.div [ + Html.input [ + prop.type' "checkbox" + prop.isChecked selected + prop.onCheckedChange onChange + prop.id id + ] + Html.label [ + prop.htmlFor id + prop.text txt + ] + ] + +let offerLogic = + fun (key:OfferKey) innerLogic (output: 'payload OfferOutput) -> + // we could be in a state of notPicked, refining, or picked. When to show what? Depends on parent state, but do we expect parent to have already filtered us out? + // Three possibilities: + // 1. Parent not selected. In this case we won't even get here, don't need to worry about it. + // 2. Parent selected but we're not selected. In this case we need to enable selection, unless it would put us over budget, and then we just show it as unselectable. + // 3. Parent selected and we're also selected. In this case we need to enable deselection, unless it's "free", and then we just show it as perma-selected and un-deselectable. + let ui selected (txt: string) = + let id = $"chk_{key}" + let onChange v = if v then output.pickedOffers <- output.pickedOffers |> Set.add key else output.pickedOffers <- output.pickedOffers |> Set.remove key + output.uiBuilder <- output.uiBuilder |> Map.add key (function + | [] -> checkbox txt id selected onChange + | children when txt = "" -> Html.div [prop.children children] + | children -> Html.div [prop.children (checkbox txt id selected onChange::children)]) + if output.pickedOffers.Contains(key) then + innerLogic true (ui true) + else innerLogic false (ui false) + +let skill(name, bonus): DFRPGCharacter Offer = + let key = newKey() + fun scope output -> + let innerLogic selected ui = + ui $"{name} {bonus}" + output |> offerLogic key innerLogic +let either(choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = + let key = newKey() + fun scope output -> + let innerLogic selected ui = + for choice in choices do + choice scope output + ui "" // todo: maybe refactor this to ui.either + output |> offerLogic key innerLogic +let budgeted(budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = + let key = newKey() + fun scope output -> + let innerLogic selected ui = + for offer in offers do + offer scope output + output.uiBuilder <- output.uiBuilder |> Map.add key (function + | children -> Html.div [prop.children (Html.div "Choose [{budget}] from:"::children)]) + output |> offerLogic key innerLogic let swash() = [ - ChooseBudget(20, [ - Offer.skill("Acrobatics", 2) - Offer.skill("Acrobatics", [1..3]) - Offer.either([ - Offer.skill("Rapier", 20) - Offer.skill("Broadsword", 20) + + budgeted(20, [ + skill("Acrobatics", 2) + skill("Acrobatics", [1..3]) + either([ + skill("Rapier", 20) + skill("Broadsword", 20) ]) ]) ] type Model = { - template: Offers list + template: DFRPGCharacter Offer list } let init _ = { template = swash() } From 036271865e4ca01dbe8e248bafdbcde11daf2bac Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Thu, 7 Dec 2023 12:24:55 -0800 Subject: [PATCH 02/22] wip --- src/UI/DFRPG/Chargen.fs | 106 +++++++++++++++++++++++++++--------- src/UI/DFRPG/ChargenView.fs | 27 +-------- 2 files changed, 83 insertions(+), 50 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 8b237c7..0a50f4e 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -14,21 +14,37 @@ type 'payload PendingChange = PendingChange of OfferKey * ('payload -> 'payload) type 'payload OfferOutput = { stableState: 'payload // TODO: used for cost calculations - queuedChanges: 'payload PendingChange // TODO: used for cost calculations + queuedChanges: 'payload PendingChange list // TODO: used for cost calculations mutable pickedOffers: OfferKey Set mutable dataAugment: Map // some traits have levels mutable children: Multimap mutable parents: Map mutable uiBuilder: Map ReactElement> } - with static member root = System.Guid.NewGuid() // not persisted but that's okay + with + static member root = System.Guid.NewGuid() // not persisted but that's okay + static member fresh payload pending = { stableState = payload; queuedChanges = pending; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty } + member this.toReactElements() = + // do a post-order traversal of the offer tree, gathering up the UI elements wherever they exist + let root = OfferOutput<_>.root + let rec recur (key:OfferKey) = + match this.children |> Map.tryFind key with + | Some (children: OfferKey Set) -> + let combine = this.uiBuilder[key] // if there's no uiBuilder then there's no visuals and there shouldn't be any children either + let uis = children |> Set.toList |> List.map recur + let ui = combine uis + ui + | None -> + this.uiBuilder[key] [] + recur root // for scope-like properties as opposed to preorder output, e.g. whether we're within a "grant all these things" block type OfferScope = { autogrant: bool remainingBudget: int option + parent: OfferKey } -type 'payload Offer = OfferScope -> 'payload OfferOutput -> SideEffects +type 'payload Offer = OfferScope * 'payload OfferOutput -> OfferKey type Skill = { // stub, doesn't even have attribute name: string @@ -38,6 +54,7 @@ type Skill = { // stub, doesn't even have attribute type DFRPGCharacter = { // stub traits: Trait Set } + with static member fresh = { traits = Set.empty } let checkbox (txt: string) (id: string) selected onChange = Html.div [ Html.input [ @@ -52,47 +69,84 @@ let checkbox (txt: string) (id: string) selected onChange = Html.div [ ] ] +type API = { + offering: string -> unit // description -> () with a checkbox + label: string -> unit // description -> () but no checkbox, only text e.g. "choose 20 from" + } + let offerLogic = - fun (key:OfferKey) innerLogic (output: 'payload OfferOutput) -> + fun (key:OfferKey) innerLogic (scope: OfferScope, output: 'payload OfferOutput) -> + let selected = output.pickedOffers.Contains key + // we could be in a state of notPicked, refining, or picked. When to show what? Depends on parent state, but do we expect parent to have already filtered us out? // Three possibilities: // 1. Parent not selected. In this case we won't even get here, don't need to worry about it. // 2. Parent selected but we're not selected. In this case we need to enable selection, unless it would put us over budget, and then we just show it as unselectable. // 3. Parent selected and we're also selected. In this case we need to enable deselection, unless it's "free", and then we just show it as perma-selected and un-deselectable. - let ui selected (txt: string) = + + // It is the child's responsibility to set up parent/child relationships + let child = key in ( + output.parents <- output.parents |> Map.add child scope.parent + output.children <- output.children |> Map.change scope.parent (Option.orElse (Some Set.empty) >> Option.map (Set.add child)) + ) + + let uiCheckbox selected (txt: string) = let id = $"chk_{key}" let onChange v = if v then output.pickedOffers <- output.pickedOffers |> Set.add key else output.pickedOffers <- output.pickedOffers |> Set.remove key output.uiBuilder <- output.uiBuilder |> Map.add key (function | [] -> checkbox txt id selected onChange | children when txt = "" -> Html.div [prop.children children] - | children -> Html.div [prop.children (checkbox txt id selected onChange::children)]) - if output.pickedOffers.Contains(key) then - innerLogic true (ui true) - else innerLogic false (ui false) + | children -> Html.div [prop.children (checkbox txt id selected onChange::children)] + ) + let uiLabel (txt: string) = + output.uiBuilder <- output.uiBuilder |> Map.add key (function + | children -> Html.div [prop.children ((Html.text txt)::children)] + ) + + let api: API = { + offering = uiCheckbox selected + label = uiLabel + } + innerLogic selected api + key + +let recur key (scope, output) offer = + offer ({ scope with parent = key }, output) + +let run (offers: _ Offer list) state pending : _ OfferOutput = + let root = OfferOutput<_>.root + let output = OfferOutput<_>.fresh state pending + let scope = { autogrant = false; remainingBudget = None; parent = root } + output.uiBuilder <- output.uiBuilder |> Map.add root (function + | [child] -> child + | children -> Html.div [prop.children children] + ) + output let skill(name, bonus): DFRPGCharacter Offer = let key = newKey() - fun scope output -> - let innerLogic selected ui = - ui $"{name} {bonus}" - output |> offerLogic key innerLogic + fun ((scope, output) as args) -> + let innerLogic selected (ui:API) = + ui.offering $"{name} {bonus}" + offerLogic key innerLogic args let either(choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = let key = newKey() - fun scope output -> - let innerLogic selected ui = - for choice in choices do - choice scope output - ui "" // todo: maybe refactor this to ui.either - output |> offerLogic key innerLogic + fun ((scope, output) as args) -> + let innerLogic selected (ui:API) = + if selected then + let children = choices |> List.map (recur key args) + ui.label "Choose one of:" + offerLogic key innerLogic args let budgeted(budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = let key = newKey() - fun scope output -> - let innerLogic selected ui = - for offer in offers do - offer scope output - output.uiBuilder <- output.uiBuilder |> Map.add key (function - | children -> Html.div [prop.children (Html.div "Choose [{budget}] from:"::children)]) - output |> offerLogic key innerLogic + fun ((scope, output) as args) -> + let innerLogic selected (ui:API) = + if selected then + let children = offers |> List.map (recur key args) + ui.label "Choose [{budget}] from:" + output.uiBuilder <- output.uiBuilder |> Map.add key (function + | children -> Html.div [prop.children (Html.div "Choose [{budget}] from:"::children)]) + offerLogic key innerLogic args let swash() = [ diff --git a/src/UI/DFRPG/ChargenView.fs b/src/UI/DFRPG/ChargenView.fs index 0e8b353..f3f2702 100644 --- a/src/UI/DFRPG/ChargenView.fs +++ b/src/UI/DFRPG/ChargenView.fs @@ -5,27 +5,6 @@ open UI.DFRPG.Chargen [] let View() = let model, dispatch = React.useElmishSimple init update - - Html.div [ - let rec renderOffer = function - | OneOf offers -> - Html.ul [ - for offer in offers do - Html.li [prop.children [renderOffer offer]] - ] - | Offer offer -> - Html.text (offer.ToString()) - let rec renderOffers = function - | ChooseBudget (points, offers) -> - Html.div [ - Html.div [prop.text $"Choose {points} points:"] - for offer in offers do renderOffer offer - ] - | ChooseN (n, offers) -> - Html.div [ - Html.div [prop.text $"Choose {n}"] - for offer in offers do renderOffer offer - ] - for offers in model.template do - renderOffers offers - ] \ No newline at end of file + let profession = model.template[0] + let output = run [profession] DFRPGCharacter.fresh [] + output.toReactElements() From 82081ca3bcdcd11b806db39576d25c66501954bd Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Thu, 7 Dec 2023 17:57:09 -0800 Subject: [PATCH 03/22] (nonfunctional) wip, refactoring error code, still not showing error correctly after first dismissal --- src/Main.fs | 2 +- src/UI/CommonUI.fs | 28 ++++++++++++++-------------- src/UI/DFRPG/Chargen.fs | 3 +++ src/UI/DFRPG/ChargenView.fs | 5 +++-- 4 files changed, 21 insertions(+), 17 deletions(-) diff --git a/src/Main.fs b/src/Main.fs index 8c619c4..29aca8c 100644 --- a/src/Main.fs +++ b/src/Main.fs @@ -33,7 +33,7 @@ let Router() = ] let main() = - ReactErrorBoundary.renderCatchSimple ReactErrorBoundary.err <| Router() + ReactErrorBoundary.renderCatchSimple (Router()) let root = ReactDOM.createRoot(document.getElementById "feliz-app") root.render(Html.div [ main() ]) diff --git a/src/UI/CommonUI.fs b/src/UI/CommonUI.fs index 50cdaf2..7cdbfb2 100644 --- a/src/UI/CommonUI.fs +++ b/src/UI/CommonUI.fs @@ -51,18 +51,10 @@ module ReactErrorBoundary = open Fable open Fable.Core.JsInterop - let err msg clearError = - class' "error" Html.div [ - Html.text $"There has been an error: {msg}" - Html.div [ - Html.button [ prop.onClick (fun _ -> clearError()); prop.children [Html.text "Dismiss"] ] - ] - ] - [] let WindowProtector(error, setError, child) = - React.useWindowListener.onError(fun (ev: Browser.Types.UIEvent) -> setError (Some (ev?message: string))) - React.useWindowListener.onUnhandledRejection(fun (ev: Browser.Types.PromiseRejectionEvent) -> setError (Some (ev.reason.ToString()))) + React.useWindowListener.onError(fun (ev: Browser.Types.UIEvent) -> setError (Some ("[window] " + ev?message: string))) + React.useWindowListener.onUnhandledRejection(fun (ev: Browser.Types.PromiseRejectionEvent) -> setError (Some ("[unhandled rejection] " + ev.reason.ToString()))) let child = Html.div [prop.children [child]; prop.style [Feliz.style.margin (length.px 0); if Option.isSome error then Feliz.style.display.none]] React.fragment [ child @@ -82,7 +74,7 @@ module ReactErrorBoundary = type ErrorBoundaryProps = { Inner : React.ReactElement - ErrorComponent : string -> (unit -> unit) -> React.ReactElement + ErrorComponent : string -> (string option -> unit) -> React.ReactElement OnError : exn * InfoComponentObject -> unit } type ErrorBoundaryState = @@ -101,10 +93,18 @@ module ReactErrorBoundary = override this.render() = let setError v = this.setState(fun _ _ -> { Error = v }) - WindowProtector(this.state.Error, setError, if this.state.Error.IsSome then Html.div (this.state.Error.ToString()) else this.props.Inner) + WindowProtector(this.state.Error, setError, if this.state.Error.IsSome then this.props.ErrorComponent (this.state.Error.Value) setError else this.props.Inner) + + let err (error: string) (setError: (string option -> unit)) = + class' "error" Html.div [ + Html.text $"There has been an error: {error}" + Html.div [ + Html.button [ prop.onClick (fun _ -> setError None); prop.children [Html.text "Dismiss"] ] + ] + ] - let renderCatchSimple errorElement element = - ReactElementType.create ReactElementType.ofComponent { Inner = element; ErrorComponent = errorElement; OnError = fun _ -> () } [ ] + let renderCatchSimple element = + ReactElementType.create ReactElementType.ofComponent { Inner = element; ErrorComponent = err; OnError = fun _ -> () } [ ] let renderCatchFn onError errorElement element = ReactElementType.create ReactElementType.ofComponent { Inner = element; ErrorComponent = errorElement; OnError = onError } [ ] diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 0a50f4e..aa38220 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -30,6 +30,9 @@ type 'payload OfferOutput = { let rec recur (key:OfferKey) = match this.children |> Map.tryFind key with | Some (children: OfferKey Set) -> + if not (this.pickedOffers.Contains key) then + // if we're not picked, we don't need to render anything + shouldntHappen "if there's no uiBuilder then there's no visuals and there shouldn't be any children either" let combine = this.uiBuilder[key] // if there's no uiBuilder then there's no visuals and there shouldn't be any children either let uis = children |> Set.toList |> List.map recur let ui = combine uis diff --git a/src/UI/DFRPG/ChargenView.fs b/src/UI/DFRPG/ChargenView.fs index f3f2702..1a6dab9 100644 --- a/src/UI/DFRPG/ChargenView.fs +++ b/src/UI/DFRPG/ChargenView.fs @@ -6,5 +6,6 @@ open UI.DFRPG.Chargen let View() = let model, dispatch = React.useElmishSimple init update let profession = model.template[0] - let output = run [profession] DFRPGCharacter.fresh [] - output.toReactElements() + // let output = run [profession] DFRPGCharacter.fresh [] + // output.toReactElements() + shouldntHappen "This error should be caught by React Boundary and displayed in the UI, but it isn't. Or at least, it isn't after the first Dismiss. Instead it triggers some kind of React error about updating during render()." From 16e65753820bb22a8f117936ee8365577c6600b9 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 18:20:00 -0800 Subject: [PATCH 04/22] still wip on error --- src/UI/CommonUI.fs | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/UI/CommonUI.fs b/src/UI/CommonUI.fs index 7cdbfb2..dda9f17 100644 --- a/src/UI/CommonUI.fs +++ b/src/UI/CommonUI.fs @@ -52,21 +52,10 @@ module ReactErrorBoundary = open Fable.Core.JsInterop [] - let WindowProtector(error, setError, child) = + let WindowProtector setError = React.useWindowListener.onError(fun (ev: Browser.Types.UIEvent) -> setError (Some ("[window] " + ev?message: string))) React.useWindowListener.onUnhandledRejection(fun (ev: Browser.Types.PromiseRejectionEvent) -> setError (Some ("[unhandled rejection] " + ev.reason.ToString()))) - let child = Html.div [prop.children [child]; prop.style [Feliz.style.margin (length.px 0); if Option.isSome error then Feliz.style.display.none]] React.fragment [ - child - match error with - | Some error -> - class' "error" Html.div [ - Html.text $"There has been an error: {error}" - Html.div [ - Html.button [ prop.onClick (fun _ -> setError None); prop.children [Html.text "Dismiss"] ] - ] - ] - | None -> () ] type [] InfoComponentObject = @@ -89,12 +78,17 @@ module ReactErrorBoundary = override this.componentDidCatch(error, info) = let info = info :?> InfoComponentObject this.props.OnError(error, info) + printfn "componentDidCatch %A" error this.setState(fun _ _ -> { Error = Some (error.ToString()) }) override this.render() = let setError v = this.setState(fun _ _ -> { Error = v }) - WindowProtector(this.state.Error, setError, if this.state.Error.IsSome then this.props.ErrorComponent (this.state.Error.Value) setError else this.props.Inner) - + React.fragment [ + // WindowProtector setError + match this.state.Error with + | Some err -> this.props.ErrorComponent err setError + | None -> this.props.Inner + ] let err (error: string) (setError: (string option -> unit)) = class' "error" Html.div [ Html.text $"There has been an error: {error}" From c16067d85bdeaada83bc7beb1d91d5b646ea891c Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 18:27:29 -0800 Subject: [PATCH 05/22] Don't let WindowProtector throw on the UI thread, because that somehow interferes with React Error Boundary and makes it crash even harder --- src/UI/CommonUI.fs | 2 +- src/UI/DFRPG/ChargenView.fs | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/UI/CommonUI.fs b/src/UI/CommonUI.fs index dda9f17..0be6754 100644 --- a/src/UI/CommonUI.fs +++ b/src/UI/CommonUI.fs @@ -84,7 +84,7 @@ module ReactErrorBoundary = override this.render() = let setError v = this.setState(fun _ _ -> { Error = v }) React.fragment [ - // WindowProtector setError + WindowProtector (fun exn -> task { setError exn } |> ignore) match this.state.Error with | Some err -> this.props.ErrorComponent err setError | None -> this.props.Inner diff --git a/src/UI/DFRPG/ChargenView.fs b/src/UI/DFRPG/ChargenView.fs index 1a6dab9..f3f2702 100644 --- a/src/UI/DFRPG/ChargenView.fs +++ b/src/UI/DFRPG/ChargenView.fs @@ -6,6 +6,5 @@ open UI.DFRPG.Chargen let View() = let model, dispatch = React.useElmishSimple init update let profession = model.template[0] - // let output = run [profession] DFRPGCharacter.fresh [] - // output.toReactElements() - shouldntHappen "This error should be caught by React Boundary and displayed in the UI, but it isn't. Or at least, it isn't after the first Dismiss. Instead it triggers some kind of React error about updating during render()." + let output = run [profession] DFRPGCharacter.fresh [] + output.toReactElements() From 1893ad9f389687cf47dc408fa7ea5d46ee7d9979 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 19:00:43 -0800 Subject: [PATCH 06/22] Improve error output to include stack trace when exception occurs during render (but not for window.onError or for unhandled promise rejections--maybe in the future we can handle those cases) --- src/UI/CommonUI.fs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/UI/CommonUI.fs b/src/UI/CommonUI.fs index 0be6754..6b7db69 100644 --- a/src/UI/CommonUI.fs +++ b/src/UI/CommonUI.fs @@ -78,20 +78,20 @@ module ReactErrorBoundary = override this.componentDidCatch(error, info) = let info = info :?> InfoComponentObject this.props.OnError(error, info) - printfn "componentDidCatch %A" error - this.setState(fun _ _ -> { Error = Some (error.ToString()) }) + printfn "componentDidCatch %A" error.StackTrace + this.setState(fun _ _ -> { Error = Some (sprintf "%A %A" error.Message error.StackTrace) }) override this.render() = - let setError v = this.setState(fun _ _ -> { Error = v }) + let setErrorFromString v = this.setState(fun _ _ ->{ Error = v }) // won't have a stack trace if it doesn't come from an exception React.fragment [ - WindowProtector (fun exn -> task { setError exn } |> ignore) + WindowProtector (fun exn -> task { setErrorFromString exn } |> ignore) match this.state.Error with - | Some err -> this.props.ErrorComponent err setError + | Some err -> this.props.ErrorComponent err setErrorFromString | None -> this.props.Inner ] let err (error: string) (setError: (string option -> unit)) = class' "error" Html.div [ - Html.text $"There has been an error: {error}" + yield! ("There has been an error:" :: (error.Split("\n") |> List.ofArray)) |> List.map Html.div Html.div [ Html.button [ prop.onClick (fun _ -> setError None); prop.children [Html.text "Dismiss"] ] ] From ce81b21308f9d802ef308c5a205022f3ba27e46c Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 22:22:10 -0800 Subject: [PATCH 07/22] Bugfix: root offerKey should be stable, not regenerated on every call --- src/UI/DFRPG/Chargen.fs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index aa38220..0af2eb8 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -22,11 +22,12 @@ type 'payload OfferOutput = { mutable uiBuilder: Map ReactElement> } with - static member root = System.Guid.NewGuid() // not persisted but that's okay + static let root = System.Guid.NewGuid() // not persisted but that's okay + static member Root = root static member fresh payload pending = { stableState = payload; queuedChanges = pending; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty } member this.toReactElements() = // do a post-order traversal of the offer tree, gathering up the UI elements wherever they exist - let root = OfferOutput<_>.root + let root = root let rec recur (key:OfferKey) = match this.children |> Map.tryFind key with | Some (children: OfferKey Set) -> @@ -38,7 +39,9 @@ type 'payload OfferOutput = { let ui = combine uis ui | None -> - this.uiBuilder[key] [] + match this.uiBuilder |> Map.tryFind key with + | Some builder -> builder [] + | None -> Html.div $"no uiBuilder for {key}" recur root // for scope-like properties as opposed to preorder output, e.g. whether we're within a "grant all these things" block @@ -47,7 +50,7 @@ type OfferScope = { remainingBudget: int option parent: OfferKey } -type 'payload Offer = OfferScope * 'payload OfferOutput -> OfferKey +type 'payload Offer = OfferScope * 'payload OfferOutput -> SideEffects type Skill = { // stub, doesn't even have attribute name: string @@ -111,15 +114,16 @@ let offerLogic = label = uiLabel } innerLogic selected api - key let recur key (scope, output) offer = offer ({ scope with parent = key }, output) let run (offers: _ Offer list) state pending : _ OfferOutput = - let root = OfferOutput<_>.root + let root = OfferOutput<_>.Root let output = OfferOutput<_>.fresh state pending let scope = { autogrant = false; remainingBudget = None; parent = root } + for offer in offers do + recur root (scope, output) offer output.uiBuilder <- output.uiBuilder |> Map.add root (function | [child] -> child | children -> Html.div [prop.children children] From d253827ae97a5d42d5156f9ce5947ebcf2215169 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 22:31:22 -0800 Subject: [PATCH 08/22] Use async in Fable, not task --- src/UI/CommonUI.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/UI/CommonUI.fs b/src/UI/CommonUI.fs index 6b7db69..8152000 100644 --- a/src/UI/CommonUI.fs +++ b/src/UI/CommonUI.fs @@ -84,7 +84,7 @@ module ReactErrorBoundary = override this.render() = let setErrorFromString v = this.setState(fun _ _ ->{ Error = v }) // won't have a stack trace if it doesn't come from an exception React.fragment [ - WindowProtector (fun exn -> task { setErrorFromString exn } |> ignore) + WindowProtector (fun exn -> async { setErrorFromString exn } |> Async.StartImmediate) match this.state.Error with | Some err -> this.props.ErrorComponent err setErrorFromString | None -> this.props.Inner From 97c4e2f312ec9ce6deabfa35ef5329752d74b11d Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 22:47:03 -0800 Subject: [PATCH 09/22] Better error messages for window.onError and trace --- src/Core/Common.fs | 1 + src/UI/CommonUI.fs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Core/Common.fs b/src/Core/Common.fs index 65188ce..864c0c0 100644 --- a/src/Core/Common.fs +++ b/src/Core/Common.fs @@ -423,6 +423,7 @@ module Trie = let inline trace v = #if DEBUG printfn "Trace: %A" v + System.Console.WriteLine(box v) #endif v diff --git a/src/UI/CommonUI.fs b/src/UI/CommonUI.fs index 8152000..057556e 100644 --- a/src/UI/CommonUI.fs +++ b/src/UI/CommonUI.fs @@ -53,7 +53,7 @@ module ReactErrorBoundary = [] let WindowProtector setError = - React.useWindowListener.onError(fun (ev: Browser.Types.UIEvent) -> setError (Some ("[window] " + ev?message: string))) + React.useWindowListener.onError(fun (ev: Browser.Types.UIEvent) -> setError (Some ("[window] " + (if ev?error then ev?error?msg else ev?message): string))) React.useWindowListener.onUnhandledRejection(fun (ev: Browser.Types.PromiseRejectionEvent) -> setError (Some ("[unhandled rejection] " + ev.reason.ToString()))) React.fragment [ ] From 0e64706aaa0b727bc6f654570aadcfa2d4f28638 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 22:48:04 -0800 Subject: [PATCH 10/22] Workaround Fable limitation: static let bindings on record fields don't work yet, confuse the Fable-generated ctor. Updating to latest Fable didn't help but keeping the update anyway. --- .config/dotnet-tools.json | 2 +- src/UI/DFRPG/Chargen.fs | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 8f7195a..ed51fab 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -3,7 +3,7 @@ "isRoot": true, "tools": { "fable": { - "version": "4.5.0", + "version": "4.7.0", "commands": [ "fable" ] diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 0af2eb8..826ef13 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -12,6 +12,8 @@ type SideEffects = unit // payload will probably be a character in a given ruleset type 'payload PendingChange = PendingChange of OfferKey * ('payload -> 'payload) +let offerRoot = System.Guid.NewGuid() // not persisted but that's okay + type 'payload OfferOutput = { stableState: 'payload // TODO: used for cost calculations queuedChanges: 'payload PendingChange list // TODO: used for cost calculations @@ -22,12 +24,10 @@ type 'payload OfferOutput = { mutable uiBuilder: Map ReactElement> } with - static let root = System.Guid.NewGuid() // not persisted but that's okay - static member Root = root static member fresh payload pending = { stableState = payload; queuedChanges = pending; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty } member this.toReactElements() = // do a post-order traversal of the offer tree, gathering up the UI elements wherever they exist - let root = root + let root = offerRoot let rec recur (key:OfferKey) = match this.children |> Map.tryFind key with | Some (children: OfferKey Set) -> @@ -119,8 +119,8 @@ let recur key (scope, output) offer = offer ({ scope with parent = key }, output) let run (offers: _ Offer list) state pending : _ OfferOutput = - let root = OfferOutput<_>.Root - let output = OfferOutput<_>.fresh state pending + let root = offerRoot + let output = OfferOutput<_>.fresh state pending |> trace let scope = { autogrant = false; remainingBudget = None; parent = root } for offer in offers do recur root (scope, output) offer From cfecf8596179bb5ac4429af6aceb2826da820958 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 22:48:43 -0800 Subject: [PATCH 11/22] Remove trace inside of run --- src/UI/DFRPG/Chargen.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 826ef13..0ffc055 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -120,7 +120,7 @@ let recur key (scope, output) offer = let run (offers: _ Offer list) state pending : _ OfferOutput = let root = offerRoot - let output = OfferOutput<_>.fresh state pending |> trace + let output = OfferOutput<_>.fresh state pending let scope = { autogrant = false; remainingBudget = None; parent = root } for offer in offers do recur root (scope, output) offer From 92fe831e1ea446a4a2b72de742ad85c762602a17 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 22:55:15 -0800 Subject: [PATCH 12/22] Another correction to react boundary logic to unpack a slightly different error format --- src/UI/CommonUI.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/UI/CommonUI.fs b/src/UI/CommonUI.fs index 057556e..153dfeb 100644 --- a/src/UI/CommonUI.fs +++ b/src/UI/CommonUI.fs @@ -78,8 +78,8 @@ module ReactErrorBoundary = override this.componentDidCatch(error, info) = let info = info :?> InfoComponentObject this.props.OnError(error, info) - printfn "componentDidCatch %A" error.StackTrace - this.setState(fun _ _ -> { Error = Some (sprintf "%A %A" error.Message error.StackTrace) }) + let error = if error?msg then error?msg elif error?error && error?error?msg then error?error?msg else error?Message + error?StackTrace + this.setState(fun _ _ -> { Error = Some error }) override this.render() = let setErrorFromString v = this.setState(fun _ _ ->{ Error = v }) // won't have a stack trace if it doesn't come from an exception From 240b193051af02a2fc4e00a96d96f154cc75529b Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 23:50:18 -0800 Subject: [PATCH 13/22] Improve error messages further (and the issue turns out to be in root) --- src/UI/DFRPG/Chargen.fs | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 0ffc055..80797e6 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -6,13 +6,13 @@ type Weapon = Sword | Bow type Trait = WeaponMaster of Weapon | CombatReflexes | Skill of string * bonus:int type Multimap<'key, 'value when 'key:comparison and 'value: comparison> = Map<'key, Set<'value>> -type OfferKey = System.Guid -let newKey() = System.Guid.NewGuid() +type OfferKey = string // should include a guid +let newKey (prefix:string) = $"{prefix}-{System.Guid.NewGuid()}" type SideEffects = unit // payload will probably be a character in a given ruleset type 'payload PendingChange = PendingChange of OfferKey * ('payload -> 'payload) -let offerRoot = System.Guid.NewGuid() // not persisted but that's okay +let offerRoot = newKey "root" // not persisted but that's okay type 'payload OfferOutput = { stableState: 'payload // TODO: used for cost calculations @@ -33,7 +33,7 @@ type 'payload OfferOutput = { | Some (children: OfferKey Set) -> if not (this.pickedOffers.Contains key) then // if we're not picked, we don't need to render anything - shouldntHappen "if there's no uiBuilder then there's no visuals and there shouldn't be any children either" + shouldntHappen $"if there's no uiBuilder for {key} then there's no visuals and there shouldn't be any children either" let combine = this.uiBuilder[key] // if there's no uiBuilder then there's no visuals and there shouldn't be any children either let uis = children |> Set.toList |> List.map recur let ui = combine uis @@ -131,35 +131,41 @@ let run (offers: _ Offer list) state pending : _ OfferOutput = output let skill(name, bonus): DFRPGCharacter Offer = - let key = newKey() + let key = newKey $"{name} %+d{bonus}" fun ((scope, output) as args) -> let innerLogic selected (ui:API) = ui.offering $"{name} {bonus}" offerLogic key innerLogic args +let skillRange(name, bonusRange: int list): DFRPGCharacter Offer = + let key = newKey $"{name} {bonusRange}" + fun ((scope, output) as args) -> + let innerLogic selected (ui:API) = + ui.offering $"{name} {bonusRange[0]}" + offerLogic key innerLogic args let either(choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = - let key = newKey() + let key = newKey $"one-of-{choices.Length}" fun ((scope, output) as args) -> let innerLogic selected (ui:API) = if selected then - let children = choices |> List.map (recur key args) - ui.label "Choose one of:" + choices |> List.iter (recur key args) + ui.label "Choose one of:" offerLogic key innerLogic args let budgeted(budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = - let key = newKey() + let key = newKey $"budget-{budget}" fun ((scope, output) as args) -> let innerLogic selected (ui:API) = if selected then - let children = offers |> List.map (recur key args) - ui.label "Choose [{budget}] from:" - output.uiBuilder <- output.uiBuilder |> Map.add key (function - | children -> Html.div [prop.children (Html.div "Choose [{budget}] from:"::children)]) + offers |> List.iter (recur key args) + ui.label "Choose [{budget}] from:" + output.uiBuilder <- output.uiBuilder |> Map.add key (function + | children -> Html.div [prop.children (Html.div "Choose [{budget}] from:"::children)]) offerLogic key innerLogic args let swash() = [ budgeted(20, [ skill("Acrobatics", 2) - skill("Acrobatics", [1..3]) + skillRange("Acrobatics", [1..3]) either([ skill("Rapier", 20) skill("Broadsword", 20) From 347365bd9c552a45694436c1ec3bf5697b636bbe Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sat, 9 Dec 2023 23:58:32 -0800 Subject: [PATCH 14/22] Remove misleading error message with wrong field name. --- src/Core/Common.fs | 4 +++- src/UI/DFRPG/Chargen.fs | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Core/Common.fs b/src/Core/Common.fs index 864c0c0..d84c8dc 100644 --- a/src/Core/Common.fs +++ b/src/Core/Common.fs @@ -420,10 +420,12 @@ module Trie = node // treat unusable indexes as no-op recur ixs trie +let inline log v = System.Console.WriteLine (box v) +let inline logM (msg:string) v = log msg; log v let inline trace v = #if DEBUG printfn "Trace: %A" v - System.Console.WriteLine(box v) + log v #endif v diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 80797e6..a74d295 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -31,7 +31,7 @@ type 'payload OfferOutput = { let rec recur (key:OfferKey) = match this.children |> Map.tryFind key with | Some (children: OfferKey Set) -> - if not (this.pickedOffers.Contains key) then + if not (this.uiBuilder.ContainsKey key) then // if we're not picked, we don't need to render anything shouldntHappen $"if there's no uiBuilder for {key} then there's no visuals and there shouldn't be any children either" let combine = this.uiBuilder[key] // if there's no uiBuilder then there's no visuals and there shouldn't be any children either From 394455c524f6227d33f6856d70016d4830229a20 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sun, 10 Dec 2023 11:33:42 -0800 Subject: [PATCH 15/22] (now only partly-broken) root things are showing up but not checkboxes within budgeted --- src/UI/DFRPG/Chargen.fs | 18 +++++++++++------- src/UI/DFRPG/ChargenView.fs | 4 ++-- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index a74d295..44eada0 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -6,6 +6,7 @@ type Weapon = Sword | Bow type Trait = WeaponMaster of Weapon | CombatReflexes | Skill of string * bonus:int type Multimap<'key, 'value when 'key:comparison and 'value: comparison> = Map<'key, Set<'value>> +type OrderedMultimap<'key, 'value when 'key:comparison and 'value: comparison> = Map<'key, List<'value>> type OfferKey = string // should include a guid let newKey (prefix:string) = $"{prefix}-{System.Guid.NewGuid()}" type SideEffects = unit @@ -19,7 +20,7 @@ type 'payload OfferOutput = { queuedChanges: 'payload PendingChange list // TODO: used for cost calculations mutable pickedOffers: OfferKey Set mutable dataAugment: Map // some traits have levels - mutable children: Multimap + mutable children: OrderedMultimap mutable parents: Map mutable uiBuilder: Map ReactElement> } @@ -30,12 +31,12 @@ type 'payload OfferOutput = { let root = offerRoot let rec recur (key:OfferKey) = match this.children |> Map.tryFind key with - | Some (children: OfferKey Set) -> + | Some (children: OfferKey list) -> if not (this.uiBuilder.ContainsKey key) then // if we're not picked, we don't need to render anything shouldntHappen $"if there's no uiBuilder for {key} then there's no visuals and there shouldn't be any children either" let combine = this.uiBuilder[key] // if there's no uiBuilder then there's no visuals and there shouldn't be any children either - let uis = children |> Set.toList |> List.map recur + let uis = children |> List.map recur let ui = combine uis ui | None -> @@ -93,7 +94,7 @@ let offerLogic = // It is the child's responsibility to set up parent/child relationships let child = key in ( output.parents <- output.parents |> Map.add child scope.parent - output.children <- output.children |> Map.change scope.parent (Option.orElse (Some Set.empty) >> Option.map (Set.add child)) + output.children <- output.children |> Map.change scope.parent (Option.orElse (Some []) >> Option.map (flip List.append [child])) ) let uiCheckbox selected (txt: string) = @@ -150,19 +151,22 @@ let either(choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = choices |> List.iter (recur key args) ui.label "Choose one of:" offerLogic key innerLogic args +type style = Feliz.style let budgeted(budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = let key = newKey $"budget-{budget}" fun ((scope, output) as args) -> let innerLogic selected (ui:API) = if selected then offers |> List.iter (recur key args) - ui.label "Choose [{budget}] from:" + if not selected then + output.pickedOffers <- output.pickedOffers |> Set.add key output.uiBuilder <- output.uiBuilder |> Map.add key (function - | children -> Html.div [prop.children (Html.div "Choose [{budget}] from:"::children)]) + | children -> Html.div [prop.children (Html.div $"Choose [{budget}] from:"::children)]) offerLogic key innerLogic args let swash() = [ - + skill("climbing", 1) + skillRange("stealth", [1..3]) budgeted(20, [ skill("Acrobatics", 2) skillRange("Acrobatics", [1..3]) diff --git a/src/UI/DFRPG/ChargenView.fs b/src/UI/DFRPG/ChargenView.fs index f3f2702..046faf5 100644 --- a/src/UI/DFRPG/ChargenView.fs +++ b/src/UI/DFRPG/ChargenView.fs @@ -5,6 +5,6 @@ open UI.DFRPG.Chargen [] let View() = let model, dispatch = React.useElmishSimple init update - let profession = model.template[0] - let output = run [profession] DFRPGCharacter.fresh [] + let profession = model.template + let output = run profession DFRPGCharacter.fresh [] output.toReactElements() From 3cb0eb48196f276aec6f81447df8b1c4e141b4cf Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sun, 10 Dec 2023 11:51:34 -0800 Subject: [PATCH 16/22] Initial list display --- main.sass | 2 ++ src/UI/DFRPG/Chargen.fs | 44 +++++++++++++++++++---------------------- 2 files changed, 22 insertions(+), 24 deletions(-) diff --git a/main.sass b/main.sass index 5fc5dd3..ba820d0 100644 --- a/main.sass +++ b/main.sass @@ -94,6 +94,8 @@ ul 100% transform: scale(0) +.control + user-select: none .hasMargins box-sizing: border-box margin: 3px diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 44eada0..d7a2a17 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -63,10 +63,10 @@ type DFRPGCharacter = { // stub } with static member fresh = { traits = Set.empty } -let checkbox (txt: string) (id: string) selected onChange = Html.div [ +let checkbox (txt: string) (id: string) selected onChange = class' "control" Html.div [ Html.input [ prop.type' "checkbox" - prop.isChecked selected + prop.valueOrDefault (selected: bool) prop.onCheckedChange onChange prop.id id ] @@ -78,11 +78,11 @@ let checkbox (txt: string) (id: string) selected onChange = Html.div [ type API = { offering: string -> unit // description -> () with a checkbox - label: string -> unit // description -> () but no checkbox, only text e.g. "choose 20 from" + unconditional: string -> unit // description -> () but no checkbox, only text e.g. "choose 20 from" } let offerLogic = - fun (key:OfferKey) innerLogic (scope: OfferScope, output: 'payload OfferOutput) -> + fun (key:OfferKey) (scope: OfferScope, output: 'payload OfferOutput) innerLogic -> let selected = output.pickedOffers.Contains key // we could be in a state of notPicked, refining, or picked. When to show what? Depends on parent state, but do we expect parent to have already filtered us out? @@ -105,14 +105,15 @@ let offerLogic = | children when txt = "" -> Html.div [prop.children children] | children -> Html.div [prop.children (checkbox txt id selected onChange::children)] ) - let uiLabel (txt: string) = + let uiDiv (txt: string) = output.uiBuilder <- output.uiBuilder |> Map.add key (function - | children -> Html.div [prop.children ((Html.text txt)::children)] + | [] -> Html.div txt + | children -> React.fragment [Html.div txt; Html.ul children] ) let api: API = { offering = uiCheckbox selected - label = uiLabel + unconditional = uiDiv } innerLogic selected api @@ -134,35 +135,30 @@ let run (offers: _ Offer list) state pending : _ OfferOutput = let skill(name, bonus): DFRPGCharacter Offer = let key = newKey $"{name} %+d{bonus}" fun ((scope, output) as args) -> - let innerLogic selected (ui:API) = + offerLogic key args <| fun selected (ui:API) -> ui.offering $"{name} {bonus}" - offerLogic key innerLogic args let skillRange(name, bonusRange: int list): DFRPGCharacter Offer = let key = newKey $"{name} {bonusRange}" fun ((scope, output) as args) -> - let innerLogic selected (ui:API) = + offerLogic key args <| fun selected (ui:API) -> ui.offering $"{name} {bonusRange[0]}" - offerLogic key innerLogic args + let either(choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = let key = newKey $"one-of-{choices.Length}" fun ((scope, output) as args) -> - let innerLogic selected (ui:API) = - if selected then - choices |> List.iter (recur key args) - ui.label "Choose one of:" - offerLogic key innerLogic args + offerLogic key args <| fun selected (ui:API) -> + // selected doesn't matter in this case: there's no checkbox, only a div or ul + choices |> List.iter (recur key args) + ui.unconditional $"Choose one of {choices.Length}:" + type style = Feliz.style let budgeted(budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = let key = newKey $"budget-{budget}" fun ((scope, output) as args) -> - let innerLogic selected (ui:API) = - if selected then - offers |> List.iter (recur key args) - if not selected then - output.pickedOffers <- output.pickedOffers |> Set.add key - output.uiBuilder <- output.uiBuilder |> Map.add key (function - | children -> Html.div [prop.children (Html.div $"Choose [{budget}] from:"::children)]) - offerLogic key innerLogic args + offerLogic key args <| fun selected (ui:API) -> + // selected doesn't matter in this case: there's no checkbox, only a div or ul + offers |> List.iter (recur key args) + ui.unconditional $"Choose [{budget}] from:" let swash() = [ skill("climbing", 1) From 5bec1c9756daae5e6bee509c1796e56ed7ca5e80 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sun, 10 Dec 2023 12:11:22 -0800 Subject: [PATCH 17/22] Correct capitalization. Need a way to checkbox changes to trigger a React re-render. --- src/UI/DFRPG/Chargen.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index d7a2a17..a7e8445 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -161,8 +161,8 @@ let budgeted(budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = ui.unconditional $"Choose [{budget}] from:" let swash() = [ - skill("climbing", 1) - skillRange("stealth", [1..3]) + skill("Climbing", 1) + skillRange("Stealth", [1..3]) budgeted(20, [ skill("Acrobatics", 2) skillRange("Acrobatics", [1..3]) From b8522390e65f6e888410abcb31e3482c8fb6637c Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sun, 10 Dec 2023 17:54:34 -0800 Subject: [PATCH 18/22] Make sure UI _knows_ which boxes have been checked --- src/Core/Common.fs | 8 +++++++- src/UI/DFRPG/Chargen.fs | 29 +++++++++++++++++++---------- src/UI/DFRPG/ChargenView.fs | 4 ++-- 3 files changed, 28 insertions(+), 13 deletions(-) diff --git a/src/Core/Common.fs b/src/Core/Common.fs index d84c8dc..f871e0e 100644 --- a/src/Core/Common.fs +++ b/src/Core/Common.fs @@ -432,7 +432,13 @@ let inline trace v = // log for dev purposes, for when exceptions aren't quite enough context let inline devLog v = #if DEBUG - printfn "%s" v + System.Console.WriteLine (box v) +#endif + () +let inline devLogM (txt:string) v = +#if DEBUG + System.Console.Write txt + System.Console.WriteLine (box v) #endif () diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index a7e8445..5443b67 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -18,6 +18,7 @@ let offerRoot = newKey "root" // not persisted but that's okay type 'payload OfferOutput = { stableState: 'payload // TODO: used for cost calculations queuedChanges: 'payload PendingChange list // TODO: used for cost calculations + notifyChanged: 'payload OfferOutput -> unit mutable pickedOffers: OfferKey Set mutable dataAugment: Map // some traits have levels mutable children: OrderedMultimap @@ -25,7 +26,8 @@ type 'payload OfferOutput = { mutable uiBuilder: Map ReactElement> } with - static member fresh payload pending = { stableState = payload; queuedChanges = pending; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty } + static member fresh payload pending = { stableState = payload; queuedChanges = pending; notifyChanged = ignore; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty } + member this.notify() = this.notifyChanged this member this.toReactElements() = // do a post-order traversal of the offer tree, gathering up the UI elements wherever they exist let root = offerRoot @@ -99,7 +101,9 @@ let offerLogic = let uiCheckbox selected (txt: string) = let id = $"chk_{key}" - let onChange v = if v then output.pickedOffers <- output.pickedOffers |> Set.add key else output.pickedOffers <- output.pickedOffers |> Set.remove key + let onChange v = + if v then output.pickedOffers <- output.pickedOffers |> Set.add key else output.pickedOffers <- output.pickedOffers |> Set.remove key + output.notify() output.uiBuilder <- output.uiBuilder |> Map.add key (function | [] -> checkbox txt id selected onChange | children when txt = "" -> Html.div [prop.children children] @@ -120,9 +124,9 @@ let offerLogic = let recur key (scope, output) offer = offer ({ scope with parent = key }, output) -let run (offers: _ Offer list) state pending : _ OfferOutput = +let run (offers: _ Offer list) (state: DFRPGCharacter OfferOutput) notify : _ OfferOutput = let root = offerRoot - let output = OfferOutput<_>.fresh state pending + let output = { OfferOutput<_>.fresh state.stableState state.queuedChanges with pickedOffers = state.pickedOffers; notifyChanged = notify } let scope = { autogrant = false; remainingBudget = None; parent = root } for offer in offers do recur root (scope, output) offer @@ -160,22 +164,27 @@ let budgeted(budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = offers |> List.iter (recur key args) ui.unconditional $"Choose [{budget}] from:" -let swash() = [ +let swash = [ skill("Climbing", 1) skillRange("Stealth", [1..3]) budgeted(20, [ skill("Acrobatics", 2) skillRange("Acrobatics", [1..3]) either([ - skill("Rapier", 20) - skill("Broadsword", 20) + skill("Rapier", +4) + skill("Broadsword", +4) + skill("Polearm", +4) + skill("Two-handed sword", +4) ]) ]) ] +type Msg = RefreshedOutput of DFRPGCharacter OfferOutput type Model = { - template: DFRPGCharacter Offer list + currentOutput: DFRPGCharacter OfferOutput option } -let init _ = { template = swash() } -let update msg1 model = model +let init _ = { currentOutput = None } +let update msg model = + match msg with + | RefreshedOutput output -> { model with currentOutput = Some output } diff --git a/src/UI/DFRPG/ChargenView.fs b/src/UI/DFRPG/ChargenView.fs index 046faf5..bb06836 100644 --- a/src/UI/DFRPG/ChargenView.fs +++ b/src/UI/DFRPG/ChargenView.fs @@ -5,6 +5,6 @@ open UI.DFRPG.Chargen [] let View() = let model, dispatch = React.useElmishSimple init update - let profession = model.template - let output = run profession DFRPGCharacter.fresh [] + let profession = swash + let output = run profession (model.currentOutput |> Option.defaultWith (fun _ -> OfferOutput<_>.fresh DFRPGCharacter.fresh [])) (RefreshedOutput >> dispatch) output.toReactElements() From 9038caf5b18501c5f39a1536e52adf12441f9eaf Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Sun, 10 Dec 2023 17:56:34 -0800 Subject: [PATCH 19/22] Display tweak: Rapier +4 instead of Rapier 4 --- src/UI/DFRPG/Chargen.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 5443b67..91647c7 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -140,12 +140,12 @@ let skill(name, bonus): DFRPGCharacter Offer = let key = newKey $"{name} %+d{bonus}" fun ((scope, output) as args) -> offerLogic key args <| fun selected (ui:API) -> - ui.offering $"{name} {bonus}" + ui.offering $"{name} %+d{bonus}" let skillRange(name, bonusRange: int list): DFRPGCharacter Offer = let key = newKey $"{name} {bonusRange}" fun ((scope, output) as args) -> offerLogic key args <| fun selected (ui:API) -> - ui.offering $"{name} {bonusRange[0]}" + ui.offering $"{name} %+d{bonusRange[0]} to %+d{bonusRange |> List.last}" let either(choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = let key = newKey $"one-of-{choices.Length}" From 50d993a8ee96cfe2d66d274f64081d4b2ed4b51f Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Mon, 11 Dec 2023 18:52:36 -0800 Subject: [PATCH 20/22] Add Sword! and Sword and shield options to Swashbuckler--needs to become mutually exclusive though (pick one!). Whether it's a checkbox or a div should depend on whether the PARENT is an either or an and', not on self. I.e. Sword! should have a checkbox next to it. --- src/UI/DFRPG/Chargen.fs | 101 ++++++++++++++++++++++++++-------------- 1 file changed, 66 insertions(+), 35 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 91647c7..262c934 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -68,7 +68,7 @@ type DFRPGCharacter = { // stub let checkbox (txt: string) (id: string) selected onChange = class' "control" Html.div [ Html.input [ prop.type' "checkbox" - prop.valueOrDefault (selected: bool) + prop.isChecked selected prop.onCheckedChange onChange prop.id id ] @@ -112,6 +112,8 @@ let offerLogic = let uiDiv (txt: string) = output.uiBuilder <- output.uiBuilder |> Map.add key (function | [] -> Html.div txt + | [child] when txt = "" -> child + | children when txt = "" -> Html.div children | children -> React.fragment [Html.div txt; Html.ul children] ) @@ -136,46 +138,75 @@ let run (offers: _ Offer list) (state: DFRPGCharacter OfferOutput) notify : _ Of ) output -let skill(name, bonus): DFRPGCharacter Offer = - let key = newKey $"{name} %+d{bonus}" - fun ((scope, output) as args) -> - offerLogic key args <| fun selected (ui:API) -> - ui.offering $"{name} %+d{bonus}" -let skillRange(name, bonusRange: int list): DFRPGCharacter Offer = - let key = newKey $"{name} {bonusRange}" - fun ((scope, output) as args) -> - offerLogic key args <| fun selected (ui:API) -> - ui.offering $"{name} %+d{bonusRange[0]} to %+d{bonusRange |> List.last}" - -let either(choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = - let key = newKey $"one-of-{choices.Length}" - fun ((scope, output) as args) -> - offerLogic key args <| fun selected (ui:API) -> - // selected doesn't matter in this case: there's no checkbox, only a div or ul - choices |> List.iter (recur key args) - ui.unconditional $"Choose one of {choices.Length}:" - type style = Feliz.style -let budgeted(budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = - let key = newKey $"budget-{budget}" - fun ((scope, output) as args) -> - offerLogic key args <| fun selected (ui:API) -> - // selected doesn't matter in this case: there's no checkbox, only a div or ul - offers |> List.iter (recur key args) - ui.unconditional $"Choose [{budget}] from:" +type OfferConfiguration = { + label: string option + key: string option // let multiple options share the same if they should share state, e.g. Sword! Broadsword-20 and Sword-and-Shield! Broadsword-19 + Shield-15 might want both broadswords to keep the same state when toggling between Sword! vs. Sword-and-Sheild! + } +let blank = { label = None; key = None } + +type Op() = + static member label (txt:string) = { blank with label = Some txt } + + static member skill(config: OfferConfiguration, name:string, bonus: int): DFRPGCharacter Offer = + let key = defaultArg config.key <| newKey $"{name} %+d{bonus}" + fun ((scope, output) as args) -> + offerLogic key args <| fun selected (ui:API) -> + ui.offering (defaultArg config.label $"{name} %+d{bonus}") + static member skill(name: string, bonus: int) = Op.skill(blank, name, bonus) + + static member skill(config: OfferConfiguration, name:string, bonusRange: int list): DFRPGCharacter Offer = + let key = defaultArg config.key <| newKey $"{name} {bonusRange}" + fun ((scope, output) as args) -> + offerLogic key args <| fun selected (ui:API) -> + ui.offering (defaultArg config.label $"{name} %+d{bonusRange[0]} to %+d{bonusRange |> List.last}") + static member skill(name, bonusRange: int list) = Op.skill(blank, name, bonusRange) + + static member either(config: OfferConfiguration, choices: (DFRPGCharacter Offer) list): DFRPGCharacter Offer = + let key = defaultArg config.key <| newKey $"one-of-{choices.Length}" + fun ((scope, output) as args) -> + offerLogic key args <| fun selected (ui:API) -> + // selected doesn't matter in this case: there's no checkbox, only a div or ul + choices |> List.iter (recur key args) // how do we feed the label into the offer text? It needs to happen in uiBuilder. + ui.unconditional (defaultArg config.label $"Choose one of {choices.Length}:") + static member either(choices: (DFRPGCharacter Offer) list) = Op.either(blank, choices) + + static member and'(config: OfferConfiguration, choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = + let key = defaultArg config.key <| newKey $"one-of-{choices.Length}" + fun ((scope, output) as args) -> + offerLogic key args <| fun selected (ui:API) -> + // selected doesn't matter in this case: there's no checkbox, only a div or ul + choices |> List.iter (recur key args) + ui.unconditional (defaultArg config.label "") + static member and'(choices: DFRPGCharacter Offer list) = Op.and'(blank, choices) + + static member budgeted(config: OfferConfiguration, budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = + let key = defaultArg config.key <| newKey $"budget-{budget}" + fun ((scope, output) as args) -> + offerLogic key args <| fun selected (ui:API) -> + // selected doesn't matter in this case: there's no checkbox, only a div or ul + offers |> List.iter (recur key args) + ui.unconditional (defaultArg config.label $"Choose [{budget}] from:") + static member budgeted(budget, offers: DFRPGCharacter Offer list) = Op.budgeted(blank, budget, offers) +open type Op let swash = [ skill("Climbing", 1) - skillRange("Stealth", [1..3]) + skill("Stealth", [1..3]) budgeted(20, [ skill("Acrobatics", 2) - skillRange("Acrobatics", [1..3]) - either([ - skill("Rapier", +4) - skill("Broadsword", +4) - skill("Polearm", +4) - skill("Two-handed sword", +4) - ]) + skill("Acrobatics", [1..3]) + let mainWeapons = ["Rapier"; "Broadsword"; "Polearm"; "Two-handed sword"] |> List.map (fun name -> name, newKey name) + let weaponsAt (bonus: int) = mainWeapons |> List.map (fun (name, key) -> skill({ blank with key = Some key }, name, bonus)) + either [ + either(label "Sword!", weaponsAt +5) + and'(label "Sword and Dagger", [either(weaponsAt +4); skill("Main-gauche", +1)]) + and'(label "Sword and Shield", [either(weaponsAt +4); skill("Shield", +2)]) + ] + either [ + skill("Fast-draw (Sword)", +2) + and'(label "both", [skill("Fast-draw (Sword)", +1); skill("Fast-draw (Dagger)", +1)]) + ] ]) ] From b69910a2c44ac40a3dcc18ca8def494f58201681 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Mon, 11 Dec 2023 19:57:23 -0800 Subject: [PATCH 21/22] Need to unselect mutually-exclusive options for either --- src/UI/DFRPG/Chargen.fs | 107 ++++++++++++++++++++++------------------ 1 file changed, 59 insertions(+), 48 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 262c934..434d785 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -24,9 +24,10 @@ type 'payload OfferOutput = { mutable children: OrderedMultimap mutable parents: Map mutable uiBuilder: Map ReactElement> + mutable choices: Set } with - static member fresh payload pending = { stableState = payload; queuedChanges = pending; notifyChanged = ignore; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty } + static member fresh payload pending = { stableState = payload; queuedChanges = pending; notifyChanged = ignore; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty; choices = Set.empty } member this.notify() = this.notifyChanged this member this.toReactElements() = // do a post-order traversal of the offer tree, gathering up the UI elements wherever they exist @@ -83,46 +84,6 @@ type API = { unconditional: string -> unit // description -> () but no checkbox, only text e.g. "choose 20 from" } -let offerLogic = - fun (key:OfferKey) (scope: OfferScope, output: 'payload OfferOutput) innerLogic -> - let selected = output.pickedOffers.Contains key - - // we could be in a state of notPicked, refining, or picked. When to show what? Depends on parent state, but do we expect parent to have already filtered us out? - // Three possibilities: - // 1. Parent not selected. In this case we won't even get here, don't need to worry about it. - // 2. Parent selected but we're not selected. In this case we need to enable selection, unless it would put us over budget, and then we just show it as unselectable. - // 3. Parent selected and we're also selected. In this case we need to enable deselection, unless it's "free", and then we just show it as perma-selected and un-deselectable. - - // It is the child's responsibility to set up parent/child relationships - let child = key in ( - output.parents <- output.parents |> Map.add child scope.parent - output.children <- output.children |> Map.change scope.parent (Option.orElse (Some []) >> Option.map (flip List.append [child])) - ) - - let uiCheckbox selected (txt: string) = - let id = $"chk_{key}" - let onChange v = - if v then output.pickedOffers <- output.pickedOffers |> Set.add key else output.pickedOffers <- output.pickedOffers |> Set.remove key - output.notify() - output.uiBuilder <- output.uiBuilder |> Map.add key (function - | [] -> checkbox txt id selected onChange - | children when txt = "" -> Html.div [prop.children children] - | children -> Html.div [prop.children (checkbox txt id selected onChange::children)] - ) - let uiDiv (txt: string) = - output.uiBuilder <- output.uiBuilder |> Map.add key (function - | [] -> Html.div txt - | [child] when txt = "" -> child - | children when txt = "" -> Html.div children - | children -> React.fragment [Html.div txt; Html.ul children] - ) - - let api: API = { - offering = uiCheckbox selected - unconditional = uiDiv - } - innerLogic selected api - let recur key (scope, output) offer = offer ({ scope with parent = key }, output) @@ -146,8 +107,48 @@ type OfferConfiguration = { let blank = { label = None; key = None } type Op() = - static member label (txt:string) = { blank with label = Some txt } + static let offerLogic = + fun (key:OfferKey) (scope: OfferScope, output: 'payload OfferOutput) innerLogic -> + let selected = output.pickedOffers.Contains key + + // we could be in a state of notPicked, refining, or picked. When to show what? Depends on parent state, but do we expect parent to have already filtered us out? + // Three possibilities: + // 1. Parent not selected. In this case we won't even get here, don't need to worry about it. + // 2. Parent selected but we're not selected. In this case we need to enable selection, unless it would put us over budget, and then we just show it as unselectable. + // 3. Parent selected and we're also selected. In this case we need to enable deselection, unless it's "free", and then we just show it as perma-selected and un-deselectable. + + // It is the child's responsibility to set up parent/child relationships + let child = key in ( + output.parents <- output.parents |> Map.add child scope.parent + output.children <- output.children |> Map.change scope.parent (Option.orElse (Some []) >> Option.map (flip List.append [child])) + ) + + let uiCheckbox selected (txt: string) = + let id = $"chk_{key}" + let onChange v = + if v then output.pickedOffers <- output.pickedOffers |> Set.add key else output.pickedOffers <- output.pickedOffers |> Set.remove key + output.notify() + output.choices <- output.choices |> Set.add key + output.uiBuilder <- output.uiBuilder |> Map.add key (function + | [] -> checkbox txt id selected onChange + | children when txt = "" -> Html.div [prop.children children] + | children -> Html.div [prop.children [checkbox txt id selected onChange; Html.ul children]] + ) + let uiDiv (txt: string) = + output.uiBuilder <- output.uiBuilder |> Map.add key (function + | [] -> Html.div txt + | [child] when txt = "" -> child + | children when txt = "" -> Html.div children + | children -> React.fragment [Html.div txt; Html.ul children] + ) + + let api: API = { + offering = uiCheckbox selected + unconditional = uiDiv + } + innerLogic selected api + static member label (txt:string) = { blank with label = Some txt } static member skill(config: OfferConfiguration, name:string, bonus: int): DFRPGCharacter Offer = let key = defaultArg config.key <| newKey $"{name} %+d{bonus}" fun ((scope, output) as args) -> @@ -166,18 +167,28 @@ type Op() = let key = defaultArg config.key <| newKey $"one-of-{choices.Length}" fun ((scope, output) as args) -> offerLogic key args <| fun selected (ui:API) -> - // selected doesn't matter in this case: there's no checkbox, only a div or ul - choices |> List.iter (recur key args) // how do we feed the label into the offer text? It needs to happen in uiBuilder. - ui.unconditional (defaultArg config.label $"Choose one of {choices.Length}:") + // recur if selected or no need for selection + if selected || scope.autogrant || config.label.IsNone then + choices |> List.iter (recur key args) + match config.label with + | Some label -> + ui.offering (label + if selected then $"Choose one of {choices.Length}:" else "") + | None -> + ui.unconditional $"Choose one of {choices.Length}:" static member either(choices: (DFRPGCharacter Offer) list) = Op.either(blank, choices) static member and'(config: OfferConfiguration, choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = let key = defaultArg config.key <| newKey $"one-of-{choices.Length}" fun ((scope, output) as args) -> offerLogic key args <| fun selected (ui:API) -> - // selected doesn't matter in this case: there's no checkbox, only a div or ul - choices |> List.iter (recur key args) - ui.unconditional (defaultArg config.label "") + // recur if selected or no need for selection + if selected || scope.autogrant || config.label.IsNone then + choices |> List.iter (recur key args) + match config.label with + | Some label -> + ui.offering label + | None -> + ui.unconditional $"Choose one of {choices.Length}:" static member and'(choices: DFRPGCharacter Offer list) = Op.and'(blank, choices) static member budgeted(config: OfferConfiguration, budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = From 3ee483a9c6233dc28c02353329d2cf27301f3778 Mon Sep 17 00:00:00 2001 From: Max Wilson Date: Mon, 11 Dec 2023 20:11:21 -0800 Subject: [PATCH 22/22] Swords!, etc. works okay now, but Fast-draw needs a better experience. Apparently whether an option like a skill is a choice or not should be determined by its CONTEXT (i.e. parent) and not by itself. --- src/UI/DFRPG/Chargen.fs | 45 ++++++++++++++++++++++++++--------------- 1 file changed, 29 insertions(+), 16 deletions(-) diff --git a/src/UI/DFRPG/Chargen.fs b/src/UI/DFRPG/Chargen.fs index 434d785..3a64dbc 100644 --- a/src/UI/DFRPG/Chargen.fs +++ b/src/UI/DFRPG/Chargen.fs @@ -24,10 +24,10 @@ type 'payload OfferOutput = { mutable children: OrderedMultimap mutable parents: Map mutable uiBuilder: Map ReactElement> - mutable choices: Set + mutable eithers: Set // need this to keep track of which options are mutually-exclusive } with - static member fresh payload pending = { stableState = payload; queuedChanges = pending; notifyChanged = ignore; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty; choices = Set.empty } + static member fresh payload pending = { stableState = payload; queuedChanges = pending; notifyChanged = ignore; pickedOffers = Set.empty; dataAugment = Map.empty; children = Map.empty; parents = Map.empty; uiBuilder = Map.empty; eithers = Set.empty } member this.notify() = this.notifyChanged this member this.toReactElements() = // do a post-order traversal of the offer tree, gathering up the UI elements wherever they exist @@ -51,9 +51,11 @@ type 'payload OfferOutput = { // for scope-like properties as opposed to preorder output, e.g. whether we're within a "grant all these things" block type OfferScope = { autogrant: bool + mutuallyExclusiveChildren: bool remainingBudget: int option parent: OfferKey } + with static member fresh = { autogrant = false; mutuallyExclusiveChildren = false; remainingBudget = None; parent = offerRoot } type 'payload Offer = OfferScope * 'payload OfferOutput -> SideEffects type Skill = { // stub, doesn't even have attribute @@ -84,15 +86,15 @@ type API = { unconditional: string -> unit // description -> () but no checkbox, only text e.g. "choose 20 from" } -let recur key (scope, output) offer = - offer ({ scope with parent = key }, output) +let recur (key, mutuallyExclusiveChildren, (scope, output)) offer = + offer ({ scope with parent = key; mutuallyExclusiveChildren = mutuallyExclusiveChildren }, output) let run (offers: _ Offer list) (state: DFRPGCharacter OfferOutput) notify : _ OfferOutput = let root = offerRoot let output = { OfferOutput<_>.fresh state.stableState state.queuedChanges with pickedOffers = state.pickedOffers; notifyChanged = notify } - let scope = { autogrant = false; remainingBudget = None; parent = root } + let scope = { OfferScope.fresh with parent = root } for offer in offers do - recur root (scope, output) offer + recur (root, false, (scope, output)) offer output.uiBuilder <- output.uiBuilder |> Map.add root (function | [child] -> child | children -> Html.div [prop.children children] @@ -125,10 +127,18 @@ type Op() = let uiCheckbox selected (txt: string) = let id = $"chk_{key}" + output.eithers <- output.eithers |> Set.add (scope.parent) // this feels like a code smell. Shouldn't an either register itself instead of having the child do it? let onChange v = - if v then output.pickedOffers <- output.pickedOffers |> Set.add key else output.pickedOffers <- output.pickedOffers |> Set.remove key + if v then + // if inside an either, unselect siblings then add self + if output.eithers.Contains scope.parent then + for sibling in output.children.[scope.parent] do + output.pickedOffers <- output.pickedOffers |> Set.remove sibling + output.pickedOffers <- output.pickedOffers |> Set.add key + else + // if deselecting, don't need to do anything special + output.pickedOffers <- output.pickedOffers |> Set.remove key output.notify() - output.choices <- output.choices |> Set.add key output.uiBuilder <- output.uiBuilder |> Map.add key (function | [] -> checkbox txt id selected onChange | children when txt = "" -> Html.div [prop.children children] @@ -153,7 +163,10 @@ type Op() = let key = defaultArg config.key <| newKey $"{name} %+d{bonus}" fun ((scope, output) as args) -> offerLogic key args <| fun selected (ui:API) -> - ui.offering (defaultArg config.label $"{name} %+d{bonus}") + if scope.autogrant then + ui.unconditional (defaultArg config.label $"{name} %+d{bonus}") + else + ui.offering (defaultArg config.label $"{name} %+d{bonus}") static member skill(name: string, bonus: int) = Op.skill(blank, name, bonus) static member skill(config: OfferConfiguration, name:string, bonusRange: int list): DFRPGCharacter Offer = @@ -169,12 +182,12 @@ type Op() = offerLogic key args <| fun selected (ui:API) -> // recur if selected or no need for selection if selected || scope.autogrant || config.label.IsNone then - choices |> List.iter (recur key args) + choices |> List.iter (recur(key, true, args)) match config.label with | Some label -> - ui.offering (label + if selected then $"Choose one of {choices.Length}:" else "") + ui.offering (label + if selected then $" Choose one:" else "") // something doesn't match up here. Why isn't the either registering itself? Do we have two overlapping concepts here, offer/options and... mutually exclusion zones? Maybe it's recur that needs to change. | None -> - ui.unconditional $"Choose one of {choices.Length}:" + ui.unconditional $"Choose one:" static member either(choices: (DFRPGCharacter Offer) list) = Op.either(blank, choices) static member and'(config: OfferConfiguration, choices: DFRPGCharacter Offer list): DFRPGCharacter Offer = @@ -183,20 +196,20 @@ type Op() = offerLogic key args <| fun selected (ui:API) -> // recur if selected or no need for selection if selected || scope.autogrant || config.label.IsNone then - choices |> List.iter (recur key args) + choices |> List.iter (recur(key, true, ({ scope with autogrant = true }, output))) match config.label with | Some label -> ui.offering label | None -> - ui.unconditional $"Choose one of {choices.Length}:" - static member and'(choices: DFRPGCharacter Offer list) = Op.and'(blank, choices) + ui.unconditional "" + static member and'(choices: DFRPGCharacter Offer list) = Op.and'(blank, choices) static member budgeted(config: OfferConfiguration, budget, offers: DFRPGCharacter Offer list): DFRPGCharacter Offer = let key = defaultArg config.key <| newKey $"budget-{budget}" fun ((scope, output) as args) -> offerLogic key args <| fun selected (ui:API) -> // selected doesn't matter in this case: there's no checkbox, only a div or ul - offers |> List.iter (recur key args) + offers |> List.iter (recur(key, true, args)) ui.unconditional (defaultArg config.label $"Choose [{budget}] from:") static member budgeted(budget, offers: DFRPGCharacter Offer list) = Op.budgeted(blank, budget, offers) open type Op