M readme.org => readme.org +9 -2
@@ 42,8 42,10 @@ Weapons have damage dice and stuff, armour has armour class.
**** Model Name
**** Model Goal
+**** import JSON
+**** fromJson should return an Either CharParseError Character
*** Doing
-**** Model Foci
+**** WAIT 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.
@@ 51,7 53,12 @@ I'm thinking that we can have a list of /possible foci/ in the json file, and a
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
+**** TODO export json
+
+This is likely just a button which opens a window which lets you copy out raw json representing your character.
+
+We need the whole character passed into the component, but displaying it should be relatively easy.
+
*** Done
**** DONE save sheet on update
:LOGBOOK:
M src/CharSheet.purs => src/CharSheet.purs +5 -1
@@ 2,6 2,7 @@ module CharSheet
( Character(..)
, fresh
, fromJson
+ , toJsonString
, write
, _attributes
, _background
@@ 96,10 97,13 @@ toJson { xp: x, class: c, attributes: a, background: b, possibleFoci: pf } =
]
)
+toJsonString :: Character -> String
+toJsonString = A.stringify <<< toJson
+
write :: Character -> Aff (Either Error Unit)
write c = do
let
- s = A.stringify $ toJson c
+ s = toJsonString c
liftEffect $ Console.logShow $ "saving: " <> s
if s == "" then
pure $ Left $ error "[CharSheet] character data is empty"
A src/UI/CharacterSheet.purs => src/UI/CharacterSheet.purs +107 -0
@@ 0,0 1,107 @@
+module UI.CharacterSheet where
+
+import Prelude
+import CharSheet as C
+import CharSheet.XP as CXP
+import Data.Lens as L
+import Data.Maybe (Maybe(..))
+import Data.Tuple.Nested ((/\))
+import Effect.Class (class MonadEffect)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.Hooks as Hooks
+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
+import UI.XP as UIXP
+
+type Input
+ = C.Character
+
+data Message
+ = Save C.Character
+
+data Query s
+ = Set C.Character s
+
+_xp = Proxy :: Proxy "xp"
+
+_lvl = Proxy :: Proxy "lvl"
+
+_class = Proxy :: Proxy "class"
+
+_attributes = Proxy :: Proxy "attributes"
+
+_background = Proxy :: Proxy "background"
+
+_possibleFoci = Proxy :: Proxy "possibleFoci"
+
+component :: forall m. MonadEffect m => H.Component Query Input Message m
+component =
+ Hooks.component \({ outputToken, queryToken }) state -> Hooks.do
+ char /\ charID <- Hooks.useState state
+ Hooks.useQuery queryToken \q -> case q of
+ Set char' s -> do
+ Hooks.modify_ charID (\_ -> char')
+ pure $ Just s
+ let
+ xp = L.view C._xp char
+
+ cl = L.view C._class char
+
+ attr = L.view C._attributes char
+
+ background = L.view C._background char
+
+ possibleFoci = L.view C._possibleFoci char
+
+ save = do
+ c <- Hooks.get charID
+ Hooks.raise outputToken $ Save c
+
+ changeClass = case _ of
+ UC.ClassChosen c -> do
+ Hooks.modify_ charID $ L.set C._class c
+ save
+
+ changeBackground = case _ of
+ UB.SetBackground b -> do
+ Hooks.modify_ charID $ L.set C._background (Just b)
+ save
+
+ changeXP = case _ of
+ UIXP.IncXP -> do
+ Hooks.modify_ charID $ L.over C._xp CXP.inc
+ save
+ UIXP.DecXP -> do
+ Hooks.modify_ charID $ L.over C._xp CXP.dec
+ save
+
+ changeAttributes = case _ of
+ UA.UpdateAttributes as -> do
+ Hooks.modify_ charID $ L.set C._attributes as
+ save
+ Hooks.pure do
+ HH.div
+ [ Util.classes
+ [ "border-solid"
+ , "border-2"
+ , "border-black"
+ , "m-2"
+ , "p-2"
+ ]
+ ]
+ [ 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 } changeXP
+ , HH.slot_ _lvl unit UILevel.component xp
+ ]
+ , HH.slot _attributes unit UA.component attr changeAttributes
+ ]
M src/UI/Entry.purs => src/UI/Entry.purs +52 -113
@@ 2,136 2,75 @@ module UI.Entry where
import Prelude
import CharSheet as C
-import CharSheet.XP as CXP
import Data.Lens as L
import Data.Maybe (Maybe(..))
-import Effect.Class (class MonadEffect)
+import Data.Tuple.Nested ((/\))
+import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Console as Console
import Halogen as H
import Halogen.HTML as HH
+import Halogen.Hooks as Hooks
import Type.Proxy (Proxy(..))
-import UI.Attributes as UA
-import UI.Background as UB
-import UI.Class as UC
+import UI.CharacterSheet as UCh
import UI.Foci.PossibleList as PossibleFoci
-import UI.Level as UILevel
+import UI.ImportExport.ExportBox as ExportBox
+import UI.ImportExport.ImportBox as ImportBox
import UI.Util as Util
-import UI.XP as UIXP
-
-type State
- = C.Character
type Input
= C.Character
data Output
- = Save State
-
-data Query a
- = Load Input a
-
-data Action
- = XPOutput UIXP.Output
- | ChangeClass UC.Output
- | ChangeAttributes UA.Message
- | ChangeBackground UB.Message
+ = Save C.Character
-type Slots
- = ( xp :: (UIXP.Slot Unit)
- , lvl :: (UILevel.Slot Unit)
- , class :: (UC.Slot Unit)
- , attributes :: (UA.Slot Unit)
- , background :: (UB.Slot Unit)
- , possibleFoci :: (PossibleFoci.Slot Unit)
- )
+data Query s
+ = Load C.Character s
-_xp = Proxy :: Proxy "xp"
+_charSheet = Proxy :: Proxy "charSheet"
-_lvl = Proxy :: Proxy "lvl"
-
-_class = Proxy :: Proxy "class"
-
-_attributes = Proxy :: Proxy "attributes"
+_possibleFoci = Proxy :: Proxy "possibleFoci"
-_background = Proxy :: Proxy "background"
+_exportBox = Proxy :: Proxy "exportBox"
-_possibleFoci = Proxy :: Proxy "possibleFoci"
+_importBox = Proxy :: Proxy "importBox"
component :: forall m. MonadEffect m => H.Component Query Input Output m
component =
- H.mkComponent
- { initialState
- , render
- , eval:
- H.mkEval
- $ H.defaultEval
- { handleQuery = handleQuery
- , handleAction = handleAction
- }
- }
-
-initialState :: Input -> State
-initialState = identity
-
-render :: forall m. MonadEffect m => State -> H.ComponentHTML Action Slots m
-render state =
- let
- xp = L.view C._xp state
-
- cl = L.view C._class state
-
- attr = L.view C._attributes state
-
- background = L.view C._background state
-
- possibleFoci = L.view C._possibleFoci state
- in
- 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.div [] [ HH.slot_ _possibleFoci unit PossibleFoci.component possibleFoci ]
- ]
-
-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
- H.modify_ $ L.set C._attributes as
- c <- H.get
- H.raise $ Save c
- ChangeClass output -> do
- case output of
- UC.ClassChosen c -> H.modify_ $ L.set C._class c
- c <- H.get
- H.raise $ Save c
- XPOutput output -> do
- case output of
- UIXP.IncXP -> H.modify_ $ L.over C._xp CXP.inc
- UIXP.DecXP -> H.modify_ $ L.over C._xp CXP.dec
- c <- H.get
- H.raise $ Save c
-
-handleQuery :: forall a m o. Query a -> H.HalogenM State Action Slots o m (Maybe a)
-handleQuery = case _ of
- Load c a -> do
- H.modify_ \_ -> c
- pure (Just a)
+ Hooks.component \t state -> Hooks.do
+ char /\ charId <- Hooks.useState state
+ let
+ updateCharacter c = do
+ Hooks.raise t.outputToken $ Save c
+ Hooks.tell t.slotToken _charSheet unit (UCh.Set c)
+ Hooks.tell t.slotToken _exportBox unit (ExportBox.SetCharacter c)
+ Hooks.captures {} Hooks.useTickEffect do
+ liftEffect $ Console.log "re-rendering"
+ pure Nothing
+ Hooks.useQuery t.queryToken \x -> case x of
+ Load c s -> do
+ Hooks.modify_ charId \_ -> c
+ updateCharacter c
+ pure $ Just s
+ let
+ possibleFoci = L.view C._possibleFoci char
+
+ requestSave = case _ of
+ UCh.Save c -> updateCharacter c
+
+ importCharacter = case _ of
+ ImportBox.ImportCharacter c -> updateCharacter c
+ Hooks.pure do
+ HH.div
+ [ Util.classes [ "grid", "grid-cols-4" ] ]
+ [ HH.div
+ [ Util.classes [ "col-span-3" ] ]
+ [ HH.slot _charSheet unit UCh.component char requestSave ]
+ , HH.div
+ [ Util.classes [ "col-span-1", "flex", "flex-col", "pr-4" ] ]
+ [ HH.div [] [ HH.slot_ _possibleFoci unit PossibleFoci.component possibleFoci ]
+ , HH.div
+ [ Util.classes [ "mb-4" ] ]
+ [ HH.slot _importBox unit ImportBox.component unit importCharacter ]
+ , HH.div_ [ HH.slot_ _exportBox unit ExportBox.component char ]
+ ]
+ ]
A src/UI/ImportExport/Button.purs => src/UI/ImportExport/Button.purs +21 -0
@@ 0,0 1,21 @@
+module UI.ImportExport.Button where
+
+import Effect.Class (class MonadEffect)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.Hooks as Hooks
+
+data Message
+ = Pressed
+
+type Slot s
+ = forall q. H.Slot q Message s
+
+component :: forall q i m. MonadEffect m => H.Component q i Message m
+component =
+ Hooks.component \t _ -> Hooks.do
+ let
+ handleClick = \_ -> Hooks.raise t.outputToken Pressed
+ Hooks.pure do
+ HH.div_ [ HH.button [ HE.onClick handleClick ] [ HH.text "import/export" ] ]
A src/UI/ImportExport/ExportBox.purs => src/UI/ImportExport/ExportBox.purs +39 -0
@@ 0,0 1,39 @@
+module UI.ImportExport.ExportBox where
+
+import Prelude
+import CharSheet as C
+import Data.Maybe (Maybe(..))
+import Data.Tuple.Nested ((/\))
+import Effect.Class (class MonadEffect)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import Halogen.Hooks as Hooks
+import UI.Util as Util
+
+type Input
+ = C.Character
+
+data Query s
+ = SetCharacter C.Character s
+
+component :: forall o m. MonadEffect m => H.Component Query Input o m
+component =
+ Hooks.component \p state -> Hooks.do
+ char /\ charId <- Hooks.useState state
+ Hooks.useQuery p.queryToken case _ of
+ SetCharacter c s -> do
+ Hooks.modify_ charId (const c)
+ pure $ Just s
+ Hooks.pure do
+ HH.div
+ [ Util.classes [ "border-2", "border-black", "flex", "flex-col", "justify-items-center", "p-4" ] ]
+ [ HH.h6 [ Util.classes [ "text-lg", "font-bold" ] ] [ HH.text "Export:" ]
+ , HH.textarea
+ [ HP.value $ C.toJsonString char
+ , HP.cols 80
+ , HP.rows 15
+ , Util.classes [ "border", "border-black" ]
+ ]
+ , HH.p_ [ HH.text "Copy this text and keep it somewhere safe to export your character." ]
+ ]
A src/UI/ImportExport/ImportBox.purs => src/UI/ImportExport/ImportBox.purs +61 -0
@@ 0,0 1,61 @@
+module UI.ImportExport.ImportBox where
+
+import Prelude
+import CharSheet as C
+import Data.Argonaut as A
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Tuple.Nested ((/\))
+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 Halogen.Hooks as Hooks
+import UI.Util as Util
+
+data Output
+ = ImportCharacter C.Character
+
+data ImportError
+ = JsonDecodeError A.JsonDecodeError
+ | CharacterDecodeError String
+
+component :: forall q i m. MonadEffect m => H.Component q i Output m
+component =
+ Hooks.component \t _ -> Hooks.do
+ text /\ textId <- Hooks.useState ""
+ parseError /\ parseErrorId <- Hooks.useState (Nothing :: Maybe ImportError)
+ let
+ json = A.parseJson text
+
+ importButton = \_ -> do
+ case json of
+ Left err -> Hooks.modify_ parseErrorId $ const $ Just (JsonDecodeError err)
+ Right j -> do
+ -- json into char
+ -- raise character
+ case C.fromJson j of
+ Nothing -> Hooks.modify_ parseErrorId $ const $ Just (CharacterDecodeError "unable to parse into a Character")
+ Just c -> Hooks.raise t.outputToken (ImportCharacter c)
+ Hooks.pure do
+ HH.div
+ [ Util.classes [ "border-2", "border-black", "flex", "flex-col", "justify-items-center", "p-4" ] ]
+ [ HH.textarea
+ [ HE.onValueChange \v -> (Hooks.modify_ textId \_ -> v)
+ , HP.value text
+ , HP.cols 80
+ , HP.rows 15
+ , Util.classes [ "border", "border-black" ]
+ ]
+ , HH.div_
+ [ HH.text
+ $ case parseError of
+ (Just (JsonDecodeError err)) -> show err
+ (Just (CharacterDecodeError err)) -> show err
+ Nothing -> ""
+ ]
+ , HH.button
+ [ HE.onClick importButton ]
+ [ HH.text "import" ]
+ ]