10 files changed, 246 insertions(+), 91 deletions(-)

M readme.org
M scripts.org
M src/CharSheet.purs
M src/CharSheet/Background.purs
A src/CharSheet/ChosenFocus.purs
A src/CharSheet/Focus.purs
A src/CharSheet/Focus/Default.purs
M src/UI/Background.purs
M src/UI/Entry.purs
A src/UI/Foci/PossibleList.purs

@@ 6,12 6,6 @@ Control your data, avoid hosting character sheets online, still share them with 
 
 ** todo list
 *** Backlog
-**** TODO import/export json
-**** TODO Improve use of profunctor-lenses
-
-This one might require me to understand profunctor lenses a lot better...
-
-***** TODO Read up on profunctor-lenses
 **** Model hitpoints
 
 these are derived from your class and your level and your constitution


@@ 29,12 23,16 @@ for shooting, skills, etc
 relies on attributes and level
 **** tool-tips with rules
 **** Oracles of some kind
+**** Edit mode
+rather than have everything be editable all the time, allow the user to toggle between editability
+**** real-time updates for viewers
+**** 'fork' or 'copy' button, for people to start their own sheet
+
 *** Ready
 **** Model Skills
 
 Only show psychic skills for psychics.
 
-**** Model Foci
 **** Model Attack bonus
 **** Model Equipment
 


@@ 45,6 43,15 @@ Weapons have damage dice and stuff, armour has armour class.
 **** Model Name
 **** Model Goal
 *** Doing
+**** Model Foci
+
+This is an interesting one, similar to equipment. There's a set of already-known possible foci, but GMs may make their own so we need to be able to add foci too.
+
+I'm thinking that we can have a list of /possible foci/ in the json file, and a single set too.
+
+The UI could be interesting. I think when selecting, we should see a list of foci in a panel on the right hand side, separate from the main body of the list.
+
+**** TODO import/export json
 *** Done
 **** DONE save sheet on update
 :LOGBOOK:

