module Diagrams.Puzzles.PuzzleTypes (
lits, litsplus, geradeweg, fillomino, masyu, nurikabe, latintapa,
sudoku, thermosudoku, pyramid, kpyramid, slither,
liarslither, tightfitskyscrapers, wordloop, wordsearch,
curvedata, doubleback, slalom, compass, boxof2or3,
afternoonskyscrapers, meanderingnumbers, tapa, japanesesums,
coral, maximallengths, primeplace, labyrinth, bahnhof,
cave
) where
import Diagrams.Prelude hiding (Loop, coral)
import Diagrams.Puzzles.PuzzleGrids
import Diagrams.Puzzles.Draw
import Diagrams.Puzzles.Grid
import qualified Diagrams.Puzzles.Pyramid as DPyr
import Diagrams.Puzzles.Elements
import Diagrams.Puzzles.Lib
import Diagrams.Puzzles.Widths
import Data.Puzzles.Grid
import Data.Puzzles.GridShape (Edge)
import Data.Puzzles.Elements
import qualified Data.Puzzles.Pyramid as Pyr
lits :: Backend' b => RenderPuzzle b AreaGrid ShadedGrid
lits = (,)
drawAreaGridGray
(drawAreaGrid . fst <> drawShadedGrid . snd)
litsplus :: Backend' b => RenderPuzzle b AreaGrid ShadedGrid
litsplus = lits
solstyle :: (HasStyle a, V a ~ R2) => a -> a
solstyle = lc (blend 0.8 black white) . lwG (3 * onepix)
geradeweg :: Backend' b => RenderPuzzle b IntGrid Loop
geradeweg = (,)
drawIntGrid
(drawIntClues . fst
<> solstyle . drawDualEdges . snd
<> grid . size . fst)
fillomino :: Backend' b => RenderPuzzle b IntGrid (SGrid Int)
fillomino = (,)
(atCentres drawInt . clues <> dashedgrid . size)
((atCentres drawInt . values <> drawEdges . borders <> dashedgrid . size) . snd)
masyu :: Backend' b =>
RenderPuzzle b (SGrid (Clue MasyuPearl)) Loop
masyu = (,)
drawMasyuGrid
(solstyle . drawDualEdges . snd <> drawMasyuGrid . fst)
nurikabe :: Backend' b =>
RenderPuzzle b IntGrid ShadedGrid
nurikabe = (,)
drawIntGrid
(drawIntGrid . fst <> drawShadedGrid . snd)
latintapa :: Backend' b =>
RenderPuzzle b (SGrid (Clue [String])) CharClueGrid
latintapa = (,)
l
(l . fst <> atCentres drawChar . clues . snd)
where
l = grid . size <> drawWordsClues
sudoku :: Backend' b =>
RenderPuzzle b IntGrid IntGrid
sudoku = (,)
(drawIntClues <> sudokugrid)
((drawIntClues <> sudokugrid) . snd)
thermosudoku :: Backend' b =>
RenderPuzzle b (SGrid Int, [Thermometer]) IntGrid
thermosudoku = (,)
(drawInts . fst <> sudokugrid . fst <> drawThermos . snd)
(drawIntClues . snd <> sudokugrid . snd <> drawThermos . snd . fst)
pyramid :: Backend' b =>
RenderPuzzle b Pyr.Pyramid Pyr.PyramidSol
pyramid = (,)
DPyr.pyramid
(DPyr.pyramid . merge)
where
merge (p, q) = Pyr.mergepyramidsol p q
kpyramid :: Backend' b =>
RenderPuzzle b Pyr.RowKropkiPyramid Pyr.PyramidSol
kpyramid = (,)
DPyr.kpyramid
(DPyr.kpyramid . merge)
where
merge (p, q) = Pyr.mergekpyramidsol p q
slither :: Backend' b =>
RenderPuzzle b IntGrid Loop
slither = (,)
drawSlitherGrid
(drawSlitherGrid . fst <> solstyle . drawEdges . snd)
liarslither :: Backend' b =>
RenderPuzzle b IntGrid (Loop, SGrid Bool)
liarslither = (,)
drawSlitherGrid
(solstyle . drawCrosses . snd . snd
<> drawSlitherGrid . fst
<> solstyle . drawEdges . fst . snd)
tightfitskyscrapers :: Backend' b =>
RenderPuzzle b (OutsideClues (Maybe Int), SGrid (Tightfit ()))
(SGrid (Tightfit Int))
tightfitskyscrapers = (,)
(atCentres drawInt . outsideClues . fst
<> drawTightGrid (const mempty) . snd)
(atCentres drawInt . outsideClues . fst . fst
<> drawTightGrid drawInt . snd)
wordgrid :: Backend' b =>
SGrid (Maybe Char) -> [String] -> Diagram b R2
wordgrid g ws = stackWords ws `besidesR` drawClueGrid g
wordloop :: Backend' b =>
RenderPuzzle b (CharClueGrid, [String]) CharClueGrid
wordloop = (,)
(uncurry wordgrid)
(drawClueGrid . snd)
wordsearch :: Backend' b =>
RenderPuzzle b (CharClueGrid, [String]) (CharClueGrid, [MarkedWord])
wordsearch = (,)
(uncurry wordgrid)
(solstyle . drawMarkedWords . snd . snd
<> drawClueGrid . fst . snd)
curvedata :: Backend' b =>
RenderPuzzle b (SGrid (Clue [Edge])) [Edge]
curvedata = (,)
cd
((solstyle . drawDualEdges . snd) <> cd . fst)
where
cd = atCentres drawCurve . clues <> grid . size
doubleback :: Backend' b =>
RenderPuzzle b AreaGrid Loop
doubleback = (,)
drawAreaGridGray
(solstyle . drawDualEdges . snd <> drawAreaGridGray . fst)
slalom :: Backend' b =>
RenderPuzzle b IntGrid (SGrid SlalomDiag)
slalom = (,)
drawSlalomGrid
(drawSlalomGrid . fst <> solstyle . drawSlalomDiags . snd)
compass :: Backend' b =>
RenderPuzzle b (SGrid (Clue CompassC)) AreaGrid
compass = (,)
drawCompassGrid
(drawCompassClues . fst <> drawAreaGridGray . snd)
boxof2or3 :: Backend' b =>
RenderPuzzle b (SGrid MasyuPearl, [Edge]) ()
boxof2or3 = (,)
(atCentres smallPearl . values . fst
<> phantom' . grid . size . fst
<> drawThinDualEdges . snd)
(error "boxof2or3 solution not implemented")
afternoonskyscrapers :: Backend' b =>
RenderPuzzle b (SGrid Shade) IntGrid
afternoonskyscrapers = (,)
(grid . size <> atCentres drawShade . values)
(drawIntGrid . snd <> atCentres drawShade . values . fst)
meanderingnumbers :: Backend' b =>
RenderPuzzle b AreaGrid IntGrid
meanderingnumbers = (,)
drawAreaGrid
(drawIntGrid . snd <> drawAreaGrid . fst)
tapa :: Backend' b =>
RenderPuzzle b (SGrid TapaClue) ShadedGrid
tapa = (,)
tapaGrid
(tapaGrid . fst <> drawShadedGrid . snd)
where
tapaGrid = atCentres drawTapaClue . values <> grid . size
japanesesums :: Backend' b =>
RenderPuzzle b (OutsideClues [Int]) (SGrid (Either Black Int))
japanesesums = (,)
outsideIntGrid
(outsideIntGrid . fst <> japcells . snd)
where
japcells = atCentres japcell . values
japcell (Left Black) = fillBG gray
japcell (Right x) = drawInt x
coral :: Backend' b =>
RenderPuzzle b (OutsideClues [String]) ShadedGrid
coral = (,)
outsideGrid
(outsideGrid . fst <> drawShadedGrid . snd)
maximallengths :: Backend' b =>
RenderPuzzle b (OutsideClues (Maybe Int)) Loop
maximallengths = (,)
g
(solstyle . drawDualEdges . snd <> g . fst)
where
g = atCentres drawInt . outsideClues
<> grid . outsideSize
primeplace :: Backend' b =>
RenderPuzzle b (SGrid PrimeDiag) (SGrid Int)
primeplace = (,)
g
(atCentres drawInt . values . snd <> g . fst)
where
g = irregularGrid <> atCentres drawPrimeDiag . values
labyrinth :: Backend' b =>
RenderPuzzle b (SGrid (Clue Int), [Edge]) (SGrid (Clue Int))
labyrinth = (,)
(atCentres drawInt . clues . fst <> g)
(atCentres drawInt . clues . snd <> g . fst)
where
g = drawEdges . snd <> plaingrid . size . fst
bahnhof :: Backend' b =>
RenderPuzzle b (SGrid (Maybe BahnhofClue)) [Edge]
bahnhof = (,)
(atCentres drawBahnhofClue . clues <> grid . size)
(atCentres drawBahnhofStation . clues . fst
<> solstyle . drawDualEdges . snd
<> grid . size . fst)
where
drawBahnhofStation = either drawInt (const mempty)
cave ::
(Backend b R2, Renderable (Path R2) b) =>
RenderPuzzle b (SGrid (Clue Int)) ShadedGrid
cave = (,)
g
(drawEdges . edgesGen (/=) not . snd
<> drawShadedGrid . snd <> fr . fst
<> g . fst)
where
g = gridDashing . plaingrid . size <> atCentres drawInt . clues
fr gr = outframe' 8 (size gr) # lc gray