-- | output module for dihaa: write PNG using Rasterific

-- -------------------------------------------------------------------
-- Copyright (C) 2017 by Sascha Wilde <wilde@sha-bang.de>

-- This program is free software under the GNU GPL (>=v2)
-- Read the file COPYING coming with the software for details.
-- -------------------------------------------------------------------

module Dihaa.OutputPNG (outputFilePNG) where

import Dihaa
import Dihaa.Vectorize
import TwoD

import Paths_dihaa

import Control.Applicative
import Data.Maybe
import Data.Monoid
import Graphics.Text.TrueType (loadFontFile, Font)
import Codec.Picture( PixelRGBA8( .. ), writePng )
import Graphics.Rasterific
import Graphics.Rasterific.Texture

scaleXFactor :: Int
scaleXFactor = 9
scaleYFactor :: Int
scaleYFactor = 15
margin :: Int
margin = 6

scaleX :: Float -> Float
scaleX = (fromIntegral margin +) . (fromIntegral scaleXFactor *)
scaleY :: Float -> Float
scaleY = (fromIntegral margin +) . (fromIntegral scaleYFactor *)

pToV2 :: Dihaa.Vectorize.Point -> Float -> Graphics.Rasterific.Point
pToV2 (P x y) o = V2 (scaleX (fromIntegral x)
                      + (fromIntegral scaleXFactor/2) + o)
                  (scaleY (fromIntegral y)
                   + (fromIntegral scaleYFactor/2) + o)

drawBoxes :: Float -> Maybe PixelRGBA8 -> [Shape] -> Drawing PixelRGBA8 ()
drawBoxes o maybeColor = mconcat . fmap drawBox
  where
    drawBox (Box p1 p2 (RGB r g b)) = let color = fromJust
                                            $ maybeColor
                                            <|> Just (PixelRGBA8
                                                       (fromIntegral r)
                                                       (fromIntegral g)
                                                       (fromIntegral b) 255)
                                      in
      withTexture (uniformTexture color)
      $ fill $ rectangle (pToV2 p1 o) (calcW p1 p2) (calcH p1 p2)
    drawBox _ = return ()
    calcW (P x1 _) (P x2 _) = fromIntegral ((x2 - x1) * scaleXFactor)
    calcH (P _ y1) (P _ y2) = fromIntegral ((y2 - y1) * scaleYFactor)

drawLabels :: Float -> Font -> [Shape] -> Drawing px ()
drawLabels o fnt = mconcat . fmap drawLabel
  where
    drawLabel (Label p s) = let (V2 x y) = pToV2 p o in
                              printTextAt fnt (PointSize 11.25)
                              (V2 (x - (fromIntegral scaleXFactor*0.6))
                                  (y + (fromIntegral scaleXFactor*0.5)))
                              s
    drawLabel _ = return ()

drawLines :: Float -> [Shape] -> Drawing px ()
drawLines o = mconcat . fmap drawLine
  where
    drawLine (Dihaa.Vectorize.Line p1 p2) =
      stroke 1 (JoinMiter 0) (CapStraight 1,CapStraight 1) $
      line (pToV2 p1 o) (pToV2 p2 o)
    drawLine _ = return ()

diaArrow :: Graphics.Rasterific.Point -> TwoD.Direction -> Drawing px ()
diaArrow (V2 x y) dir = fill $ case dir of
                                 N -> polygon [V2 x (y-hH+sp),
                                               V2 (x+hS) (y-hH+sp+fS),
                                               V2 (x-hS) (y-hH+sp+fS)]
                                 S -> polygon [V2 x (y+hH-sp),
                                               V2 (x+hS) (y+hH-sp-fS),
                                               V2 (x-hS) (y+hH-sp-fS)]
                                 W -> polygon [V2 (x-hW+sp) y,
                                               V2 (x-hW+sp+fS) (y-hS),
                                               V2 (x-hW+sp+fS) (y+hS)]
                                 E -> polygon [V2 (x+hW-sp) y,
                                               V2 (x+hW-sp-fS) (y-hS),
                                               V2 (x+hW-sp-fS) (y+hS)]
  where
    hW = fromIntegral scaleXFactor / 2
    hH = fromIntegral scaleYFactor / 2
    hS = min hW hH * 0.8
    fS = hS * 2
    sp = min hW hH * 0.2

drawArrows :: Float -> [Shape] -> Drawing px ()
drawArrows o = mconcat . fmap drawArrow
  where
    drawArrow (Arrow p1 d) = diaArrow (pToV2 p1 o) d
    drawArrow _ = return ()

outputFilePNG :: String -> Dia -> IO ()
outputFilePNG name d = do
  fontFileName <- getDataFileName "fonts/DroidSansMono.ttf"
  fontErr <- loadFontFile fontFileName
  case fontErr of
    Left err -> error err
    Right font ->
      writePng name img
      where bgColor = PixelRGBA8 240 240 240 255
            black = PixelRGBA8 0 0 0 255
            boxColor = PixelRGBA8 255 255 255 255
            shdwColor = PixelRGBA8 0 0 0 40
            (w,h) = getSize d
            vs = vectorize d
            img = renderDrawing
                  (w * scaleXFactor + 2 * margin)
                  (h * scaleYFactor + 2 * margin)
                  bgColor
                  $ drawBoxes 5 (Just shdwColor) vs
                  >> drawBoxes 0 Nothing vs
                  >> (withTexture (uniformTexture black)
                      $ mconcat [drawLines 0 vs,
                                 drawArrows 0 vs,
                                 drawLabels 0 font vs])