module Diagrams.Puzzles.Elements where
import Diagrams.Prelude
import Diagrams.TwoD.Offset
import Data.Puzzles.Elements
import Data.Puzzles.GridShape
import Diagrams.Puzzles.Lib
import Diagrams.Puzzles.Widths
import Diagrams.Puzzles.Grid
pearl :: Backend' b =>
MasyuPearl -> Diagram b R2
pearl m = circle 0.35 # lwG 0.05 # fc (c m)
where
c MWhite = white
c MBlack = black
smallPearl :: Backend' b =>
MasyuPearl -> Diagram b R2
smallPearl = scale 0.4 . pearl
ur :: Path R2
ur = fromVertices [p2 (1/2,1/2), p2 (1/2,1/2)]
dr :: Path R2
dr = fromVertices [p2 (1/2,1/2), p2 (1/2,1/2)]
cross :: Path R2
cross = ur <> dr
drawCross :: Backend' b => Diagram b R2
drawCross = stroke cross # scale 0.8 # lwG edgewidth
drawCompassClue :: Backend' b =>
CompassC -> Diagram b R2
drawCompassClue (CC n e s w) = texts <> stroke cross # lwG onepix
where tx Nothing _ = mempty
tx (Just x) v = text' (show x) # scale 0.5 # translate (r2 v)
texts = mconcat . zipWith tx [n, e, s, w] $
[(0,f), (f,0), (0,f), (f,0)]
f = 3/10
thermo :: Backend' b => [P2] -> QDiagram b R2 Any
thermo vs@(v:_) = (bulb `atop` line) # col # translate (r2 (0.5, 0.5))
where bulb = circle 0.4 # moveTo v
line = strokeLocLine (fromVertices vs)
# lwG 0.55 # lineCap LineCapSquare
col = lc gr . fc gr
gr = blend 0.6 white black
thermo [] = error "invalid empty thermometer"
drawThermos :: Backend' b => [Thermometer] -> QDiagram b R2 Any
drawThermos = mconcat . map (thermo . map p2i)
drawTight :: Backend' b =>
(a -> Diagram b R2) -> Tightfit a -> Diagram b R2
drawTight d (Single x) = d x
drawTight d (UR x y) = stroke ur # lwG onepix
<> d x # scale s # translate (r2 (t,t))
<> d y # scale s # translate (r2 (t,t))
where t = 1/5
s = 2/3
drawTight d (DR x y) = stroke dr # lwG onepix
<> d x # scale s # translate (r2 (t,t))
<> d y # scale s # translate (r2 (t,t))
where t = 1/5
s = 2/3
stackWords :: Backend' b => [String] -> QDiagram b R2 Any
stackWords = vcat' with {_sep = 0.1} . scale 0.8 . map (alignL . text')
drawMarkedWord :: Backend' b => MarkedWord -> QDiagram b R2 Any
drawMarkedWord (MW s e) = lwG onepix . stroke $ expandTrail' with {_expandCap = LineCapRound} 0.4 t
where t = fromVertices [p2i s, p2i e] # translate (r2 (1/2,1/2))
drawMarkedWords :: Backend' b => [MarkedWord] -> QDiagram b R2 Any
drawMarkedWords = mconcat . map drawMarkedWord
drawSlalomClue :: (Show a, Backend' b) =>
a -> Diagram b R2
drawSlalomClue x = text' (show x) # scale 0.75
<> circle 0.4 # fc white # lwG onepix
drawText :: Backend' b => String -> QDiagram b R2 Any
drawText = text'
drawInt :: Backend' b =>
Int -> Diagram b R2
drawInt s = drawText (show s)
drawChar :: Backend' b =>
Char -> Diagram b R2
drawChar c = drawText [c]
drawWords :: Backend' b =>
[String] -> Diagram b R2
drawWords ws = spread (1.0 *^ unitY)
(map (centerXY . scale 0.4 . drawText) ws)
# centerY
drawCurve :: Backend' b => [Edge] -> Diagram b R2
drawCurve = lwG onepix . fit 0.6 . centerXY . mconcat . map (stroke . edge)
drawShade :: Backend' b => Shade -> Diagram b R2
drawShade (Shade s w) = (if s then south else mempty) <>
(if w then west else mempty)
where
shape = translate (r2 (1/2, 1/2)) . fromVertices . map p2 $
[ (0, 0), (1/4, 1/4), (1, 1/4), (1, 0), (0, 0) ]
south = strokeLocLoop shape # lwG 0 # fc gray
west = reflectAbout (p2 (0, 0)) (r2 (1, 1)) south
drawTapaClue :: Backend' b =>
TapaClue -> Diagram b R2
drawTapaClue (TapaClue [x]) = drawInt x
drawTapaClue (TapaClue xs) = fit 0.8
. decoratePath (p (length xs))
. map drawInt
$ xs
where
p n = centerXY (p' n)
p' 2 = p2 (1/4, 1/4) ~~ p2 (1/4, 1/4)
p' 3 = reflectX . rotateBy (1/6) $ triangle 0.8
p' 4 = reflectX . rotateBy (3/8) $ square 0.7
p' 1 = error "singleton clues handled separately"
p' _ = error "invalid tapa clue"
drawPrimeDiag :: Backend' b =>
PrimeDiag -> Diagram b R2
drawPrimeDiag (PrimeDiag d) = stroke p # lwG (3 * onepix) # lc (blend 0.5 gray white)
where
p = case d of (False, False) -> mempty
(True, False) -> ur
(False, True) -> dr
(True, True) -> ur <> dr
drawCrossing :: Backend' b => Crossing -> Diagram b R2
drawCrossing = const $ drawChar '+'
drawBahnhofClue :: Backend' b => BahnhofClue -> Diagram b R2
drawBahnhofClue = either drawInt drawCrossing