module Group where
import Control.Monad (mapM_)
import Data.List (groupBy, sort)
import System.IO (hPutStrLn, stderr)
import Text.Blaze.Svg11 (Svg, g)
import Text.Printf (printf)
import ApproxEq
import Layer (Layer, mkLayer)
import Point (Point)
import qualified Shape as S
import Style
newtype Group shape = Group [shape]
instance (Show a) => Show (Group a) where
show (Group as) = show as
instance (Show a, S.SvgShape a, S.Transformable a, S.Mergable a) => Semigroup (Group a) where
(<>) (Group as) (Group bs) = Group (as ++ bs)
instance (Show a, S.SvgShape a, S.Transformable a, S.Mergable a) => Monoid (Group a) where
mempty = Group []
instance Functor Group where
fmap fn (Group as) = Group (fmap fn as)
instance Applicative Group where
pure a = Group [a]
(<*>) (Group fn) (Group as) = Group ([f a | (f, a) <- (zip fn as)])
instance (S.Transformable a) => S.Transformable (Group a) where
translate = fmap . S.translate
rotate = (fmap .) . S.rotate
mirror = (fmap .) . S.mirror
offset = (fmap .) . S.offset
toLayer :: (Show a, S.SvgShape a, S.Transformable a) => String -> Group a -> Layer
toLayer name (Group shapes) = mkLayer name shapes
toList :: (Show a, S.SvgShape a, S.Transformable a) => Group a -> [a]
toList (Group shapes) = shapes
size :: Group a -> Int
size (Group as) = length as
translateOverPoints :: (S.Transformable s) => [Point] -> s -> Group s
translateOverPoints ps s = Group $ fmap (\p -> S.translate p s) ps
translateGroupOverPoints :: (Show a, S.SvgShape a, S.Transformable a, S.Mergable a) => [Point] -> Group a -> Group a
translateGroupOverPoints ps (Group shapes) = mconcat $ map (\shape -> translateOverPoints ps shape) shapes
deduplicate :: (Ord t, ApproxEq t) => Group t -> Group t
deduplicate (Group grp) = Group (nub grp)
where nub = map head . groupBy (=~) . sort
transformAndAppend :: (Show a, S.SvgShape a, S.Transformable a, S.Mergable a) => (a -> a) -> Group a -> Group a
transformAndAppend fn (Group grp) = Group (grp <> newShapes)
where newShapes = map fn grp
optimizeGroup :: (S.Mergable a) => Group a -> Float -> Group a
optimizeGroup (Group grp) epsilon = Group (S.optimize grp epsilon)
optimizeGroupAndLog :: (S.Mergable a) => Group a -> Float -> IO (Group a)
optimizeGroupAndLog group epsilon = hPutStrLn stderr mssg >> return optGrp
where
_start = size group
optGrp = optimizeGroup group epsilon
_end = size optGrp
mssg = printf "Optimized group: %d shapes to %d" _start _end
toSvgN :: (S.SvgShape s) => Group s -> Svg
toSvgN (Group grp) = g $ mapM_ S.toSvg grp
toSvgWithStyle :: (S.SvgShape s) => Group s -> StyleAttrs -> Svg
toSvgWithStyle grp s = applyStyle s $ toSvgN grp