6 files changed, 75 insertions(+), 51 deletions(-)

M readme.org
M src/CharSheet/XP.purs
M src/UI/Attributes.purs
M src/UI/Attributes/Attribute.purs
M src/UI/Level.purs
M src/UI/XP.purs

@@ 6,8 6,6 @@ Control your data, avoid hosting character sheets online, still share them with 
 
 ** todo list
 *** Backlog
-**** TODO how many xp until level up?
-this could pop up
 **** TODO import/export json
 **** TODO Improve use of profunctor-lenses
 


@@ 112,3 110,8 @@ These are derived solely from the Attributes, so can be read-only
 ***** Data
 ***** UI
 **** Set Attributes Manually
+**** DONE how many xp until level up?
+:LOGBOOK:
+- State "DONE"       from "TODO"       [2021-05-10 Mon 18:04]
+:END:
+this could pop up, or be next to the xp count (X/Y)

@@ 1,4 1,4 @@
-module CharSheet.XP (XP, _xp, xp, toLevel, inc, dec, toJson) where
+module CharSheet.XP (XP, _xp, xp, level, xpRequired, untilNextLevel, inc, dec, toJson) where
 
 import Prelude
 import CharSheet.Level (Level(..))


@@ 33,15 33,32 @@ dec (XP i)
 toJson :: XP -> A.Json
 toJson (XP i) = A.fromNumber $ I.toNumber i
 
-toLevel :: XP -> Level
-toLevel (XP count)
-  | count < 3 = Level 1
-  | count < 6 = Level 2
-  | count < 12 = Level 3
-  | count < 18 = Level 4
-  | count < 27 = Level 5
-  | count < 39 = Level 6
-  | count < 54 = Level 7
-  | count < 72 = Level 8
-  | count < 93 = Level 9
-  | otherwise = Level (10 + (count - 93) / 24)
+xpRequired :: Level -> XP
+xpRequired (Level x)
+  | x == 1 = XP 3
+  | x == 2 = XP 6
+  | x == 3 = XP 12
+  | x == 4 = XP 18
+  | x == 5 = XP 27
+  | x == 6 = XP 39
+  | x == 7 = XP 54
+  | x == 8 = XP 72
+  | x == 9 = XP 93
+  | otherwise = XP $ 93 + ((x - 10) * 24)
+
+level :: XP -> Level
+level (XP count) = go count 1
+  where
+  go c lvl =
+    if c < L.view _xp (xpRequired (Level lvl)) then
+      (Level lvl)
+    else
+      (go c (lvl + 1))
+
+untilNextLevel :: XP -> XP
+untilNextLevel x =
+  let
+    lvl = level x
+    (XP req) = xpRequired lvl
+  in
+   L.over _xp (\curr -> req - curr) x

@@ 1,7 1,6 @@
 module UI.Attributes where
 
 import Prelude
-
 import CharSheet.Attributes as CA
 import Data.Lens as L
 import Effect.Class (class MonadEffect, liftEffect)


@@ 28,8 27,8 @@ component :: forall q m. MonadEffect m => H.Component q Input Message m
 component =
   Hooks.component \tokens i -> Hooks.do
     let
-
       incAttribute attr = (UpdateAttributes (L.over attr (_ + 1) i))
+
       decAttribute attr = (UpdateAttributes (L.over attr (_ - 1) i))
 
       handleStr = case _ of


@@ 59,7 58,6 @@ component =
       handleClick = do
         new <- liftEffect $ CA.fresh
         Hooks.raise tokens.outputToken (UpdateAttributes new)
-
     Hooks.pure do
       HH.div
         [ Util.classes [ "border-b-2", "border-black", "w-32", "mt-2" ] ]


@@ 69,7 67,7 @@ component =
         , HH.slot _attribute 3 UAA.component { label: "int", attribute: L.view CA._int i } handleInt
         , HH.slot _attribute 4 UAA.component { label: "wis", attribute: L.view CA._wis i } handleWis
         , HH.slot _attribute 5 UAA.component { label: "cha", attribute: L.view CA._cha i } handleCha
-                , if CA.isEmpty i then
+        , if CA.isEmpty i then
             HH.button [ HE.onClick \_ -> handleClick ] [ HH.text "Roll" ]
           else
             HH.div_ []

@@ 1,7 1,6 @@
 module UI.Attributes.Attribute where
 
 import Prelude
-
 import CharSheet.Attributes as CA
 import Halogen as H
 import Halogen.HTML as HH


