8 files changed, 160 insertions(+), 13 deletions(-)

M readme.org
M src/CharSheet.purs
A src/CharSheet/Background.purs
M src/CharSheet/XP.purs
A src/UI/Background.purs
M src/UI/Class.purs
M src/UI/Entry.purs
M src/UI/XP.purs

@@ 28,13 28,8 @@ for shooting, skills, etc
 
 relies on attributes and level
 **** tool-tips with rules
+**** Oracles of some kind
 *** Ready
-**** Model Backgrounds
-
-I won't be automating the setting of skills based on these, so that should also be explained somewhere.
-
-This is basically gonna be a big old list.
-
 **** Model Skills
 
 Only show psychic skills for psychics.


@@ 115,3 110,10 @@ These are derived solely from the Attributes, so can be read-only
 - State "DONE"       from "TODO"       [2021-05-10 Mon 18:04]
 :END:
 this could pop up, or be next to the xp count (X/Y)
+**** Model Backgrounds
+
+I won't be automating the setting of skills based on these, so that should also be explained somewhere.
+
+This is basically gonna be a big old list.
+
+Is it best to make a thing called a Background, and then make them into a list? I think so - I'm not sure there's value in having Backgrounds as a sum type.

@@ 4,21 4,25 @@ module CharSheet
   , fromJson
   , write
   , _attributes
+  , _background
   , _class
   , _xp
   ) where
 
 import Prelude
+
 import Beaker.HyperDrive as HD
 import CharSheet.Attributes as CA
+import CharSheet.Background as CB
 import CharSheet.Class as CC
 import CharSheet.XP as CX
 import Data.Argonaut as A
+import Data.Array as Array
 import Data.Either (Either(..))
 import Data.Int as I
 import Data.Lens as L
 import Data.Lens.Index (ix)
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe(..), maybe')
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff, Error, error)
 import Effect.Class (liftEffect)


@@ 29,6 33,7 @@ type Character
   = { xp :: CX.XP
     , class :: CC.Class
     , attributes :: CA.Attributes
+    , background :: Maybe CB.Background
     }
 
 fresh :: Character


@@ 36,6 41,7 @@ fresh =
   { xp: CX.xp 0
   , class: CC.Undecided
   , attributes: CA.empty
+  , background: Nothing
   }
 
 fromJson :: A.Json -> Maybe Character


@@ 48,15 54,26 @@ fromJson j = do
   int <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "int" <<< A._Number) j)
   wis <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "wis" <<< A._Number) j)
   cha <- I.ceil <$> (L.preview (A._Object <<< ix "attributes" <<< A._Object <<< ix "cha" <<< A._Number) j)
-  pure $ { xp: CX.xp x, class: cl, attributes: CA.manual str dex con int wis cha }
+  bg <- (L.preview ( A._Object <<< ix "background" <<< A._String ) j)
+
+  let background = Array.find
+                   (\b -> (L.view CB._background b) == bg)
+                   CB.backgrounds
+
+  pure $ { xp: CX.xp x
+         , class: cl
+         , attributes: CA.manual str dex con int wis cha
+         , background
+         }
 
 toJson :: Character -> A.Json