@@ 2,6 2,9 @@
 #+begin_src shell :results output verbatim
 rm ./dist/*.js ./dist/*.js.map
 spago build
+#+end_src
+
+#+begin_src shell :results output verbatim
 yarn parcel build ./index.html
 #+end_src
 


@@ 21,48 24,6 @@ ls -1 ./dist
 #+end_src
 
 #+RESULTS: build-project
-#+begin_example
-Warning found:
-in module UI.Entry
-at src/UI/Entry.purs:11:1 - 11:37 (line 11, column 1 - line 11, column 37)
-
-  The qualified import of Halogen.HTML.Properties as HP is redundant
-
-
-See https://github.com/purescript/documentation/blob/master/errors/UnusedImport.md for more information,
-or to contribute content related to this warning.
-
-
-yarn run v1.22.10
-$ /home/sam/Documents/code/builds-character/node_modules/.bin/parcel build ./index.html
-Building...
-Bundling...
-Packaging & Optimizing...
-✨ Built in 6.91s
-
-dist/index.0ebdc5d7.css                         ⚠️  3.07 MB    184ms
-├── app.css                                         3.07 MB    6.00s
-├── <no source>                                       128 B      0ms
-├── Code from unknown sourcefiles                      48 B      0ms
-└── %3Cinput%20css%20B9PXjF%3E                          6 B      0ms
-
-dist/index.e475b57a.js                            652.43 KB    5.85s
-├── output/Data.Map.Internal/index.js              35.27 KB    984ms
-├── output/Data.List/index.js                       17.4 KB    993ms
-├── output/Data.List.Lazy/index.js                 16.62 KB    337ms
-├── output/Control.Monad.List.Trans/index.js       12.76 KB    785ms
-├── output/Data.List.Lazy.Types/index.js           12.57 KB    369ms
-├── output/Data.List.Types/index.js                11.81 KB    583ms
-├── output/Data.Foldable/index.js                  10.81 KB    507ms
-├── output/Data.Array/index.js                     10.15 KB    455ms
-├── output/Data.FoldableWithIndex/index.js          9.86 KB    808ms
-└── output/Halogen.Query.HalogenM/index.js           8.8 KB    463ms
-└── + 382 more assets
-
-dist/index.html                                       218 B    184ms
-└── index.html                                        285 B     59ms
-Done in 7.90s.
-#+end_example
 
 #+name: install
 #+begin_src shell :results output verbose


@@ 70,3 31,17 @@ spago install effect
 #+end_src
 
 #+RESULTS: install
+
+#+begin_src shell :results output verbose
+df
+#+end_src
+
+#+RESULTS:
+: Filesystem     1K-blocks      Used Available Use% Mounted on
+: tmpfs            1611136      2560   1608576   1% /run
+: /dev/nvme0n1p2 490691512 123015360 342680672  27% /
+: tmpfs            8055680    389076   7666604   5% /dev/shm
+: tmpfs               5120         4      5116   1% /run/lock
+: tmpfs               4096         0      4096   0% /sys/fs/cgroup
+: /dev/nvme0n1p1    523248      8004    515244   2% /boot/efi
+: tmpfs            1611136       144   1610992   1% /run/user/1000

@@ 7,14 7,20 @@ module CharSheet
   , _background
   , _class
   , _xp
+  , _possibleFoci
   ) where
 
 import Prelude
-
 import Beaker.HyperDrive as HD
 import CharSheet.Attributes as CA
+import CharSheet.Background (Background)
 import CharSheet.Background as CB
+import CharSheet.ChosenFocus (ChosenFocus)
+import CharSheet.ChosenFocus as CCF
 import CharSheet.Class as CC
+import CharSheet.Focus (Focus)
+import CharSheet.Focus as CF
+import CharSheet.Focus.Default as FocusDefault
 import CharSheet.XP as CX
 import Data.Argonaut as A
 import Data.Array as Array


@@ 22,7 28,8 @@ import Data.Either (Either(..))
 import Data.Int as I
 import Data.Lens as L
 import Data.Lens.Index (ix)
-import Data.Maybe (Maybe(..), maybe')
+import Data.Maybe (Maybe(..), maybe, maybe')
+import Data.Traversable (sequence)
 import Data.Tuple (Tuple(..))
 import Effect.Aff (Aff, Error, error)
 import Effect.Class (liftEffect)


@@ 33,7 40,9 @@ type Character
   = { xp :: CX.XP
     , class :: CC.Class
     , attributes :: CA.Attributes
-    , background :: Maybe CB.Background
+    , background :: Maybe Background
+    , chosenFoci :: Array ChosenFocus
+    , possibleFoci :: Array Focus
     }
 
 fresh :: Character


@@ 42,6 51,8 @@ fresh =
   , class: CC.Undecided
   , attributes: CA.empty
   , background: Nothing
+  , chosenFoci: []
+  , possibleFoci: FocusDefault.foci
   }
 
 fromJson :: A.Json -> Maybe Character


@@ 54,26 65,34 @@ 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)
-  bg <- (L.preview ( A._Object <<< ix "background" <<< A._String ) j)
+  bg <- (L.preview (A._Object <<< ix "background" <<< A._String) j)
+  let
+    cfoci = (L.toArrayOf (A._Object <<< ix "chosenFoci" <<< A._JsonArray) j)
 
-  let background = Array.find
-                   (\b -> (L.view CB._background b) == bg)
-                   CB.backgrounds
+    pfoci = (L.toArrayOf (A._Object <<< ix "possibleFoci" <<< A._JsonArray) j)
 
-  pure $ { xp: CX.xp x
-         , class: cl
-         , attributes: CA.manual str dex con int wis cha
-         , background
-         }
+    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
+      , chosenFoci: maybe [] identity (sequence $ CCF.fromJson <$> cfoci)
+      , possibleFoci: maybe [] identity (sequence $ CF.fromJson <$> pfoci)
+      }
 
 toJson :: Character -> A.Json
-toJson { xp: x, class: c, attributes: a, background: b } =
+toJson { xp: x, class: c, attributes: a, background: b, possibleFoci: pf } =
   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)
+        , Tuple "possibleFoci" $ A.fromArray (CF.toJson <$> pf)
         ]
     )
 


@@ 99,3 118,6 @@ _xp = L.lens _.xp $ _ { xp = _ }
 
 _background :: L.Lens' Character (Maybe CB.Background)
 _background = L.lens _.background $ _ { background = _ }
+
+_possibleFoci :: L.Lens' Character (Array Focus)
+_possibleFoci = L.lens _.possibleFoci $ _ { possibleFoci = _ }

@@ 1,7 1,6 @@
 module CharSheet.Background where
 
 import Prelude
-
 import Data.Argonaut as A
 import Data.Lens as L
 import Data.Tuple (Tuple(..))

@@ 0,0 1,28 @@
+module CharSheet.ChosenFocus where
+
+import Prelude
+import Data.Argonaut as A
+import Data.Int as I
+import Data.Lens as L
+import Data.Lens.Index (ix)
+import Data.Maybe (Maybe)
+
+type ChosenFocus
+  = { name :: String
+    , level :: Int
+    }
+
+chosenFocus :: String -> Int -> ChosenFocus
+chosenFocus name level = { name, level }
+
+fromJson :: A.Json -> Maybe ChosenFocus
+fromJson json = do
+  name <- L.preview (A._Object <<< ix "name" <<< A._String) json
+  level <- I.ceil <$> L.preview (A._Object <<< ix "level" <<< A._Number) json
+  pure { name, level }
+
+_name :: L.Lens' ChosenFocus String
+_name = L.lens _.name $ _ { name = _ }
+
+_level :: L.Lens' ChosenFocus Int
+_level = L.lens _.level $ _ { level = _ }

@@ 0,0 1,64 @@
+module CharSheet.Focus where
+
+import Prelude
+import Data.Argonaut as A
+import Data.Lens as L
+import Data.Lens.Index (ix)
+import Data.Maybe (Maybe)
+import Data.Tuple (Tuple(..))
+import Foreign.Object as Object
+
+type Focus
+  = { name :: String
+    , description :: String
+    , levelOne :: String
+    , levelTwo :: String
+    }
+
+focus :: String -> String -> String -> String -> Focus
+focus name description levelOne levelTwo =
+  { name
+  , description
+  , levelOne
+  , levelTwo
+  }
+
+-- _ObjectKey :: forall profunctor. Choice profunctor => Strong profunctor => String -> profunctor Json Json -> profunctor Json Json
+_ObjectKey :: String -> L.Traversal' A.Json A.Json
+_ObjectKey key = (A._Object <<< ix key)
+
+fromJson :: A.Json -> Maybe Focus
+fromJson json = do
+  name <- L.preview (A._Object <<< ix "name" <<< A._String) json
+  description <- L.preview (A._Object <<< ix "description" <<< A._String) json
+  levelOne <- L.preview (_ObjectKey "levelOne" <<< A._String) json
+  levelTwo <- L.preview (_ObjectKey "levelTwo" <<< A._String) json
+  pure
+    { name
+    , description
+    , levelOne
+    , levelTwo
+    }
+
+toJson :: Focus -> A.Json
+toJson f =
+  A.fromObject
+    ( Object.fromFoldable
+        [ Tuple "name" $ A.fromString (L.view _name f)
+        , Tuple "description" $ A.fromString (L.view _description f)
+        , Tuple "levelOne" $ A.fromString (L.view _levelOne f)
+        , Tuple "levelTwo" $ A.fromString (L.view _levelTwo f)
+        ]
+    )
+
+_name :: L.Lens' Focus String
+_name = L.lens _.name $ _ { name = _ }
+
+_description :: L.Lens' Focus String
+_description = L.lens _.description $ _ { description = _ }
+
+_levelOne :: L.Lens' Focus String
+_levelOne = L.lens _.levelOne $ _ { levelOne = _ }
+
+_levelTwo :: L.Lens' Focus String
+_levelTwo = L.lens _.levelTwo $ _ { levelTwo = _ }

@@ 0,0 1,25 @@
+module CharSheet.Focus.Default where
+
+import CharSheet.Focus
+
+foci :: Array Focus
+foci =
+  [ focus
+      "Alert"
+      """
+You are keenly aware of your surroundings and virtually
+impossible to take you unaware. You have an instinctive
+alacrity of response that helps you act before less wary
+persons can think to move.
+"""
+      """
+Gain notice as a bonus skill. You cannot be surprised,
+nor can others use the Execution Attack option on you.
+When you roll initiative, roll twice and take the
+best result.
+"""
+      """
+You always act first in a combat round unless someone
+else involved is also Alert.
+"""
+  ]

@@ 1,7 1,6 @@
 module UI.Background where
 
 import Prelude
-
 import CharSheet.Background as CB
 import Data.Array as Array
 import Data.Lens as L


@@ 35,22 34,23 @@ 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
+      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
-
+          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" ] ]
+        [ 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"]))
+            [ 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" ])
+            )
         ]

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


@@ 13,6 12,7 @@ import Type.Proxy (Proxy(..))
 import UI.Attributes as UA
 import UI.Background as UB
 import UI.Class as UC
+import UI.Foci.PossibleList as PossibleFoci
 import UI.Level as UILevel
 import UI.Util as Util
 import UI.XP as UIXP


@@ 41,6 41,7 @@ type Slots
     , class :: (UC.Slot Unit)
     , attributes :: (UA.Slot Unit)
     , background :: (UB.Slot Unit)
+    , possibleFoci :: (PossibleFoci.Slot Unit)
     )
 
 _xp = Proxy :: Proxy "xp"


@@ 53,6 54,8 @@ _attributes = Proxy :: Proxy "attributes"
 
 _background = Proxy :: Proxy "background"
 
+_possibleFoci = Proxy :: Proxy "possibleFoci"
+
 component :: forall m. MonadEffect m => H.Component Query Input Output m
 component =
   H.mkComponent


@@ 79,21 82,26 @@ render state =
     attr = L.view C._attributes state
 
     background = L.view C._background state
+
+    possibleFoci = L.view C._possibleFoci state
   in
-    HH.div
-      [ Util.classes
-          [ "border-solid"
-          , "border-2"
-          , "border-black"
-          , "m-2"
-          , "p-2"
-          , "w-4/6"
+    HH.div []
+      [ HH.div
+          [ Util.classes
+              [ "border-solid"
+              , "border-2"
+              , "border-black"
+              , "m-2"
+              , "p-2"
+              , "w-4/6"
+              ]
           ]
-      ]
-      [ 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
+          [ 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
+          ]
+      , HH.div [] [ HH.slot_ _possibleFoci unit PossibleFoci.component possibleFoci ]
       ]
 
 handleAction :: forall m. MonadEffect m => Action -> H.HalogenM State Action Slots Output m Unit

@@ 0,0 1,27 @@
+module UI.Foci.PossibleList where
+
+import Prelude
+import CharSheet.Focus as CF
+import Data.Lens as L
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.Hooks as Hooks
+
+-- list the possible foci so the user can select one.
+type Input
+  = Array CF.Focus
+
+data Message
+  = ChooseFocus CF.Focus
+
+type Slot s
+  = forall q. H.Slot q Message s
+
+focus :: forall w i. CF.Focus -> HH.HTML w i
+focus f = HH.div [] [ HH.h1_ [ HH.text (L.view CF._name f) ] ]
+
+component :: forall q m. H.Component q Input Message m
+component =
+  Hooks.component \_ possibleFoci -> Hooks.do
+    Hooks.pure do
+      HH.div [] (focus <$> possibleFoci)