summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-06-14 11:53:42 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2016-06-14 11:53:42 +0200
commit583f6cddc1c17bd93bb7b33cb1a5210fc330ff0f (patch)
treefbea91dff8e16fcda9df8d9632db35b5ab0877c2 /src
parentd196ace4100ec5f8cfb0fad265d3baa44873fc9d (diff)
download2017-01-16_17:13:37-583f6cddc1c17bd93bb7b33cb1a5210fc330ff0f.tar
2017-01-16_17:13:37-583f6cddc1c17bd93bb7b33cb1a5210fc330ff0f.tar.gz
2017-01-16_17:13:37-583f6cddc1c17bd93bb7b33cb1a5210fc330ff0f.tar.bz2
2017-01-16_17:13:37-583f6cddc1c17bd93bb7b33cb1a5210fc330ff0f.tar.xz
2017-01-16_17:13:37-583f6cddc1c17bd93bb7b33cb1a5210fc330ff0f.zip
cleanup
Diffstat (limited to 'src')
-rw-r--r--src/Sequence/Contact/Archetypes.hs226
-rw-r--r--src/Sequence/Formula.hs7
2 files changed, 117 insertions, 116 deletions
diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs
index 1bf2b7e..8bb44d4 100644
--- a/src/Sequence/Contact/Archetypes.hs
+++ b/src/Sequence/Contact/Archetypes.hs
@@ -15,7 +15,7 @@ import Sequence.Formula
15import Sequence.Types 15import Sequence.Types
16import Sequence.Utils 16import Sequence.Utils
17 17
18import Data.Map (Map) 18import Data.Map (Map, (!))
19import qualified Data.Map as Map 19import qualified Data.Map as Map
20 20
21import Data.Set (Set) 21import Data.Set (Set)
@@ -150,44 +150,44 @@ human = Humanoid
150 , (91, 100, "Linkes Bein") 150 , (91, 100, "Linkes Bein")
151 ] 151 ]
152 , _sArmor = const def 152 , _sArmor = const def
153 , _sCripple = fromJust . flip Map.lookup [ ("Kopf", def 153 , _sCripple = (!) [ ("Kopf", def
154 & set seVal (sDamage' "Kopf" . to return) 154 & set seVal (sDamage' "Kopf" . to return)
155 & set seBar (vitBar 0.5) 155 & set seBar (vitBar 0.5)
156 & set seReBar (vitBar 0.2) 156 & set seReBar (vitBar 0.2)
157 & set seEffect (cTable [ (1, 10, death "Kopf") 157 & set seEffect (cTable [ (1, 10, death "Kopf")
158 , (11, 25, effect "Blind") 158 , (11, 25, effect "Blind")
159 , (26, 35, effect "Blind, Rechts") 159 , (26, 35, effect "Blind, Rechts")
160 , (36, 45, effect "Blind, Links") 160 , (36, 45, effect "Blind, Links")
161 , (46, 75, effect "Taub") 161 , (46, 75, effect "Taub")
162 , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10) 162 , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10)
163 ]) 163 ])
164 ) 164 )
165 , ("Torso", def 165 , ("Torso", def
166 & set seVal (sDamage' "Torso" . to return) 166 & set seVal (sDamage' "Torso" . to return)
167 & set seBar (vitBar 0.75) 167 & set seBar (vitBar 0.75)
168 & set seReBar (vitBar 0.2) 168 & set seReBar (vitBar 0.2)
169 & set seEffect (cTable [ (1, 5, death "Torso") 169 & set seEffect (cTable [ (1, 5, death "Torso")
170 , (6, 25, Effect "Organschäden" . previews ctx $ over sFatigue (+ 25) . over (sDamage' "Torso") (+ 10)) 170 , (6, 25, Effect "Organschäden" . previews ctx $ over sFatigue (+ 25) . over (sDamage' "Torso") (+ 10))
171 , (26, 45, effect "Innere Blutung (3 Schaden (Au) Minuten)") 171 , (26, 45, effect "Innere Blutung (3 Schaden (Au) Minuten)")
172 , (46, 75, Effect "Bewusstlos" unconscious) 172 , (46, 75, Effect "Bewusstlos" unconscious)
173 , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10) 173 , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10)
174 ]) 174 ])
175 ) 175 )
176 , ("Rechter Arm", arm "Rechter Arm") 176 , ("Rechter Arm", arm "Rechter Arm")
177 , ("Linker Arm", arm "Linker Arm") 177 , ("Linker Arm", arm "Linker Arm")
178 , ("Unterleib", def 178 , ("Unterleib", def
179 & set seVal (sDamage' "Unterleib" . to return) 179 & set seVal (sDamage' "Unterleib" . to return)
180 & set seBar (vitBar 0.2) 180 & set seBar (vitBar 0.2)
181 & set seReBar (vitBar 0.2) 181 & set seReBar (vitBar 0.2)
182 & set seEffect ( cTable [ (1, 5, effect "Querschnittsgelähmt") 182 & set seEffect ( cTable [ (1, 5, effect "Querschnittsgelähmt")
183 , (6, 25, Effect "Kastration" . previews ctx $ over sFatigue (+ 15)) 183 , (6, 25, Effect "Kastration" . previews ctx $ over sFatigue (+ 15))
184 , (26, 50, effect "Innere Blutung (2 Schaden (Au) Minuten)") 184 , (26, 50, effect "Innere Blutung (2 Schaden (Au) Minuten)")
185 , (51, 100, Effect "Bewusstlos" unconscious) 185 , (51, 100, Effect "Bewusstlos" unconscious)
186 ]) 186 ])
187 ) 187 )
188 , ("Rechtes Bein", bein "Rechtes Bein") 188 , ("Rechtes Bein", bein "Rechtes Bein")
189 , ("Linkes Bein", bein "Linkes Bein") 189 , ("Linkes Bein", bein "Linkes Bein")
190 ] 190 ]
191 191
192 , _sDamage = const 0 192 , _sDamage = const 0
193 , _sFatigue = 0 193 , _sFatigue = 0
@@ -269,45 +269,45 @@ dog = Quadruped
269 , (91, 100, "Linker Hinterlauf") 269 , (91, 100, "Linker Hinterlauf")
270 ] 270 ]
271 , _sArmor = const def 271 , _sArmor = const def
272 , _sCripple = fromJust . flip Map.lookup [ ("Kopf", def 272 , _sCripple = (!) [ ("Kopf", def
273 & set seVal (sDamage' "Kopf" . to return) 273 & set seVal (sDamage' "Kopf" . to return)
274 & set seBar (vitBar 0.5) 274 & set seBar (vitBar 0.5)
275 & set seReBar (vitBar 0.2) 275 & set seReBar (vitBar 0.2)
276 & set seEffect (cTable [ (1, 10, death "Kopf") 276 & set seEffect (cTable [ (1, 10, death "Kopf")
277 , (11, 25, effect "Blind") 277 , (11, 25, effect "Blind")
278 , (26, 35, effect "Blind, Rechts") 278 , (26, 35, effect "Blind, Rechts")
279 , (36, 45, effect "Blind, Links") 279 , (36, 45, effect "Blind, Links")
280 , (46, 75, effect "Geruchssinn ist verloren") 280 , (46, 75, effect "Geruchssinn ist verloren")
281 , (76, 100, Effect "Bewusstlos" . unconsciousR $ 2 * d 10) 281 , (76, 100, Effect "Bewusstlos" . unconsciousR $ 2 * d 10)
282 ]) 282 ])
283 ) 283 )
284 , ("Torso", def 284 , ("Torso", def
285 & set seVal (sDamage' "Torso" . to return) 285 & set seVal (sDamage' "Torso" . to return)
286 & set seBar (vitBar 0.75) 286 & set seBar (vitBar 0.75)
287 & set seReBar (vitBar 0.2) 287 & set seReBar (vitBar 0.2)
288 & set seEffect ( cTable [ (1, 5, death "Torso") 288 & set seEffect ( cTable [ (1, 5, death "Torso")
289 , (6, 25, Effect "Organschäden" . previews ctx $ over sFatigue (+ 25) . over (sDamage' "Torso") (+ 10)) 289 , (6, 25, Effect "Organschäden" . previews ctx $ over sFatigue (+ 25) . over (sDamage' "Torso") (+ 10))
290 , (26, 45, effect "Innere Blutung (3 Schaden (Au) Minuten)") 290 , (26, 45, effect "Innere Blutung (3 Schaden (Au) Minuten)")
291 , (46, 75, Effect "Bewusstlos" unconscious) 291 , (46, 75, Effect "Bewusstlos" unconscious)
292 , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10) 292 , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10)
293 ]) 293 ])
294 ) 294 )
295 , ("Hinterteil", def 295 , ("Hinterteil", def
296 & set seVal (sDamage' "Hinterteil" . to return) 296 & set seVal (sDamage' "Hinterteil" . to return)
297 & set seBar (vitBar 0.2) 297 & set seBar (vitBar 0.2)
298 & set seReBar (vitBar 0.2) 298 & set seReBar (vitBar 0.2)
299 & set seEffect ( cTable [ (1, 5, effect "Querschnittsgelähmt") 299 & set seEffect ( cTable [ (1, 5, effect "Querschnittsgelähmt")
300 , (6, 25, Effect "Kastration" . previews ctx $ over sFatigue (+ 10)) 300 , (6, 25, Effect "Kastration" . previews ctx $ over sFatigue (+ 10))
301 , (26, 50, effect "Innere Blutung (2 Schaden (Au) Minuten)") 301 , (26, 50, effect "Innere Blutung (2 Schaden (Au) Minuten)")
302 , (51, 100, Effect "Bewusstlos" . unconsciousR $ 2 * d 10) 302 , (51, 100, Effect "Bewusstlos" . unconsciousR $ 2 * d 10)
303 ]) 303 ])
304 ) 304 )
305 , (\x -> (x, lauf x)) "Rechter Vorderlauf" 305 , (\x -> (x, lauf x)) "Rechter Vorderlauf"
306 , (\x -> (x, lauf x)) "Linker Vorderlauf" 306 , (\x -> (x, lauf x)) "Linker Vorderlauf"
307 , (\x -> (x, lauf x)) "Rechter Hinterlauf" 307 , (\x -> (x, lauf x)) "Rechter Hinterlauf"
308 , (\x -> (x, lauf x)) "Linker Hinterlauf" 308 , (\x -> (x, lauf x)) "Linker Hinterlauf"
309 ] 309 ]
310 310
311 , _sDamage = const 0 311 , _sDamage = const 0
312 , _sFatigue = 0 312 , _sFatigue = 0
313 313
@@ -360,41 +360,41 @@ dolphin = Dolphin
360 , ("Schwanz", 0.25) 360 , ("Schwanz", 0.25)
361 ] 361 ]
362 , _sArmor = const def 362 , _sArmor = const def
363 , _sCripple = fromJust . flip Map.lookup [ ("Kopf", def 363 , _sCripple = (!) [ ("Kopf", def
364 & set seVal (sDamage' "Kopf" . to return) 364 & set seVal (sDamage' "Kopf" . to return)
365 & set seBar (vitBar 0.6) 365 & set seBar (vitBar 0.6)
366 & set seReBar (vitBar 0.2) 366 & set seReBar (vitBar 0.2)
367 & set seEffect ( cTable [ (1, 10, death "Kopf") 367 & set seEffect ( cTable [ (1, 10, death "Kopf")
368 , (11, 25, effect "Blind") 368 , (11, 25, effect "Blind")
369 , (26, 35, effect "Blind, Rechts") 369 , (26, 35, effect "Blind, Rechts")
370 , (36, 45, effect "Blind, Links") 370 , (36, 45, effect "Blind, Links")
371 , (46, 75, effect "Verlust des Biosonar") 371 , (46, 75, effect "Verlust des Biosonar")
372 , (76, 100, Effect "Bewusstlos" . unconsciousR $ 2 * d 10) 372 , (76, 100, Effect "Bewusstlos" . unconsciousR $ 2 * d 10)
373 ]) 373 ])
374 ) 374 )
375 , ("Rumpf", def 375 , ("Rumpf", def
376 & set seVal (sDamage' "Rumpf" . to return) 376 & set seVal (sDamage' "Rumpf" . to return)
377 & set seBar (vitBar 0.8) 377 & set seBar (vitBar 0.8)
378 & set seReBar (vitBar 0.2) 378 & set seReBar (vitBar 0.2)
379 & set seEffect ( cTable [ (1, 5, death "Rumpf") 379 & set seEffect ( cTable [ (1, 5, death "Rumpf")
380 , (6, 25, Effect "Organschäden" . previews ctx $ over sFatigue (+ 7) . over (sDamage' "Rumpf") (+ 20)) 380 , (6, 25, Effect "Organschäden" . previews ctx $ over sFatigue (+ 7) . over (sDamage' "Rumpf") (+ 20))
381 , (26, 45, effect "Blutung (2 Schaden (Au) Minuten)") 381 , (26, 45, effect "Blutung (2 Schaden (Au) Minuten)")
382 , (46, 75, Effect "Bewusstlos" unconscious) 382 , (46, 75, Effect "Bewusstlos" unconscious)
383 , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10) 383 , (76, 100, Effect "Bewusstlos" . unconsciousR $ d 10)
384 ]) 384 ])
385 ) 385 )
386 , ("Schwanz", def 386 , ("Schwanz", def
387 & set seVal (sDamage' "Schwanz" . to return) 387 & set seVal (sDamage' "Schwanz" . to return)
388 & set seBar (vitBar 0.4) 388 & set seBar (vitBar 0.4)
389 & set seReBar (vitBar 0.2) 389 & set seReBar (vitBar 0.2)
390 & set seEffect ( cTable [ (1, 10, amputate "Schwanz") 390 & set seEffect ( cTable [ (1, 10, amputate "Schwanz")
391 , (11, 25, effect "Halbierte Bewegung") 391 , (11, 25, effect "Halbierte Bewegung")
392 , (26, 45, Effect "Schmerz" . previews ctx $ over sFatigue (+ 15)) 392 , (26, 45, Effect "Schmerz" . previews ctx $ over sFatigue (+ 15))
393 , (46, 100, effect "Fleischwunde") 393 , (46, 100, effect "Fleischwunde")
394 ]) 394 ])
395 ) 395 )
396 ] 396 ]
397 397
398 , _sDamage = const 0 398 , _sDamage = const 0
399 , _sFatigue = 0 399 , _sFatigue = 0
400 400
diff --git a/src/Sequence/Formula.hs b/src/Sequence/Formula.hs
index be5032a..a3675c6 100644
--- a/src/Sequence/Formula.hs
+++ b/src/Sequence/Formula.hs
@@ -103,9 +103,10 @@ quot' = liftM2 quot
103askQuestion :: (MonadIO m, sInput :<: lInput) => [String] -> (lInput, Maybe (Formula sInput)) -> Question sInput -> m (lInput, Maybe (Formula sInput)) 103askQuestion :: (MonadIO m, sInput :<: lInput) => [String] -> (lInput, Maybe (Formula sInput)) -> Question sInput -> m (lInput, Maybe (Formula sInput))
104askQuestion promptPref input q@(Question{..}) = flip (if keepResult then set $ _1 . ctx' . answer else set _2 . Just) input . maybe (throwError q) return <$> askQ (wPromptPref $ promptPref ++ prompt) (join . fmap readMaybe) 104askQuestion promptPref input q@(Question{..}) = flip (if keepResult then set $ _1 . ctx' . answer else set _2 . Just) input . maybe (throwError q) return <$> askQ (wPromptPref $ promptPref ++ prompt) (join . fmap readMaybe)
105 where 105 where
106 wPromptPref [] = " »" 106 wPromptPref [] = " " ++ sep
107 wPromptPref [x] = x ++ " »" 107 wPromptPref [x] = x ++ " " ++ sep
108 wPromptPref (x:xs) = x ++ " » " ++ wPromptPref xs 108 wPromptPref (x:xs) = x ++ " " ++ sep ++ " " ++ wPromptPref xs
109 sep = "»"
109 110
110evalFormula :: (MonadIO m, sInput :<: lInput) => [String] -> lInput -> FormulaM sInput a -> m (lInput, a) 111evalFormula :: (MonadIO m, sInput :<: lInput) => [String] -> lInput -> FormulaM sInput a -> m (lInput, a)
111evalFormula promptPref input = evalFormula' [] promptPref (input, Nothing) 112evalFormula promptPref input = evalFormula' [] promptPref (input, Nothing)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-14 17:40:35 +0000