-toJson { xp: x, class: c, attributes: a } =
+toJson { xp: x, class: c, attributes: a, background: b } =
   A.fromObject
     ( Object.fromFoldable
         [ Tuple "xp" (CX.toJson x)
         , Tuple "class" (CC.toJson c)
         , Tuple "attributes" (CA.toJson a)
+        , Tuple "background" (maybe' (\_ -> A.fromString "undecided") CB.toJson b)
         ]
     )
 


@@ 79,3 96,6 @@ _class = L.lens _.class $ _ { class = _ }
 
 _xp :: L.Lens' Character CX.XP
 _xp = L.lens _.xp $ _ { xp = _ }
+
+_background :: L.Lens' Character (Maybe CB.Background)
+_background = L.lens _.background $ _ { background = _ }

@@ 0,0 1,53 @@
+module CharSheet.Background where
+
+import Prelude
+
+import Data.Argonaut as A
+import Data.Lens as L
+import Data.Tuple (Tuple(..))
+
+newtype Background
+  = Background (Tuple String String)
+
+_b :: L.Lens' Background (Tuple String String)
+_b = L.lens getter setter
+  where
+  getter (Background t) = t
+
+  setter _ nt = Background nt
+
+_background :: L.Lens' Background String
+_background = _b <<< L._1
+
+_description :: L.Lens' Background String
+_description = _b <<< L._2
+
+toJson :: Background -> A.Json
+toJson b = A.fromString $ L.view _background b
+
+background :: String -> String -> Background
+background name description = Background $ Tuple name description
+
+backgrounds :: Array Background
+backgrounds =
+  [ background "Barbarian" "born of a primitive world"
+  , background "Clergy" "a consecrated man or woman"
+  , background "Courtesan" "trading on pleasurable company"
+  , background "Criminal" "thief, rogue, liar, or worse"
+  , background "Dilettante" "with money if not purpose"
+  , background "Entertainer" "artful and beguilling"
+  , background "Merchant" "whether peddler or far trader"
+  , background "Noble" "by blood or by social capital"
+  , background "Official" "a functionary of some greater state"
+  , background "Peasant" "whether primitive or high-tech"
+  , background "Physician" "a healer of the sick and maimed"
+  , background "Pilot" "or rider, or sailor, or vehicle driver"
+  , background "Politician" "aspiring to leadership and control"
+  , background "Scholar" "a scientist or academic"
+  , background "Soldier" "whether mercinary or conscript"
+  , background "Spacer" "dwelling in deep space habs"
+  , background "Technician" "artisan, engineer, or builder"
+  , background "Thug" "ruffian, or strong arm of the people"
+  , background "Vagabond" "roaming without a home"
+  , background "Worker" "a cube drone or day laborer"
+  ]

@@ 59,6 59,7 @@ untilNextLevel :: XP -> XP
 untilNextLevel x =
   let
     lvl = level x
+
     (XP req) = xpRequired lvl
   in
-   L.over _xp (\curr -> req - curr) x
+    L.over _xp (\curr -> req - curr) x

@@ 0,0 1,56 @@
+module UI.Background where
+
+import Prelude
+
+import CharSheet.Background as CB
+import Data.Array as Array
+import Data.Lens as L
+import Data.Maybe (Maybe(..), maybe')
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
+import Halogen.Hooks as Hooks
+import UI.Util as Util
+
+type Input
+  = Maybe CB.Background
+
+data Message
+  = SetBackground CB.Background
+
+type Slot s
+  = forall q. H.Slot q Message s
+
+bkg :: forall w i. CB.Background -> HH.HTML w i
+bkg b =
+  let
+    background = L.view CB._background b
+  in
+    HH.option
+      [ HP.value background ]
+      [ HH.text background ]
+
+component :: forall q m. H.Component q Input Message m
+component =
+  Hooks.component \t i -> Hooks.do
+    let
+      handleValueChange value = let
+        bg = Array.find (\b -> (L.view CB._background b) == value) CB.backgrounds
+        in
+         case bg of
+           Just x -> Hooks.raise t.outputToken $ SetBackground x
+           Nothing -> pure unit
+
+    Hooks.pure do
+      HH.div
+       [ Util.classes [ "mb-2", "p-2", "border-2", "border-black", "w-96" ] ]
+        [ HH.label [ Util.classes [ "mr-2" ] ] [ HH.text "Background:" ]
+        , HH.select
+          [ HP.value (maybe' (\_ -> "undecided") (L.view CB._background) i)
+          , HP.title (maybe' (\_ -> "choose a background") (L.view CB._description) i)
+          , HE.onValueChange \v -> handleValueChange v
+          ]
+          (bkg <$>
+           (CB.backgrounds <> [CB.background "undecided" "choose a background"]))
+        ]

@@ 48,8 48,9 @@ initialState = identity
 render :: forall m. State -> H.ComponentHTML Action () m
 render s =
   HH.div
-    [ Util.classes [ "mb-2" ] ]
-    [ HH.select
+    [ Util.classes [ "mb-2", "p-2", "border-2", "border-black", "w-96" ] ]
+    [ HH.label [ Util.classes [ "mr-2" ] ] [ HH.text "Class:" ]
+    , HH.select
         [ HP.value $ CC.toString s
         , HE.onValueChange
             ( \str -> case CC.fromString str of

@@ 1,6 1,7 @@
 module UI.Entry where
 
 import Prelude
+
 import CharSheet as C
 import CharSheet.XP as CXP
 import Data.Lens as L


@@ 10,6 11,7 @@ import Halogen as H
 import Halogen.HTML as HH
 import Type.Proxy (Proxy(..))
 import UI.Attributes as UA
+import UI.Background as UB
 import UI.Class as UC
 import UI.Level as UILevel
 import UI.Util as Util


@@ 31,12 33,14 @@ data Action
   = XPOutput UIXP.Output
   | ChangeClass UC.Output
   | ChangeAttributes UA.Message
+  | ChangeBackground UB.Message
 
 type Slots
   = ( xp :: (UIXP.Slot Unit)
     , lvl :: (UILevel.Slot Unit)
     , class :: (UC.Slot Unit)
     , attributes :: (UA.Slot Unit)
+    , background :: (UB.Slot Unit)
     )
 
 _xp = Proxy :: Proxy "xp"


@@ 47,6 51,8 @@ _class = Proxy :: Proxy "class"
 
 _attributes = Proxy :: Proxy "attributes"
 
+_background = Proxy :: Proxy "background"
+
 component :: forall m. MonadEffect m => H.Component Query Input Output m
 component =
   H.mkComponent


@@ 71,6 77,8 @@ render state =
     cl = L.view C._class state
 
     attr = L.view C._attributes state
+
+    background = L.view C._background state
   in
     HH.div
       [ Util.classes


@@ 83,12 91,19 @@ render state =
           ]
       ]
       [ HH.slot _class unit UC.component cl ChangeClass
+      , HH.div [ Util.classes [ ]] [ HH.slot _background unit UB.component background ChangeBackground ]
       , HH.div [ Util.classes [ "grid", "grid-cols-2", "w-1/2" ] ] [ HH.slot _xp unit UIXP.component { xp } XPOutput, HH.slot_ _lvl unit UILevel.component xp ]
       , HH.slot _attributes unit UA.component attr ChangeAttributes
       ]
 
 handleAction :: forall m. MonadEffect m => Action -> H.HalogenM State Action Slots Output m Unit
 handleAction = case _ of
+  ChangeBackground output -> do
+    case output of
+      UB.SetBackground bg -> do
+        H.modify_ $ L.set C._background (Just bg)
+    c <- H.get
+    H.raise $ Save c
   ChangeAttributes output -> do
     case output of
       UA.UpdateAttributes as -> do

@@ 1,7 1,6 @@
 module UI.XP where
 
 import Prelude
-
 import CharSheet.XP as CX
 import Data.Maybe (Maybe(..))
 import Effect.Class (class MonadEffect)