diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 24 | 
1 files changed, 13 insertions, 11 deletions
diff --git a/src/Main.hs b/src/Main.hs index b7c6a6e..f46fd3e 100644 --- a/src/Main.hs +++ b/src/Main.hs  | |||
| @@ -32,6 +32,7 @@ import Data.Bool | |||
| 32 | import Data.Function | 32 | import Data.Function | 
| 33 | 33 | ||
| 34 | import Control.Monad.State.Strict | 34 | import Control.Monad.State.Strict | 
| 35 | import Control.Monad.Trans.Maybe | ||
| 35 | 36 | ||
| 36 | import Sequence.Types | 37 | import Sequence.Types | 
| 37 | import Sequence.Contact.Types | 38 | import Sequence.Contact.Types | 
| @@ -92,11 +93,11 @@ stateOutline st | |||
| 92 | faction id = fromJust $ view eFaction <$> Map.lookup id (st ^. gEntities) | 93 | faction id = fromJust $ view eFaction <$> Map.lookup id (st ^. gEntities) | 
| 93 | factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions | 94 | factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions | 
| 94 | rowGs = do | 95 | rowGs = do | 
| 95 | rowGroup'@((review seqVal' -> seqVal, _):_) <- protoRows | 96 | rowGroup'@((seq, _):_) <- protoRows | 
| 96 | let | 97 | let | 
| 97 | rowGroup = map snd rowGroup' | 98 | rowGroup = map snd rowGroup' | 
| 98 | factionColumn i = [evalState ?? st $ toName x | x <- rowGroup, factionIndex x == i ] | 99 | factionColumn i = [evalState ?? st $ toName x | x <- rowGroup, factionIndex x == i ] | 
| 99 | return . colsAllG top $ [seqVal] : map factionColumn [0..(length factions - 1)] | 100 | return . colsAllG top $ [show $ view seqVal seq] : map factionColumn [0..(length factions - 1)] | 
| 100 | 101 | ||
| 101 | -- Query state | 102 | -- Query state | 
| 102 | listFactions, listEntities :: Sh GameState () | 103 | listFactions, listEntities :: Sh GameState () | 
| @@ -195,12 +196,13 @@ factionSeqVal :: Completable Faction -> Sh GameState () | |||
| 195 | factionSeqVal = withArg $ \qFaction -> use gEntities >>= mapM_ (entitySeqVal') . Map.keys . Map.filter ((==) qFaction . view eFaction) | 196 | factionSeqVal = withArg $ \qFaction -> use gEntities >>= mapM_ (entitySeqVal') . Map.keys . Map.filter ((==) qFaction . view eFaction) | 
| 196 | 197 | ||
| 197 | entitySeqVal' :: EntityIdentifier -> Sh GameState () | 198 | entitySeqVal' :: EntityIdentifier -> Sh GameState () | 
| 198 | entitySeqVal' ident = do | 199 | entitySeqVal' ident = void . runMaybeT $ do | 
| 199 | entity <- preuse (gEntities . ix ident) | 200 | entity <- MaybeT $ preuse (gEntities . ix ident) | 
| 200 | let sVal = preview (eStats . sSeqVal) =<< entity | 201 | sVal <- MaybeT . return $ preview (eStats . sSeqVal) entity | 
| 201 | case (,) <$> entity <*> sVal of | 202 | name <- toName ident | 
| 202 | Nothing -> return () | 203 | round <- use gRound | 
| 203 | Just (entity, sVal) -> do | 204 | (newEntity, sNum) <- evalFormula name entity sVal | 
| 204 | name <- toName ident | 205 | let val = Just $ def | 
| 205 | (newEntity, view (seqVal . re _Just) -> val) <- evalFormula name entity sVal | 206 | & set seqRound round | 
| 206 | gEntities . at ident .= Just (newEntity & set eSeqVal val) | 207 | & set seqVal (Just sNum) | 
| 208 | gEntities . at ident .= Just (newEntity & set eSeqVal val) | ||
