Getty Ritter 9 months ago
parent
commit
99d23c4034
5 changed files with 40 additions and 42 deletions
  1. 21 22
      src/Main.hs
  2. 5 5
      src/Rolling/Common.hs
  3. 1 1
      src/Rolling/FITD.hs
  4. 10 10
      src/Rolling/Prob.hs
  5. 3 4
      src/Rolling/Render.hs

+ 21 - 22
src/Main.hs

@@ -1,12 +1,11 @@
 module Main where
 
 import Rolling.Common
-import qualified Rolling.Render as Render
-
-import qualified Rolling.PBTA as PBTA
 import qualified Rolling.FITD as FITD
-import qualified Rolling.PBTA20 as PBTA20
 import qualified Rolling.Ironsworn as Ironsworn
+import qualified Rolling.PBTA as PBTA
+import qualified Rolling.PBTA20 as PBTA20
+import qualified Rolling.Render as Render
 
 main :: IO ()
 main = mapM_ Render.diagram diagrams
@@ -14,23 +13,23 @@ main = mapM_ Render.diagram diagrams
 diagrams :: [Diagram]
 diagrams =
   [ Diagram
-      { title = "PbtA rolls (2d6)"
-      , filename = "pbta.png"
-      , rolls = [ (n, PBTA.roll n) | n <- [0..5] ]
-      }
-  , Diagram
-      { title = "FitD roll (d6 pool)"
-      , filename = "fitd.png"
-      , rolls = [ (n, FITD.roll n) | n <- [0..5] ]
-      }
-  , Diagram
-      { title = "PbtA-ish roll (d20)"
-      , filename = "d20.png"
-      , rolls = [ (n, PBTA20.roll n) | n <- [0..10] ]
-      }
-  , Diagram
-      { title = "Ironsworn roll"
-      , filename = "ironsworn.png"
-      , rolls = [ (n, Ironsworn.roll n) | n <- [0..5] ]
+      { title = "PbtA rolls (2d6)",
+        filename = "pbta.png",
+        rolls = [(n, PBTA.roll n) | n <- [0 .. 5]]
+      },
+    Diagram
+      { title = "FitD roll (d6 pool)",
+        filename = "fitd.png",
+        rolls = [(n, FITD.roll n) | n <- [0 .. 5]]
+      },
+    Diagram
+      { title = "PbtA-ish roll (d20)",
+        filename = "d20.png",
+        rolls = [(n, PBTA20.roll n) | n <- [0 .. 10]]
+      },
+    Diagram
+      { title = "Ironsworn roll",
+        filename = "ironsworn.png",
+        rolls = [(n, Ironsworn.roll n) | n <- [0 .. 5]]
       }
   ]

+ 5 - 5
src/Rolling/Common.hs

@@ -1,15 +1,15 @@
-module Rolling.Common (Diagram(..), Prob, Result(..), normalize, die) where
+module Rolling.Common (Diagram (..), Prob, Result (..), normalize, die) where
 
 import Rolling.Prob
 
 data Diagram = Diagram
-  { title :: String
-  , filename :: String
-  , rolls :: [(Int, Prob Result)]
+  { title :: String,
+    filename :: String,
+    rolls :: [(Int, Prob Result)]
   }
 
 die :: Int -> Prob Int
-die n = Prob [(d, P 1 n) | d <- [1..n]]
+die n = Prob [(d, P 1 n) | d <- [1 .. n]]
 
 -- the success metric for vaguely PbtA-ish games
 data Result

+ 1 - 1
src/Rolling/FITD.hs

@@ -14,5 +14,5 @@ roll 0 = normalize $ do
   b <- die 6
   return (judge (a `min` b))
 roll n = normalize $ do
-  dice <- sequence [ die 6 | _ <- [1..n] ]
+  dice <- sequence [die 6 | _ <- [1 .. n]]
   return (judge (maximum dice))

+ 10 - 10
src/Rolling/Prob.hs

@@ -13,14 +13,13 @@ P a at `times` P b bt = P (a * b) (at * bt)
 
 combine :: [P] -> P
 combine ps =
-  let tots = [ t | P _ t <- ps ]
+  let tots = [t | P _ t <- ps]
       newTot = foldr lcm 1 tots
-      newNums = [ if t == newTot then n else error "FIXME" | P n t <- ps ]
-  in P (sum newNums) newTot
-
+      newNums = [if t == newTot then n else error "FIXME" | P n t <- ps]
+   in P (sum newNums) newTot
 
 -- a Prob monad that tracks possible things with their probabilities
-newtype Prob a = Prob { unprob :: [(a, P)] } deriving (Eq, Show)
+newtype Prob a = Prob {unprob :: [(a, P)]} deriving (Eq, Show)
 
 instance Functor Prob where
   fmap f (Prob xs) = Prob [(f x, p) | (x, p) <- xs]
@@ -31,13 +30,14 @@ instance Applicative Prob where
 
 instance Monad Prob where
   Prob xs >>= f =
-    Prob [ (y, p `times` p')
-         | (x, p) <- xs
-         , (y, p') <- unprob (f x)
-         ]
+    Prob
+      [ (y, p `times` p')
+        | (x, p) <- xs,
+          (y, p') <- unprob (f x)
+      ]
 
 -- probably the wrong name? this is collapsing identical possibilities
 -- into one
 normalize :: (Ord a) => Prob a -> Prob a
 normalize (Prob xs) =
-  Prob [(fst (head rs), combine (map snd rs)) | rs <- groupWith fst xs ]
+  Prob [(fst (head rs), combine (map snd rs)) | rs <- groupWith fst xs]

+ 3 - 4
src/Rolling/Render.hs

@@ -1,17 +1,16 @@
 module Rolling.Render (diagram) where
 
-import qualified Control.Monad.IO.Class as Monad
 import qualified Control.Monad as Monad
+import qualified Control.Monad.IO.Class as Monad
 import qualified Graphics.Rendering.Cairo as Cairo
 import qualified Graphics.Rendering.Pango as Pango
-
 import Rolling.Common
 import Rolling.Prob
 
 findProb :: Result -> Prob Result -> Double
-findProb r (Prob rs) = case [ fromIntegral n / fromIntegral t | (r', P n t) <- rs, r == r' ] of
+findProb r (Prob rs) = case [fromIntegral n / fromIntegral t | (r', P n t) <- rs, r == r'] of
   [x] -> x
-  _   -> 0.0
+  _ -> 0.0
 
 renderRow :: Prob Result -> Int -> Cairo.Render ()
 renderRow results offset = do