summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-06-06 18:15:29 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2016-06-06 18:15:29 +0200
commit73c24db325e741ca9402152d934bd28c7ac89fed (patch)
treefb55e2fbdd63d53a41a820929c7b1423cbff61c4 /src/Main.hs
parent8e1232fc24c67e80c14d6b56904876550342b6b2 (diff)
download2017-01-16_17:13:37-73c24db325e741ca9402152d934bd28c7ac89fed.tar
2017-01-16_17:13:37-73c24db325e741ca9402152d934bd28c7ac89fed.tar.gz
2017-01-16_17:13:37-73c24db325e741ca9402152d934bd28c7ac89fed.tar.bz2
2017-01-16_17:13:37-73c24db325e741ca9402152d934bd28c7ac89fed.tar.xz
2017-01-16_17:13:37-73c24db325e741ca9402152d934bd28c7ac89fed.zip
reorder
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs20
1 files changed, 10 insertions, 10 deletions
diff --git a/src/Main.hs b/src/Main.hs
index f608c01..145df7a 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -103,11 +103,6 @@ listFactions, listEntities :: Sh GameState ()
103listFactions = use inhabitedFactions >>= mapM_ (shellPutStrLn . view faction') 103listFactions = use inhabitedFactions >>= mapM_ (shellPutStrLn . view faction')
104listEntities = use (gEntities . to Map.keys) >>= mapM_ (shellPutStrLn <=< toName) 104listEntities = use (gEntities . to Map.keys) >>= mapM_ (shellPutStrLn <=< toName)
105 105
106-- Manage faction
107listFaction, alignEntity :: Completable Faction -> Sh GameState ()
108listFaction = withArg $ \qFaction -> use gEntities >>= mapM_ (shellPutStrLn <=< toName) . Map.keys . Map.filter ((==) qFaction . view eFaction)
109alignEntity = withArg $ \nFaction -> withFocus $ \ident -> gEntities %= Map.adjust (set eFaction nFaction) ident
110
111-- Automatic focus 106-- Automatic focus
112focusTip, blur :: Sh GameState () 107focusTip, blur :: Sh GameState ()
113focusTip = gFocus <~ preuse tip 108focusTip = gFocus <~ preuse tip
@@ -138,6 +133,16 @@ nameEntity :: String -> Sh GameState ()
138nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)" 133nameEntity ('#':_) = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
139nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName) 134nameEntity name = withFocus $ \ident -> modifying gEntityNames $ Bimap.insert ident (name ^. entityName)
140 135
136-- Manage faction
137listFaction, alignEntity :: Completable Faction -> Sh GameState ()
138listFaction = withArg $ \qFaction -> use gEntities >>= mapM_ (shellPutStrLn <=< toName) . Map.keys . Map.filter ((==) qFaction . view eFaction)
139alignEntity = withArg $ \nFaction -> withFocus $ \ident -> gEntities %= Map.adjust (set eFaction nFaction) ident
140
141renameFaction :: Completable Faction -> Completable Faction -> Sh GameState ()
142renameFaction f1' f2' = withArg (\f1 -> withArg (\f2 -> renameFaction' f1 f2) f2') f1'
143 where
144 renameFaction' f1 f2 = modifying (gEntities . each . eFaction) (\cF -> bool cF f2 $ cF == f1)
145
141spawnFaction :: Completable Faction -> Integer -> Completable Entity -> String -> Sh GameState () 146spawnFaction :: Completable Faction -> Integer -> Completable Entity -> String -> Sh GameState ()
142spawnFaction cFaction num cEntity nameTemplate 147spawnFaction cFaction num cEntity nameTemplate
143 | ('#':_) <- nameTemplate = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)" 148 | ('#':_) <- nameTemplate = shellPutErrLn "We do not allow names that might shadow explicit access to entities via their number (‘#<n>’)"
@@ -197,8 +202,3 @@ entitySeqVal' ident = do
197 Just (entity, sVal) -> do 202 Just (entity, sVal) -> do
198 (newEntity, view (seqVal . re _Just) -> val) <- evalFormula entity sVal 203 (newEntity, view (seqVal . re _Just) -> val) <- evalFormula entity sVal
199 gEntities . at ident .= Just (newEntity & set eSeqVal val) 204 gEntities . at ident .= Just (newEntity & set eSeqVal val)
200
201renameFaction :: Completable Faction -> Completable Faction -> Sh GameState ()
202renameFaction f1' f2' = withArg (\f1 -> withArg (\f2 -> renameFaction' f1 f2) f2') f1'
203 where
204 renameFaction' f1 f2 = modifying (gEntities . each . eFaction) (\cF -> bool cF f2 $ cF == f1)