{-# LANGUAGE NamedFieldPuns #-}

module Rolling.Render (diagramPbtA, diagram) where

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
  [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

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
    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

    Monad.forM_ [0.0, 0.25, 0.5, 0.75, 1.0] $ \rat -> do
      let x = 5 + 290 * rat
      Cairo.setSourceRGB 0.0 0.0 0.0
      Cairo.moveTo x 5
      Cairo.lineTo x (fromIntegral (length results) * 50 - 5)
      Cairo.stroke

    Cairo.setSourceRGB 0.0 0.0 0.0
    layout <- text title
    Cairo.moveTo 20 (fromIntegral height - 50)
    Pango.showLayout layout

  Cairo.surfaceWriteToPNG surface filename

diagram :: Diagram -> IO ()
diagram Diagram {title, filename, rolls, render} =
  render title filename rolls