Initial initiative design

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
+            ]

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

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)

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
+    }