module Diagrams.Puzzles.Lib where
import Diagrams.Prelude
import Graphics.SVGFonts.ReadFont
import Control.Arrow ((***))
import Paths_puzzle_draw (getDataFileName)
import System.IO.Unsafe (unsafePerformIO)
type Backend' b = (Backend b R2, Renderable (Path R2) b)
vline, hline :: Backend' b => Double -> Diagram b R2
vline n = strokeLine . fromVertices . map p2 $ [(0, 0), (0, n)]
hline n = strokeLine . fromVertices . map p2 $ [(0, 0), (n, 0)]
hcatsep :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2) => [a] -> a
hcatsep = hcat' with {_sep = 1}
vcatsep :: (Juxtaposable a, HasOrigin a, Monoid' a, V a ~ R2) => [a] -> a
vcatsep = cat' (r2 (0,1)) with {_sep = 1}
smash :: Backend' b => QDiagram b R2 Any -> QDiagram b R2 Any
smash = withEnvelope (pointDiagram origin :: D R2)
translatep :: (Transformable t, V t ~ R2) => (Int, Int) -> t -> t
translatep = translate . r2i
r2i :: (Int, Int) -> R2
r2i = r2 . (fromIntegral *** fromIntegral)
p2i :: (Int, Int) -> P2
p2i = p2 . (fromIntegral *** fromIntegral)
mirror :: (Transformable t, V t ~ R2) => t -> t
mirror = reflectAbout (p2 (0, 0)) (r2 (1, 1))
interleave :: [a] -> [a] -> [a]
interleave [] _ = []
interleave (x:xs) ys = x : interleave ys xs
spread :: Backend' b => R2 -> [Diagram b R2] -> Diagram b R2
spread v things = cat v . interleave (repeat (strut vgap)) $ things
where ds = map (diameter v) things
gap' = (magnitude v sum ds) / fromIntegral (length things + 1)
vgap = (gap' / magnitude v) *^ v
dmid :: (Enveloped a, V a ~ R2) => a -> Double
dmid a = (dtop + dbot) / 2 dbot
where menv v = magnitude . envelopeV v
dtop = menv unitY a
dbot = menv ((1) *^ unitY) a
besidesL :: (Backend' b, Semigroup m, Monoid m) =>
QDiagram b R2 m -> QDiagram b R2 m -> QDiagram b R2 m
besidesL a b = a ||| strutX 0.5 ||| b'
where b' = b # centerY # translate (dmid a *^ unitY)
besidesR :: (Backend' b, Semigroup m, Monoid m) =>
QDiagram b R2 m -> QDiagram b R2 m -> QDiagram b R2 m
besidesR b a = b' ||| strutX 0.5 ||| a
where b' = b # centerY # translate (dmid a *^ unitY)
fit :: (Transformable t, Enveloped t, V t ~ R2) =>
Double -> t -> t
fit f a = scale (f / m) a
where m = max (magnitude (diameter unitX a))
(magnitude (diameter unitY a))
text' :: Backend' b => String -> Diagram b R2
text' t = stroke (textSVG' $ TextOpts t fnt INSIDE_H KERN False 1 1)
# lwG 0 # fc black # scale 0.8
where
fnt = outlMap . unsafePerformIO . getDataFileName
$ "data/fonts/gen-light.svg"
phantom' :: Backend' b => Diagram b R2 -> Diagram b R2
phantom' = phantom