diff --git a/src/Initiative/Initiative.elm b/src/Initiative/Initiative.elm new file mode 100644 index 0000000..8d64f70 --- /dev/null +++ b/src/Initiative/Initiative.elm @@ -0,0 +1,119 @@ +module Initiative.Initiative exposing (..) +{-| # Initiative Tracker + +The Initiative Tracker type glues together the inner workings of each element. +-} + +import Element exposing (Element) +import Iddict exposing (Iddict) +import Initiative.TurnTaker as TurnTaker exposing (TurnTaker) +import Initiative.Zipper exposing (Zipper) +import Initiative.Zipper as Zipper +import Color exposing (Color) +import Widget.Material.Color + + + +-- MODEL + +type alias Initiative = + { entities : Iddict TurnTaker + , tracker : Zipper TakerId + } + +type TakerId = TakerId Int + +-- INIT + +empty : Initiative +empty = + singleton TurnTaker.restOfTheWorld + +singleton : TurnTaker -> Initiative +singleton taker = + let + ( key, iddict ) = + Iddict.singleton taker + in + { entities = iddict + , tracker = Zipper.singleton (TakerId key) + } + +fromList : List TurnTaker -> Initiative +fromList takers = + List.head takers + |> Maybe.map singleton + |> Maybe.withDefault empty + |> List.foldl insert + |> (|>) (List.tail takers |> Maybe.withDefault []) + +-- UPDATE + +insert : TurnTaker -> Initiative -> Initiative +insert taker model = + let + ( key, iddict ) = + Iddict.insert taker model.entities + in + { entities = iddict + , tracker = Zipper.insert (TakerId key) model.tracker + } + +-- VIEW + +toElement : + { healthButtonColor : Color + , onApplyHealth : TakerId -> msg + , onApplyName : TakerId -> msg + , onClickRow : TakerId -> msg + , onHoverRow : TakerId -> msg + , onHoverOutRow : TakerId -> msg + , hover : Maybe TakerId + , hoverColor : Color + , rowEvenColor : Color + , rowOddColor : Color + , rowTurnColor : Color + } + -> Initiative + -> Element msg +toElement data model = + model.tracker + |> Zipper.toList + |> List.filterMap + (\(TakerId key) -> + model.entities + |> Iddict.get key + |> Maybe.map (Tuple.pair (TakerId key)) + ) + |> List.indexedMap + (\i (key, taker) -> + TurnTaker.toElement + { backgroundColor = + Widget.Material.Color.withShade + data.hoverColor + ( if data.hover == Just key then + 0.5 + else + 0.0 + ) + ( if key == Zipper.current model.tracker then + data.rowTurnColor + else if modBy 2 i == 0 then + data.rowEvenColor + else + data.rowOddColor + ) + , buttonColor = data.healthButtonColor + , onApplyHealth = data.onApplyHealth key + , onApplyName = data.onApplyName key + , onClick = data.onClickRow key + , onHover = data.onHoverRow key + , onHoverOut = data.onHoverOutRow key + } + taker + ) + |> Element.column + [ Element.fill + -- |> Element.maximum 500 + |> Element.width + ] diff --git a/src/Initiative/TurnTaker.elm b/src/Initiative/TurnTaker.elm new file mode 100644 index 0000000..6f3342f --- /dev/null +++ b/src/Initiative/TurnTaker.elm @@ -0,0 +1,218 @@ +module Initiative.TurnTaker exposing (..) +{-| # TurnTaker + +The TurnTaker is anything that has a turn throughout the combat round. +-} + +import Color exposing (Color) +import Element exposing (Element) +import Element.Background +import Element.Events +import Html.Events +import Layout + +-- MODEL + +{-| Ability scores +-} +type alias AbilityScores + = { str : Int, dex : Int, con : Int, int : Int, wis : Int, cha : Int } + +{-| The type of statistics that an NPC, such as a monster, can have. +-} +type alias NPCStats = + { --abilityScores : AbilityScores + --, armorClass : Int + --, + maxHitPoints : Int + } + +{-| A TurnTaker is anything that is considered part of the initiative rounds. +-} +type alias TurnTaker = + { hiddenForPlayers : Bool + , name : String + , shape : TurnTakerType + } + +{-| A TurnTaker is a line in the initiative tracker. Traditionally, it is an +adventurer or an NPC that takes a turn, but it can also be external events that +take place once every turn, such as lair events or a general "rest of the world" +turn event. + +The TurnTakerType is the type that disambiguates which type of TurnTaker it is. +-} +type TurnTakerType + = Player + { hitPoints : Int + , stats : PlayerStats + } + | NPC + { hitPoints : Int + , stats : NPCStats + } + | Event + | RestOfTheWorld + +{-| The type of statistics that a player character has. +-} +type alias PlayerStats = + { npcStats : NPCStats + } + +-- INIT + +restOfTheWorld : TurnTaker +restOfTheWorld = + { hiddenForPlayers = False + , name = "Rest of the world" + , shape = RestOfTheWorld + } + +newEvent : { name : String, hiddenForPlayers : Bool } -> TurnTaker +newEvent data = + { hiddenForPlayers = data.hiddenForPlayers + , name = data.name + , shape = Event + } + +newMonster : { name : String, hiddenForPlayers : Bool, stats : NPCStats } -> TurnTaker +newMonster { name, hiddenForPlayers, stats } = + { hiddenForPlayers = hiddenForPlayers + , name = name + , shape = NPC { hitPoints = stats.maxHitPoints, stats = stats } + } + +newPlayer : { name : String, stats : PlayerStats } -> TurnTaker +newPlayer { name, stats } = + { hiddenForPlayers = False + , name = name + , shape = Player { hitPoints = stats.npcStats.maxHitPoints, stats = stats } + } + +-- UPDATE + +type Msg + = Damage Int + | SetName String + +dealDamage : Int -> TurnTaker -> TurnTaker +dealDamage dmg taker = + { taker + | shape = + case taker.shape of + Player data -> + Player + { data + | hitPoints = + data.hitPoints - dmg + |> Basics.max 0 + |> Basics.min data.stats.npcStats.maxHitPoints + } + + NPC data -> + NPC + { data + | hitPoints = + data.hitPoints - dmg + |> Basics.max 0 + |> Basics.min data.stats.maxHitPoints + } + + Event -> + taker.shape + + RestOfTheWorld -> + taker.shape + } + +update : Msg -> TurnTaker -> TurnTaker +update msg model = + case msg of + Damage dmg -> + dealDamage dmg model + + SetName name -> + { model | name = name } + +-- VIEW + +toElement : + { backgroundColor : Color + , buttonColor : Color + , onApplyHealth : msg + , onApplyName : msg + , onClick : msg + , onHover : msg + , onHoverOut : msg + } + -> TurnTaker + -> Element msg +toElement data taker = + Element.row + [ data.backgroundColor + |> Color.toRgba + |> Element.fromRgb + |> Element.Background.color + , Element.padding 5 + , Element.spacing 5 + , Element.width Element.fill + , data.onClick + |> Element.Events.onClick + , data.onHover + |> Html.Events.onMouseEnter + |> Element.htmlAttribute + , data.onHover + |> Html.Events.onMouseOver + |> Element.htmlAttribute + , data.onHoverOut + |> Html.Events.onMouseLeave + |> Element.htmlAttribute + ] + [ String.fromInt 20 + |> Element.text + |> Element.el + [ Element.centerX + , Element.centerY + , Element.width <| Element.px 20 + ] + , taker.name + |> Element.text + |> Element.el + [ Element.Events.onClick data.onApplyName + , Element.width Element.fill + ] + , ( case hitPoints taker of + Just { current, limit } -> + Layout.textButton + { color = data.buttonColor + , icon = always Element.none + , onPress = Just data.onApplyHealth + , text = + String.join " " + [ String.fromInt current + , "/" + , String.fromInt limit + ] + } + + Nothing -> + Element.none + ) + |> Element.el [ Element.width <| Element.px 80 ] + ] + +hitPoints : TurnTaker -> Maybe { current : Int, limit : Int } +hitPoints taker = + case taker.shape of + Player data -> + Just { current = data.hitPoints, limit = data.stats.npcStats.maxHitPoints } + + NPC data -> + Just { current = data.hitPoints, limit = data.stats.maxHitPoints } + + Event -> + Nothing + + RestOfTheWorld -> + Nothing diff --git a/src/Initiative/Zipper.elm b/src/Initiative/Zipper.elm new file mode 100644 index 0000000..e65aeef --- /dev/null +++ b/src/Initiative/Zipper.elm @@ -0,0 +1,77 @@ +module Initiative.Zipper exposing (..) +{-| # Zipper + +The Zipper is a data type that acts like a list, but it guarantees that it +always has at least one item selected and available in the list. +-} + +import Queue exposing (Queue) + +-- MODEL + +type alias Zipper a = + { before : Queue a + , current : a + , after : Queue a + } + +-- INIT + +singleton : a -> Zipper a +singleton item = + { before = Queue.empty + , current = item + , after = Queue.empty + } + +fromList : a -> List a -> Zipper a +fromList head tail = + { before = Queue.empty + , current = head + , after = Queue.fromListFIFO tail + } + +-- UPDATE + +{-| Move to the next item. O(1) operation. The zipper loops around to the +beginning if necessary. +-} +forward : Zipper a -> Zipper a +forward zipper = + case Queue.head zipper.after of + Just nextItem -> + { before = Queue.enqueue zipper.current zipper.before + , current = nextItem + , after = Queue.dequeue zipper.after + } + + Nothing -> + case Queue.head zipper.before of + Just nextItem -> + { before = Queue.empty + , current = nextItem + , after = Queue.dequeue zipper.before + } + + Nothing -> + zipper + +{-| Add new items at the end of the zipper. +-} +insert : a -> Zipper a -> Zipper a +insert item zipper = + { zipper | after = Queue.enqueue item zipper.after } + +-- VIEW + +current : Zipper a -> a +current = .current + +size : Zipper a -> Int +size zipper = Queue.length zipper.before + 1 + Queue.length zipper.after + +toList : Zipper a -> List a +toList zipper = + Queue.toListFIFO zipper.after + |> List.append [ zipper.current ] + |> List.append (Queue.toListFIFO zipper.before) diff --git a/src/Main.elm b/src/Main.elm new file mode 100644 index 0000000..ba16dad --- /dev/null +++ b/src/Main.elm @@ -0,0 +1,107 @@ +module Main exposing (main) +{-| # Main website +-} + +import Browser +import Element +import Layout +import Theme +import Initiative.Initiative as Initiative +import Initiative.TurnTaker as TurnTaker +import Widget.Material.Color + +main : Program () Model Msg +main = + Browser.document + { init = init + , view = view + , update = update + , subscriptions = subscriptions + } + +-- MODEL + +type alias Model = + { hover : Maybe Initiative.TakerId } + +type Msg + = Hover Initiative.TakerId Bool + | Pass + +init : () -> ( Model, Cmd Msg ) +init () = + ( { hover = Nothing }, Cmd.none ) + +-- UPDATE + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case msg of + Hover tid True -> + ( { model | hover = Just tid }, Cmd.none ) + + Hover tid False -> + if model.hover == Just tid then + ( { model | hover = Nothing }, Cmd.none ) + else + ( model, Cmd.none ) + + Pass -> + ( model, Cmd.none ) + +-- SUBSCRIPTIONS + +subscriptions : Model -> Sub Msg +subscriptions _ = + Sub.none + +-- VIEW + +theme : Theme.Flavor +theme = Theme.Latte + +view : Model -> Browser.Document Msg +view model = + { title = "D&D Initiative Tracker" + , body = + [ TurnTaker.newPlayer + { name = "Alkbaard" + , stats = + { npcStats = { maxHitPoints = 50 } + } + } + , TurnTaker.newMonster + { name = "Ancient Red Dragon" + , hiddenForPlayers = True + , stats = { maxHitPoints = 200 } + } + , TurnTaker.newMonster + { name = "Green Dragon Wyrmling" + , hiddenForPlayers = False + , stats = { maxHitPoints = 75 } + } + , TurnTaker.newEvent + { name = "Lair actions" + , hiddenForPlayers = True + } + ] + |> Initiative.fromList + |> Initiative.toElement + { healthButtonColor = Theme.text theme + , onApplyHealth = always Pass + , onApplyName = always Pass + , onClickRow = always Pass + , onHoverRow = (\tid -> Hover tid True) + , onHoverOutRow = (\tid -> Hover tid False) + , hover = model.hover + , hoverColor = Theme.crust theme + , rowEvenColor = Theme.mantle theme + , rowOddColor = + Widget.Material.Color.withShade + (Theme.crust theme) 0.5 (Theme.mantle theme) + , rowTurnColor = Theme.flamingo theme + } + |> Element.el [ Element.centerX ] + |> Element.layout [ Theme.background Theme.base theme ] + |> List.singleton + }