```
-- | Lattice path diagrams
--
-- For example, the code:
--
-- >  let u = UpStep
-- >      d = DownStep
-- >      path = [ u,u,d,u,u,u,d,u,d,d,u,d,u,u,u,d,d,d,d,d,u,d,u,u,d,d ]
-- >  drawLatticePath \$ path
--
-- produces the diagram:
--
-- <<svg/dyck_path.svg>>
--

{-# LANGUAGE FlexibleContexts #-}
module Math.Combinat.Diagrams.LatticePaths where

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

import Math.Combinat.LatticePaths

import Linear.Vector

import Data.Colour

import Diagrams.Core
import Diagrams.Prelude

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

-- | Which orientation to draw the lattice paths
data LatticeConvention
= Hilly                -- ^ the steps are @(1,1)@ and @(1,-1)@
| UpRight              -- ^ the steps are @(0,1)@ and @(0,1)@
deriving (Eq,Show)

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

-- | Draws a lattice path with the default settings
drawLatticePath :: Renderable (Path V2 Double) b => LatticePath -> QDiagram b V2 Double Any
drawLatticePath = drawLatticePath' Hilly red True

drawLatticePath'
:: Renderable (Path V2 Double) b
=> LatticeConvention        -- ^ orientation
-> Colour Double            -- ^ color
-> Bool                     -- ^ whether to draw a grid
-> LatticePath              -- ^ whether to draw a grid
-> QDiagram b V2 Double Any
drawLatticePath' convention color hasgrid xs =
if hasgrid
then path <> grid
else path

where
{-
path = go 0 0 ps where
go !x !y []     = mempty
go !x !y (p:ps) = case p of
UpStep   -> translate (r2 x y) up  <> go (x+1) (y+1) ps
DownStep -> translate (r2 x y) dn  <> go (x+1) (y-1) ps
-}

linewidth = 0.025

path = path0 # lwL (linewidth*2) # lc color
grid = grid0 # lwL (linewidth  )

path0 = fromOffsets [ case p of { UpStep -> up ; DownStep -> dn } | p <- xs ]
grid0 = case convention of
Hilly    -> drawRectangularGrid (length xs, pathHeight xs)
UpRight  -> drawRectangularGrid (b,a)

(a,b) = pathNumberOfUpDownSteps xs

(up,dn) = case convention of
Hilly    -> ( r2 (1,1) , r2 (1,-1) )
UpRight  -> ( r2 (0,1) , r2 (1, 0) )

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

-- | Draws a rectangular grid of the given size
drawRectangularGrid :: Renderable (Path V2 Double) b => (Int,Int) -> QDiagram b V2 Double Any
drawRectangularGrid (x,y) = grid # lc grey where
grid = horiz <> vert

horiz = mconcat [ translateY (fromIntegral i) hline | i<-[0..y] ]
vert  = mconcat [ translateX (fromIntegral j) vline | j<-[0..x] ]

hline = fromOffsets [ (fromIntegral x) *^ unitX ]
vline = fromOffsets [ (fromIntegral y) *^ unitY ]

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

```