content: {-|
  Module      : Graphics.Shine.Render
  Description : Short description
  Copyright   : (c) Francesco Gazzetta, 2016
  License     : MIT
  Maintainer  : francygazz@gmail.com
  Stability   : experimental
  
  One-shot rendering, mostly used internally.
  -}
  module Graphics.Shine.Render (
    render
  ) where
  
  import GHCJS.DOM.HTMLImageElement (getWidth, getHeight)
  import GHCJS.DOM.CanvasRenderingContext2D
  import GHCJS.DOM.CanvasPath
  import GHCJS.DOM.Enums (CanvasWindingRule (CanvasWindingRuleNonzero))
  import GHCJS.DOM.Types (JSM, CanvasStyle (..))
  
  import GHCJS.Prim (toJSString)
  import Data.List (intercalate)
  
  import Graphics.Shine.Picture
  import Graphics.Shine.Image
  
  
  -- | Renders a picture on a 2D context.
  render :: CanvasRenderingContext2D -> Picture -> JSM ()
  render _ Empty = return ()
  render ctx (Line x y x' y') = do
      moveTo ctx x y
      lineTo ctx x' y'
      stroke ctx
  render ctx (Rect x y) = do
      rect ctx (-x/2) (-y/2) x y
      stroke ctx
  render ctx (RectF x' y') = fillRect ctx (-x/2) (-y/2) x y
    where x = realToFrac x'
          y = realToFrac y'
  render ctx (Polygon ((x,y):pts)) = do
      beginPath ctx
      moveTo ctx x y
      mapM_ (uncurry (lineTo ctx)) pts
      closePath ctx
      fill ctx $ Just CanvasWindingRuleNonzero --MAYBE Nothing
  render ctx (Polygon []) = render ctx Empty
  render ctx (Arc r a b direction) = do
      beginPath ctx
      arc ctx 0 0 r a b direction
      stroke ctx
  render ctx (CircleF r') = do
      save ctx
      render ctx $ circle r
      clip ctx $ Just CanvasWindingRuleNonzero --MAYBE Nothing
      render ctx $ RectF (r*2) (r*2)
      restore ctx
    where r = realToFrac r'
  render ctx (Text font align width' txt) = do
      setFont ctx font
      setTextAlign ctx $ case align of LeftAlign -> "left"
                                       CenterAlign -> "center"
                                       RightAlign -> "rignt"
      fillText ctx txt 0 0 width
    where width = realToFrac <$> width'
  render ctx (Image size (ImageData img)) =
      case size of
        Original -> do
            x <- ((/(-2)) . realToFrac) <$> getWidth img
            y <- ((/(-2)) . realToFrac) <$> getHeight img
            drawImage ctx img x y
        (Stretched w h) -> do
            let (x, y) = (-w/2, -h/2)
            drawImageScaled ctx img x y w h
        (Clipped a b c d) -> do
            let (x, y) = (-c/2, -d/2)
            drawImagePart ctx img a b c d x y c d
        (ClippedStretched a b c d e f) -> do
            let (x, y) = (-e/2, -f/2)
            drawImagePart ctx img a b c d x y e f
  render ctx (Over a b) = do
      render ctx a
      render ctx b
  render ctx (Colored col (Over a b)) = render ctx $ Over (Colored col a)
                                                      (Colored col b)
  -- push all the Colors to the leaves to avoid things like
  -- Color blue $ Translate _ _ $ Over (Color red pic) pic'q
  -- in which pic' would be black instead of blue:
  -- do
  --   set color blue -- first Colored
  --   translate
  --   set color red -- second Colored
  --   render pic
  --   set color back to black -- second Colored
  --   render pic' -- now this is black!
  --   translate back
  --   set color back to black -- first Colored
  render ctx (Colored col (Rotate angle pic)) =
      render ctx $ Rotate angle $ Colored col pic
  render ctx (Colored col (Translate x y pic)) =
      render ctx $ Translate x y $ Colored col pic
  render ctx (Colored _ (Colored col pic)) =
      render ctx $ Colored col pic --the innermost color wins
  render ctx (Colored (Color r g b a) pic) = do
      let colorString = "rgba("
                     ++ intercalate "," [show r, show g, show b, show a]
                     ++ ")"
      let color = toJSString colorString
      setFillStyle ctx $ CanvasStyle color
      setStrokeStyle ctx $ CanvasStyle color
      render ctx pic
      -- set the color back to black
      let black = toJSString "#000000"
      setFillStyle ctx $ CanvasStyle black
      setStrokeStyle ctx $ CanvasStyle black
  render ctx (Rotate angle' pic) = do
      rotate ctx angle
      render ctx pic
      --setTransform ctx 1 0 0 1 0 0 --not ok: prevents Rotate composition
      rotate ctx (-angle)
    where angle = realToFrac angle'
  render ctx (Translate x' y' pic) = do
      translate ctx x y
      render ctx pic
      translate ctx (-x) (-y)
    where x = realToFrac x'
          y = realToFrac y'
  
  