Browse Source

a bit of interface change

Getty Ritter 9 months ago
parent
commit
073507472b
3 changed files with 26 additions and 13 deletions
  1. 8 4
      src/Main.hs
  2. 6 2
      src/Rolling/Common.hs
  3. 12 7
      src/Rolling/Render.hs

+ 8 - 4
src/Main.hs

@@ -15,21 +15,25 @@ diagrams =
   [ Diagram
       { title = "PbtA rolls (2d6)",
         filename = "pbta.png",
-        rolls = [(n, PBTA.roll n) | n <- [0 .. 5]]
+        rolls = [(n, PBTA.roll n) | n <- [0 .. 5]],
+        render = Render.diagramPbtA
       },
     Diagram
       { title = "FitD roll (d6 pool)",
         filename = "fitd.png",
-        rolls = [(n, FITD.roll n) | n <- [0 .. 5]]
+        rolls = [(n, FITD.roll n) | n <- [0 .. 5]],
+        render = Render.diagramPbtA
       },
     Diagram
       { title = "PbtA-ish roll (d20)",
         filename = "d20.png",
-        rolls = [(n, PBTA20.roll n) | n <- [0 .. 10]]
+        rolls = [(n, PBTA20.roll n) | n <- [0 .. 10]],
+        render = Render.diagramPbtA
       },
     Diagram
       { title = "Ironsworn roll",
         filename = "ironsworn.png",
-        rolls = [(n, Ironsworn.roll n) | n <- [0 .. 5]]
+        rolls = [(n, Ironsworn.roll n) | n <- [0 .. 5]],
+        render = Render.diagramPbtA
       }
   ]

+ 6 - 2
src/Rolling/Common.hs

@@ -1,11 +1,15 @@
+{-# LANGUAGE ExistentialQuantification #-}
+
 module Rolling.Common (Diagram (..), Prob, Result (..), normalize, die) where
 
 import Rolling.Prob
 
-data Diagram = Diagram
+data Diagram = forall a.
+  Diagram
   { title :: String,
     filename :: String,
-    rolls :: [(Int, Prob Result)]
+    rolls :: a,
+    render :: String -> String -> a -> IO ()
   }
 
 die :: Int -> Prob Int

+ 12 - 7
src/Rolling/Render.hs

@@ -1,4 +1,6 @@
-module Rolling.Render (diagram) where
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Rolling.Render (diagramPbtA, diagram) where
 
 import qualified Control.Monad as Monad
 import qualified Control.Monad.IO.Class as Monad
@@ -46,10 +48,9 @@ text t = do
     Pango.layoutSetFontDescription layout (Just font)
   return layout
 
-diagram :: Diagram -> IO ()
-diagram d = do
-  let results = rolls d
-      width = 380
+diagramPbtA :: String -> String -> [(Int, Prob Result)] -> IO ()
+diagramPbtA title filename results = do
+  let width = 380
       height = length results * 50 + 50
   surface <- Cairo.createImageSurface Cairo.FormatRGB24 width height
   Cairo.renderWith surface $ do
@@ -68,8 +69,12 @@ diagram d = do
       Cairo.stroke
 
     Cairo.setSourceRGB 0.0 0.0 0.0
-    layout <- text (title d)
+    layout <- text title
     Cairo.moveTo 20 (fromIntegral height - 50)
     Pango.showLayout layout
 
-  Cairo.surfaceWriteToPNG surface (filename d)
+  Cairo.surfaceWriteToPNG surface filename
+
+diagram :: Diagram -> IO ()
+diagram Diagram {title, filename, rolls, render} =
+  render title filename rolls