re-britannize

robx · Jan 3, 2020 · 985227a · 985227a
1 parent 93fd01e
commit 985227a
Show file tree

Hide file tree

Showing 6 changed files with 90 additions and 155 deletions.
diff --git a/src/Draw/Component.hs b/src/Draw/Component.hs
@@ -58,9 +58,7 @@ component c = case c of
     (edgeSize g, placeGrid' . Map.mapKeys midPoint . fmap decoration $ g)
   FullGrid ns cs es ->
     ( nodeSize ns
-    , mconcat
-      . map (snd . component)
-      $ [NodeGrid ns, CellGrid cs, EdgeGrid es]
+    , mconcat . map (snd . component) $ [NodeGrid ns, CellGrid cs, EdgeGrid es]
     )
   Note        ds -> ((0, 0), note $ hcatSep 0.2 $ map decoration $ ds)
   Pyramid     g  -> (shiftSize g, shiftGrid g)
@@ -76,36 +74,36 @@ component c = case c of
 
 decoration :: Backend' b => Decoration -> Drawing b
 decoration d = case d of
-  Blank                  -> mempty
-  Letter       c         -> char c
-  Letters      s         -> text' s
-  InvertedLetters s      -> invert $ text' s
-  DecKropkiDot k         -> kropkiDot k
-  AfternoonSouth         -> afternoonSouth
-  AfternoonWest          -> afternoonWest
-  LightDiagonal diag     -> lc (blend 0.5 gray white) $ primeDiag diag
-  DarkDiagonal  diag     -> lc gray $ primeDiag diag
-  SmallDot               -> dot
-  Dot                    -> scale 0.5 $ smallPearl MBlack
-  Star                   -> star Data.Elements.Star
-  Shade                  -> fillBG gray
-  DarkShade              -> fillBG (blend 0.5 gray black)
-  Black                  -> fillBG black
-  LightShade             -> fillBG (blend 0.5 gray white)
-  SmallPearl p           -> smallPearl p
-  Pearl      p           -> pearl p
-  Edge       dir         -> edgeDecoration dir
-  ThinEdge   dir         -> edgeDecorationThin dir
-  SolEdge    dir         -> edgeDecorationSol dir
-  TriangleRight          -> arrowRight
-  TriangleDown           -> arrowDown
-  LabeledTriangleRight w -> arrowRightL w
-  LabeledTriangleDown  w -> arrowDownL w
-  MiniLoop               -> miniloop
-  ShipSquare             -> shipSquare
-  Ship dir               -> shipEnd dir
-  LabeledArrow dir w     -> labeledArrow dir $ text' w
+  Blank                      -> mempty
+  Letter          c          -> char c
+  Letters         s          -> text' s
+  InvertedLetters s          -> invert $ text' s
+  DecKropkiDot    k          -> kropkiDot k
+  AfternoonSouth             -> afternoonSouth
+  AfternoonWest              -> afternoonWest
+  LightDiagonal diag         -> lc (blend 0.5 gray white) $ primeDiag diag
+  DarkDiagonal  diag         -> lc gray $ primeDiag diag
+  SmallDot                   -> dot
+  Dot                        -> scale 0.5 $ smallPearl MBlack
+  Star                       -> star Data.Elements.Star
+  Shade                      -> fillBG gray
+  DarkShade                  -> fillBG (blend 0.5 gray black)
+  Black                      -> fillBG black
+  LightShade                 -> fillBG (blend 0.5 gray white)
+  SmallPearl p               -> smallPearl p
+  Pearl      p               -> pearl p
+  Edge       dir             -> edgeDecoration dir
+  ThinEdge   dir             -> edgeDecorationThin dir
+  SolEdge    dir             -> edgeDecorationSol dir
+  TriangleRight              -> arrowRight
+  TriangleDown               -> arrowDown
+  LabeledTriangleRight w     -> arrowRightL w
+  LabeledTriangleDown  w     -> arrowDownL w
+  MiniLoop                   -> miniloop
+  ShipSquare                 -> shipSquare
+  Ship dir                   -> shipEnd dir
+  LabeledArrow         dir w -> labeledArrow dir $ text' w
   InvertedLabeledArrow dir w -> invert $ labeledArrow dir $ text' w
-  Tent                   -> draw tentDia
-  Tree                   -> tree Data.Elements.Tree
-  Myopia dirs            -> myopia dirs
+  Tent                       -> draw tentDia
+  Tree                       -> tree Data.Elements.Tree
+  Myopia dirs                -> myopia dirs
diff --git a/src/Draw/Elements.hs b/src/Draw/Elements.hs
@@ -89,8 +89,8 @@ compassClue (CC n e s w) = texts <> (draw $ stroke crossPath # lwG onepix)
   f = 3 / 10
 
 slovakClue :: Backend' b => SlovakClue -> Drawing b
-slovakClue (SlovakClue s c) =
-  centerY' (int s === draw (strutY 0.1) === dots c) <> fillBG gray
+slovakClue (SlovakClue s c) = centerY' (int s === draw (strutY 0.1) === dots c)
+  <> fillBG gray
  where
   dots n = draw $ centerX $ hcat' with { _sep = 0.04 } (replicate n $ d)
   d = circle 0.1 # lwG 0.02 # fc white
@@ -227,8 +227,7 @@ words ws =
 -- | Fit a line drawing into a unit square.
 --   For example, a Curve Data clue.
 curve :: Backend' b => [Edge N] -> Drawing b
-curve =
-  draw . lwG onepix . fit 0.6 . centerXY . mconcat . map (stroke . edge)
+curve = draw . lwG onepix . fit 0.6 . centerXY . mconcat . map (stroke . edge)
 
 -- | Draw a shadow in the style of Afternoon Skyscrapers.
 afternoonSouth :: Backend' b => Drawing b
@@ -248,8 +247,7 @@ afternoonWest = reflectAbout (p2 (0, 0)) (direction $ r2 (1, 1)) afternoonSouth
 --   left to right, top to bottom.
 tapaClue :: Backend' b => TapaClue -> Drawing b
 tapaClue (TapaClue [x]) = int x
-tapaClue (TapaClue xs) =
-  fit' 0.8 . atPoints (p (length xs)) . map int $ xs
+tapaClue (TapaClue xs ) = fit' 0.8 . atPoints (p (length xs)) . map int $ xs
  where
   p n = mconcat . pathVertices $ centerXY (p' n)
   p' 2 = p2 (-1 / 4, 1 / 4) ~~ p2 (1 / 4, -1 / 4)
@@ -457,8 +455,9 @@ myopia = foldMap d'
   d R = a (0, 0) (1, 0)
   d D = a (0, 0) (0, -1)
   d L = a (0, 0) (-1, 0)
-  a p q =
-    arrowBetween' (with & arrowHead .~ tri & headLength .~ global 0.2) (p2 p) (p2 q)
+  a p q = arrowBetween' (with & arrowHead .~ tri & headLength .~ global 0.2)
+                        (p2 p)
+                        (p2 q)
 
 greaterClue :: Backend' b => GreaterClue -> [Drawing b]
 greaterClue []       = mempty

diff --git a/src/Draw/Grid.hs b/src/Draw/Grid.hs
@@ -228,8 +228,7 @@ solstyle :: (HasStyle a, InSpace V2 Double a) => a -> a
 solstyle = lc (blend 0.8 black white) . lwG (3 * onepix)
 
 edges :: (ToPoint k, Backend' b) => [Edge k] -> Drawing b
-edges es =
-  Drawing (\cfg -> edgeStyle cfg . stroke . mconcat . map edge $ es)
+edges es = Drawing (\cfg -> edgeStyle cfg . stroke . mconcat . map edge $ es)
 
 dirPath :: Dir -> Path V2 Double
 dirPath dir = case dir of

diff --git a/src/Draw/PuzzleGrids.hs b/src/Draw/PuzzleGrids.hs
@@ -72,11 +72,9 @@ sudokugrid = edges . sudokubordersg <> grid gDefault
 wordsClues :: Backend' b => Grid C (Maybe [String]) -> Drawing b
 wordsClues = placeGrid . fmap Draw.Elements.words . clues
 
-tightGrid
-  :: Backend' b => (t -> Drawing b) -> Grid C (Tightfit t) -> Drawing b
-tightGrid d g =
-  (placeGrid . fmap (tight d) $ g) <> grid gDefault g <> draw
-    (phantom' (strokePath $ p2i (-1, -1) ~~ p2i (sx + 1, sy + 1)))
+tightGrid :: Backend' b => (t -> Drawing b) -> Grid C (Tightfit t) -> Drawing b
+tightGrid d g = (placeGrid . fmap (tight d) $ g) <> grid gDefault g <> draw
+  (phantom' (strokePath $ p2i (-1, -1) ~~ p2i (sx + 1, sy + 1)))
   where (sx, sy) = size (Map.mapKeys toCoord g)
 
 maxDiam :: Backend' b => V2 Double -> Config -> [Drawing b] -> Double