module Diagrams.Puzzles.Pyramid where
import Diagrams.Prelude
import Data.Puzzles.Elements
import Data.Puzzles.Pyramid
import Diagrams.Puzzles.Lib
import Diagrams.Puzzles.Widths
pgray :: Colour Double
pgray = blend 0.6 white black
cell :: Backend' b => Bool -> Diagram b R2
cell s = square 1 # lwG onepix # if s then fc pgray else id
clue :: Backend' b => Maybe Int -> Diagram b R2
clue Nothing = mempty
clue (Just c) = text' (show c)
cellc :: Backend' b => Bool -> Maybe Int -> Diagram b R2
cellc s c = clue c `atop` cell s
row :: Backend' b => Row -> Diagram b R2
row (R cs s) = centerX . hcat . map (cellc s) $ cs
pyramid :: Backend' b => Pyramid -> Diagram b R2
pyramid = alignBL . vcat . map row . unPyr
kropki :: Backend' b => KropkiDot -> Diagram b R2
kropki KNone = mempty
kropki c = circle 0.1 # lwG 0.03 # fc (col c) # smash
where col KWhite = white
col KBlack = blend 0.98 black white
col KNone = error "can't reach"
krow :: Backend' b => KropkiRow -> Diagram b R2
krow (KR cs s ks) = ccat dots <> ccat clues
where ccat = centerX . hcat
clues = map (cellc s) cs
dots = interleave (map phantom' clues) (map kropki ks)
kpyramid :: Backend' b => RowKropkiPyramid -> Diagram b R2
kpyramid = alignBL . vcat . map krow . unKP