-- | Drawing plane partitions

{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
module Math.Combinat.Diagrams.Partitions.Plane where

--------------------------------------------------------------------------------

import Math.Combinat.Partitions.Integer
import Math.Combinat.Partitions.Plane

import Math.Combinat.Diagrams.Tableaux as Tableaux

-- import Data.Monoid
import Data.AffineSpace
import Data.VectorSpace
import Data.Colour
import Diagrams.Core
import Diagrams.Prelude
import Diagrams.TwoD.Text

--------------------------------------------------------------------------------

drawPlanePartition3D :: (Renderable (Path R2) b) => PlanePart -> Diagram b R2
drawPlanePartition3D = drawPlanePartition3D' (cadetblue,indianred,lawngreen)

-- | Draws 3D-like (but in fact 2D) diagram of a plane partition, coloring the faces with the given colors
--
drawPlanePartition3D' :: (Renderable (Path R2) b) => (Colour Double, Colour Double, Colour Double) -> PlanePart -> Diagram b R2
drawPlanePartition3D' (col1,col2,col3) pp@(PlanePart pps) = final where

  final  =  leftSides  # fc col1 # lwL linewidth
         <> rightSides # fc col2 # lwL linewidth
         <> topSides   # fc col3 # lwL linewidth

  layers = planePartLayers pp

  linewidth = 0.05 :: Double

  dir_top   = unitY
  dir_left  = fromDirection ( 210  @@ deg)
  dir_right = fromDirection ((-30) @@ deg)

  ndir_top   = negateV dir_top
  ndir_left  = negateV dir_left
  ndir_right = negateV dir_right

  leftSides  = mconcat $ zipWith lefts  [0..] layers
  rightSides = mconcat $ zipWith rights [0..] layers
 
  topSides   = mconcat $ map tops [1..planePartZHeight pp]

  iscale i v = if i /= 0 then scale (fromIntegral i) v else zeroV 

  tr :: (Transformable t, V t ~ R2) => Int -> Int -> Int -> t -> t
  tr i j k = translate ( iscale i dir_right ^+^
                         iscale j dir_left  ^+^
                         iscale k dir_top   )

  rights h (Partition ps) = mconcat [ tr p i h rightRect | (p,i) <- zip ps [0..]                  ]
  lefts  h (Partition ps) = mconcat [ tr j q h leftRect  | (j,q) <- zip [0..] (_dualPartition ps) ]

  tops h = mconcat [ tr j i h topRect | (i,ps) <- (zip [0..] pps) , (j,k) <- (zip [0..] ps) , k==h ]
  
  rightRect = strokeTrail $ glueTrail $ trailFromOffsets [ dir_top  , dir_left  , ndir_top  , ndir_left  ]
  leftRect  = strokeTrail $ glueTrail $ trailFromOffsets [ dir_top  , dir_right , ndir_top  , ndir_right ]
  topRect   = strokeTrail $ glueTrail $ trailFromOffsets [ dir_left , dir_right , ndir_left , ndir_right ]

--------------------------------------------------------------------------------

-- | Draws a plane partitions as a tablaeux, with numbers indicating the Z height
drawPlanePartition2D :: (Renderable (Path R2) b, Renderable Text b) => PlanePart -> Diagram b R2
drawPlanePartition2D = Tableaux.drawTableau . fromPlanePart

--------------------------------------------------------------------------------