diff --git a/src/Data/Component.hs b/src/Data/Component.hs index 73c9929..8e40969 100644 --- a/src/Data/Component.hs +++ b/src/Data/Component.hs @@ -89,4 +89,5 @@ data Decoration = | Ship Dir' | ShipSquare | LabeledArrow Dir' String - + | Tent + | Tree diff --git a/src/Draw/Component.hs b/src/Draw/Component.hs index 415a60e..887fae1 100644 --- a/src/Draw/Component.hs +++ b/src/Draw/Component.hs @@ -9,7 +9,10 @@ import Diagrams.Prelude hiding ( dot ) import Data.Component -import Data.Elements +import Data.Elements hiding ( Tent + , Tree + ) +import qualified Data.Elements import Data.Grid import Data.GridShape import Draw.Lib @@ -95,4 +98,5 @@ drawDecoration d = case d of ShipSquare -> shipSquare Ship dir -> shipEnd dir LabeledArrow dir w -> labeledArrow dir $ text' w - + Tent -> draw tent + Tree -> drawTree Data.Elements.Tree diff --git a/src/Draw/Elements.hs b/src/Draw/Elements.hs index f5cef86..5b51935 100644 --- a/src/Draw/Elements.hs +++ b/src/Draw/Elements.hs @@ -308,28 +308,29 @@ drawTent (Tent d) = draw $ tent <> lwG linewidth (stroke conn) L -> (-1, 0) ) - tent = fit 0.7 $ centerXY $ lwG 0 $ mconcat - [ rect 10 (1 / 4) # fc black - , shape [(-2, 0), (0, 4), (2, 0), (-2, 0)] # fc white - , shape [(-4, 0), (0, 8), (4, 0), (-4, 0)] # fc black - , shape - [ (0 , 8) - , (-1 / 2, 8 + 1) - , (-1 , 8 + 1 - 1 / 4) - , (0 , 8 + 1 - 1 / 4 - 2) - , (0 , 8) - ] - # fc black - , shape - [ (0 , 8) - , (1 / 2, 8 + 1) - , (1 , 8 + 1 - 1 / 4) - , (0 , 8 + 1 - 1 / 4 - 2) - , (0 , 8) - ] - # fc black - ] - shape = strokeLocLoop . fromVertices . map p2 +tent :: Backend' b => Diagram b +tent = fit 0.7 $ centerXY $ lwG 0 $ mconcat + [ rect 10 (1 / 4) # fc black + , shape [(-2, 0), (0, 4), (2, 0), (-2, 0)] # fc white + , shape [(-4, 0), (0, 8), (4, 0), (-4, 0)] # fc black + , shape + [ (0 , 8) + , (-1 / 2, 8 + 1) + , (-1 , 8 + 1 - 1 / 4) + , (0 , 8 + 1 - 1 / 4 - 2) + , (0 , 8) + ] + # fc black + , shape + [ (0 , 8) + , (1 / 2, 8 + 1) + , (1 , 8 + 1 - 1 / 4) + , (0 , 8 + 1 - 1 / 4 - 2) + , (0 , 8) + ] + # fc black + ] + where shape = strokeLocLoop . fromVertices . map p2 vertexLoop :: VertexLoop -> Located (Trail' Loop V2 Double) vertexLoop = mapLoc closeLine . fromVertices . map toPoint diff --git a/src/Parse/Component.hs b/src/Parse/Component.hs index b899273..2f5480b 100644 --- a/src/Parse/Component.hs +++ b/src/Parse/Component.hs @@ -5,7 +5,7 @@ module Parse.Component where import Data.Yaml import qualified Data.Map.Strict as Map -import Data.Elements +import qualified Data.Elements as E import Data.Component import Data.Grid import Data.GridShape @@ -133,10 +133,10 @@ parseDecorationWithReplacements repl c = case Map.lookup c repl of parseDecoration :: Char -> Parser Decoration parseDecoration c = return $ case c of '.' -> Blank - 'o' -> DecKropkiDot KWhite - '*' -> DecKropkiDot KBlack - '/' -> DarkDiagonal $ PrimeDiag (True, False) - '\\' -> DarkDiagonal $ PrimeDiag (False, True) + 'o' -> DecKropkiDot E.KWhite + '*' -> DecKropkiDot E.KBlack + '/' -> DarkDiagonal $ E.PrimeDiag (True, False) + '\\' -> DarkDiagonal $ E.PrimeDiag (False, True) '#' -> Shade '-' -> Edge Horiz '|' -> Edge Vert @@ -147,40 +147,43 @@ parseDecoration c = return $ case c of parseExtendedDecoration :: Util.IntString -> Parser Decoration parseExtendedDecoration (Util.IntString s) = case words s of [w1] -> case w1 of - "kropki-white" -> pure $ DecKropkiDot KWhite - "kropki-black" -> pure $ DecKropkiDot KBlack - "small-pearl-white" -> pure $ SmallPearl MWhite - "small-pearl-black" -> pure $ SmallPearl MBlack - "pearl-white" -> pure $ Pearl MWhite - "pearl-black" -> pure $ Pearl MBlack - "blank" -> pure Blank - "afternoon-west" -> pure $ AfternoonWest - "afternoon-south" -> pure $ AfternoonSouth - "light-diagonal-forward" -> pure $ LightDiagonal $ PrimeDiag (True, False) - "light-diagonal-back" -> pure $ LightDiagonal $ PrimeDiag (False, True) - "light-diagonal-both" -> pure $ LightDiagonal $ PrimeDiag (True, True) - "dark-diagonal-forward" -> pure $ DarkDiagonal $ PrimeDiag (True, False) - "dark-diagonal-back" -> pure $ DarkDiagonal $ PrimeDiag (False, True) - "dark-diagonal-both" -> pure $ DarkDiagonal $ PrimeDiag (True, True) - "edge-horiz" -> pure $ Edge Horiz - "edge-vert" -> pure $ Edge Vert - "thin-edge-horiz" -> pure $ ThinEdge Horiz - "thin-edge-vert" -> pure $ ThinEdge Vert - "sol-edge-horiz" -> pure $ SolEdge Horiz - "sol-edge-vert" -> pure $ SolEdge Vert - "dot" -> pure $ Dot - "small-dot" -> pure $ SmallDot - "shade" -> pure $ Shade - "light-shade" -> pure $ LightShade - "triangle-right" -> pure $ TriangleRight - "triangle-down" -> pure $ TriangleDown - "miniloop" -> pure $ MiniLoop - "ship-square" -> pure $ ShipSquare - "ship-end-left" -> pure $ Ship R - "ship-end-right" -> pure $ Ship L - "ship-end-top" -> pure $ Ship D - "ship-end-bottom" -> pure $ Ship U - _ -> pure $ Letters s + "kropki-white" -> pure $ DecKropkiDot E.KWhite + "kropki-black" -> pure $ DecKropkiDot E.KBlack + "small-pearl-white" -> pure $ SmallPearl E.MWhite + "small-pearl-black" -> pure $ SmallPearl E.MBlack + "pearl-white" -> pure $ Pearl E.MWhite + "pearl-black" -> pure $ Pearl E.MBlack + "blank" -> pure Blank + "afternoon-west" -> pure $ AfternoonWest + "afternoon-south" -> pure $ AfternoonSouth + "light-diagonal-forward" -> + pure $ LightDiagonal $ E.PrimeDiag (True, False) + "light-diagonal-back" -> pure $ LightDiagonal $ E.PrimeDiag (False, True) + "light-diagonal-both" -> pure $ LightDiagonal $ E.PrimeDiag (True, True) + "dark-diagonal-forward" -> pure $ DarkDiagonal $ E.PrimeDiag (True, False) + "dark-diagonal-back" -> pure $ DarkDiagonal $ E.PrimeDiag (False, True) + "dark-diagonal-both" -> pure $ DarkDiagonal $ E.PrimeDiag (True, True) + "edge-horiz" -> pure $ Edge Horiz + "edge-vert" -> pure $ Edge Vert + "thin-edge-horiz" -> pure $ ThinEdge Horiz + "thin-edge-vert" -> pure $ ThinEdge Vert + "sol-edge-horiz" -> pure $ SolEdge Horiz + "sol-edge-vert" -> pure $ SolEdge Vert + "dot" -> pure $ Dot + "small-dot" -> pure $ SmallDot + "shade" -> pure $ Shade + "light-shade" -> pure $ LightShade + "triangle-right" -> pure $ TriangleRight + "triangle-down" -> pure $ TriangleDown + "miniloop" -> pure $ MiniLoop + "ship-square" -> pure $ ShipSquare + "ship-end-left" -> pure $ Ship R + "ship-end-right" -> pure $ Ship L + "ship-end-top" -> pure $ Ship D + "ship-end-bottom" -> pure $ Ship U + "tent" -> pure $ Tent + "tree" -> pure $ Tree + _ -> pure $ Letters s [w1, w2] -> case w1 of "triangle-right" -> pure $ LabeledTriangleRight w2 "triangle-down" -> pure $ LabeledTriangleDown w2 diff --git a/tests/examples/snake-forest-example.png b/tests/examples/snake-forest-example.png new file mode 100644 index 0000000..df0ca69 Binary files /dev/null and b/tests/examples/snake-forest-example.png differ diff --git a/tests/examples/snake-forest-example.pzg b/tests/examples/snake-forest-example.pzg new file mode 100644 index 0000000..6c537d8 --- /dev/null +++ b/tests/examples/snake-forest-example.pzg @@ -0,0 +1,37 @@ + +- type: cells + grid: | + B... + O... + substitute: + O: pearl-black + B: tree +- type: cells + tag: solution + grid: | + .Z.# + #### + substitute: + Z: tent +- type: cells + tag: solution + grid: | + ...O + O... + substitute: + O: pearl-black +- type: edges + tag: solution + grid: | + o o o o o + - + o o o o o + + o o o o o + substitute: + o: . +- type: grid + style: default + grid: | + .... + ....