@@ 9,41 8,46 @@ import Halogen.HTML.Events as HE
 import Halogen.Hooks as Hooks
 import UI.Util as Util
 
-type Input = { label :: String
-             , attribute :: Int
-             }
+type Input
+  = { label :: String
+    , attribute :: Int
+    }
 
 data Message
   = Increment
   | Decrement
 
-type Slot s = forall q. H.Slot q Message s
+type Slot s
+  = forall q. H.Slot q Message s
 
 component :: forall q m. H.Component q Input Message m
-component = Hooks.component \tokens { label, attribute } -> Hooks.do
-  let
-    handleInc = do
-      Hooks.raise tokens.outputToken (Increment)
-    handleDec = do
-      Hooks.raise tokens.outputToken (Decrement)
+component =
+  Hooks.component \tokens { label, attribute } -> Hooks.do
+    let
+      handleInc = do
+        Hooks.raise tokens.outputToken (Increment)
 
-  Hooks.pure do
-    HH.div
-      [ Util.classes [ "w-40", "h-10", "border-black", "border-2", "border-b-0", "grid", "grid-cols-4", "items-center" ] ]
-      [ HH.div
-        [ Util.classes [ "pr-2", "border-r-2", "border-black", "block", "text-right" ] ]
-        [ HH.text label ]
-      , HH.div [ Util.classes [ "block", "pr-2", "text-gray-400", "text-right" ] ] [ HH.text $ show attribute ]
-      , HH.div [ Util.classes [ "pr-2", "border-l-2", "border-black", "text-right" ] ] [ HH.text $ show (CA.modifier attribute) ]
-      , HH.div
-        [ Util.classes [ "grid", "grid-rows-2" ] ]
-        [ HH.button
-          [ Util.classes [ "w-4", "h-4", "border-black", "border", "flex", "justify-center", "items-center" ]
-          , HE.onClick \_ -> handleInc ]
-          [ HH.text "+" ]
-        , HH.button
-          [ Util.classes [ "w-4", "h-4", "border-black", "border", "flex", "justify-center", "items-center" ]
-          , HE.onClick \_ -> handleDec]
-          [ HH.text "-" ]
+      handleDec = do
+        Hooks.raise tokens.outputToken (Decrement)
+    Hooks.pure do
+      HH.div
+        [ Util.classes [ "w-40", "h-10", "border-black", "border-2", "border-b-0", "grid", "grid-cols-4", "items-center" ] ]
+        [ HH.div
+            [ Util.classes [ "pr-2", "border-r-2", "border-black", "block", "text-right" ] ]
+            [ HH.text label ]
+        , HH.div [ Util.classes [ "block", "pr-2", "text-gray-400", "text-right" ] ] [ HH.text $ show attribute ]
+        , HH.div [ Util.classes [ "pr-2", "border-l-2", "border-black", "text-right" ] ] [ HH.text $ show (CA.modifier attribute) ]
+        , HH.div
+            [ Util.classes [ "grid", "grid-rows-2" ] ]
+            [ HH.button
+                [ Util.classes [ "w-4", "h-4", "border-black", "border", "flex", "justify-center", "items-center" ]
+                , HE.onClick \_ -> handleInc
+                ]
+                [ HH.text "+" ]
+            , HH.button
+                [ Util.classes [ "w-4", "h-4", "border-black", "border", "flex", "justify-center", "items-center" ]
+                , HE.onClick \_ -> handleDec
+                ]
+                [ HH.text "-" ]
+            ]
         ]
-      ]

@@ 66,7 66,7 @@ render s =
             , "justify-self-start"
             ]
         ]
-        [ HH.text $ show $ CX.toLevel s ]
+        [ HH.text $ show $ CX.level s ]
     ]
 
 handleAction :: forall o m. Action -> H.HalogenM State Action () o m Unit

@@ 1,12 1,14 @@
 module UI.XP where
 
 import Prelude
+
 import CharSheet.XP as CX
 import Data.Maybe (Maybe(..))
 import Effect.Class (class MonadEffect)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
 import UI.Util as Util
 
 type Input


@@ 83,7 85,7 @@ render { xp } =
             ]
         ]
         [ HH.button [ HE.onClick \_ -> Inc ] [ HH.text "+" ]
-        , HH.p_ [ HH.text $ show xp ]
+        , HH.p [ HP.title $ "xp until next level: " <> show (CX.untilNextLevel xp) ] [ HH.text $ (show xp) <> "/" <> show (CX.xpRequired (CX.level xp)) ]
         , HH.button [ HE.onClick \_ -> Dec ] [ HH.text "-" ]
         ]
     ]