1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768 |
- module Rolling.Render (diagram) where
- import qualified Control.Monad.IO.Class as Monad
- import qualified Control.Monad 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
- [x] -> x
- _ -> 0.0
- renderRow :: Prob Result -> Int -> Cairo.Render ()
- renderRow results offset = do
- let f = findProb Failure results
- p = findProb Partial results
- s = findProb Success results
- o = 50.0 * fromIntegral offset + 5
- Cairo.rectangle 5 o (f * 290) 40
- Cairo.setSourceRGB 1.0 0.0 0.0
- Cairo.fill
- Cairo.rectangle (5 + f * 290) o (p * 290) 40
- Cairo.setSourceRGB 1.0 1.0 0.0
- Cairo.fill
- Cairo.rectangle (5 + (f + p) * 290) o (s * 290) 40
- Cairo.setSourceRGB 0.0 0.0 1.0
- Cairo.fill
- Cairo.setSourceRGB 0.0 0.0 0.0
- layout <- text ("+" ++ show offset)
- Cairo.moveTo 310.0 (50.0 * fromIntegral offset)
- Pango.showLayout layout
- text :: String -> Cairo.Render Pango.PangoLayout
- text t = do
- layout <- Pango.createLayout t
- Monad.liftIO $ do
- font <- Pango.fontDescriptionNew
- Pango.fontDescriptionSetFamily font "Fira Sans"
- Pango.fontDescriptionSetSize font 30
- Pango.layoutSetFontDescription layout (Just font)
- return layout
- diagram :: Diagram -> IO ()
- diagram d = do
- let results = rolls d
- width = 400
- height = length results * 50 + 50
- surface <- Cairo.createImageSurface Cairo.FormatRGB24 width height
- Cairo.renderWith surface $ do
- Cairo.setSourceRGB 1.0 1.0 1.0
- Cairo.rectangle 0.0 0.0 (fromIntegral width) (fromIntegral height)
- Cairo.fill
- Monad.forM_ results $ \(n, r) ->
- renderRow r n
- Cairo.setSourceRGB 0.0 0.0 0.0
- layout <- text (title d)
- Cairo.moveTo 20 (fromIntegral height - 50)
- Pango.showLayout layout
- Cairo.surfaceWriteToPNG surface (filename d)
|