{-# LANGUAGE ExplicitForAll        #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Path.IteratedSubset
-- Copyright   :  (c) 2012 Brent Yorgey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@cis.upenn.edu
--
-- Generate fractal trails by the \"iterated subset\" construction,
-- iteratively replacing each segment with a given pattern.
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Path.IteratedSubset
       (
         -- * Iterated subset algorithm
         -- ** Simplified version
         refineSegment, iterTrail

         -- ** General version
         -- $ventrella
       , GeneratorSegment(..), mkGS, mkGS3, Generator
       , refineGeneratorSegment, iterGenerator

         -- ** Utilities
       , averageLine
       , bevelLine

       , showGenerator

         -- * Examples

         -- ** Example seed trails
         -- $seeds

       , koch
       , levy
       , zag
       , sqUp
       , sqUpDown

         -- ** Example generators
         -- $gens

       , dragonGen
       , polyaGen
       , terDragonGen
       , invTerDragonGen
       , ventrella56b
       , yinDragonGen
       , ventrella67
       , innerFlipQuartetGen
       , antiGosperGen
       , mandelbrotSnowflakeGen

         -- ** Other stuff
         -- $other

       , snowflake

       , IterTrailConfig(..), randITC, drawITC, drawITCScaled
       , randIterGrid
       ) where

-- Diagrams.Core.Points needed for V (Point a) instance on GHC < 7.6
import           Diagrams.Core.Points       ()
import           Diagrams.Prelude

import           Control.Monad              (replicateM)
import           Control.Monad.Random       (evalRandIO, getRandom, getRandomR)
import           Control.Monad.Random.Class (MonadRandom)
import           Data.Bits                  (xor)
import           Data.Maybe                 (mapMaybe)
import           Data.Typeable
import           System.Random              (Random)

import qualified Diagrams.TwoD.Layout.Grid  as LG

------------------------------------------------------------
-- Iterated subset algorithm (simplified version)
------------------------------------------------------------

-- | Given a \"seed pattern\", produce a list of successive
--   refinements: the zeroth trail in the output list is a horizontal
--   unit segment, and the nth trail is formed by replacing each
--   segment of the seed pattern with the (n-1)st trail.
--   (Equivalently, the nth trail consists of the (n-1)st trail with
--   every segment replaced by the seed pattern.)
--
--   See 'iterGenerator' for a more sophisticated variant which can
--   associate one of four orientations with each segment of the seed
--   pattern.
--
--   > import Diagrams.TwoD.Path.IteratedSubset
--   > iterTrailEx = vsep 0.3 . map strokeLine . take 5
--   >             $ iterTrail koch
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_iterTrailEx.svg#diagram=iterTrailEx&width=200>>
iterTrail :: RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail :: forall n. RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail Trail' Line V2 n
seed' = (Trail' Line V2 n -> Trail' Line V2 n)
-> Trail' Line V2 n -> [Trail' Line V2 n]
forall a. (a -> a) -> a -> [a]
iterate (\Trail' Line V2 n
tr -> [Trail' Line V2 n] -> Trail' Line V2 n
forall a. Monoid a => [a] -> a
mconcat ([Trail' Line V2 n] -> Trail' Line V2 n)
-> ([V2 n] -> [Trail' Line V2 n]) -> [V2 n] -> Trail' Line V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (V2 n -> Maybe (Trail' Line V2 n)) -> [V2 n] -> [Trail' Line V2 n]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
forall n.
RealFloat n =>
Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
refineSegment Trail' Line V2 n
tr) ([V2 n] -> Trail' Line V2 n) -> [V2 n] -> Trail' Line V2 n
forall a b. (a -> b) -> a -> b
$ [V2 n]
offs)
                         ([Vn (Trail' Line V2 n)] -> Trail' Line V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn (Trail' Line V2 n)
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX])
  where offs :: [V2 n]
offs = (Segment Closed V2 n -> V2 n) -> [Segment Closed V2 n] -> [V2 n]
forall a b. (a -> b) -> [a] -> [b]
map Segment Closed V2 n -> V2 n
forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset ([Segment Closed V2 n] -> [V2 n])
-> (Trail' Line V2 n -> [Segment Closed V2 n])
-> Trail' Line V2 n
-> [V2 n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line V2 n -> [Segment Closed V2 n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments (Trail' Line V2 n -> [V2 n]) -> Trail' Line V2 n -> [V2 n]
forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n
seed'

-- | Use a trail to \"refine\" a linear segment (represented by a
--   vector), returning a scaled and/or rotated copy of the trail with
--   the same endpoint as the segment.
refineSegment :: RealFloat n =>
                 Trail' Line V2 n -> V2 n ->
                 Maybe (Trail' Line V2 n)
refineSegment :: forall n.
RealFloat n =>
Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
refineSegment Trail' Line V2 n
t V2 n
sOff
  | V2 n
tOff V2 n -> V2 n -> Bool
forall a. Eq a => a -> a -> Bool
== V2 n
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Bool -> Bool -> Bool
|| V2 n
sOff V2 n -> V2 n -> Bool
forall a. Eq a => a -> a -> Bool
== V2 n
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero = Maybe (Trail' Line V2 n)
forall a. Maybe a
Nothing
  | Bool
otherwise                    = Trail' Line V2 n -> Maybe (Trail' Line V2 n)
forall a. a -> Maybe a
Just (Trail' Line V2 n -> Maybe (Trail' Line V2 n))
-> Trail' Line V2 n -> Maybe (Trail' Line V2 n)
forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n
t Trail' Line V2 n
-> (Trail' Line V2 n -> Trail' Line V2 n) -> Trail' Line V2 n
forall a b. a -> (a -> b) -> b
# n -> Trail' Line V2 n -> Trail' Line V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
k Trail' Line V2 n
-> (Trail' Line V2 n -> Trail' Line V2 n) -> Trail' Line V2 n
forall a b. a -> (a -> b) -> b
# Angle n -> Trail' Line V2 n -> Trail' Line V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
r
  where
    tOff :: V2 n
tOff = Trail' Line V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> v n
lineOffset Trail' Line V2 n
t
    k :: n
k    = V2 n -> n
forall a. Floating a => V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V2 n
sOff n -> n -> n
forall a. Fractional a => a -> a -> a
/ V2 n -> n
forall a. Floating a => V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V2 n
tOff
    r :: Angle n
r    = (V2 n
sOffV2 n -> Getting (Angle n) (V2 n) (Angle n) -> Angle n
forall s a. s -> Getting a s a -> a
^.Getting (Angle n) (V2 n) (Angle n)
forall n. RealFloat n => Lens' (V2 n) (Angle n)
Lens' (V2 n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta) Angle n -> Angle n -> Angle n
forall a. Num a => Angle a -> Angle a -> Angle a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (V2 n
tOffV2 n -> Getting (Angle n) (V2 n) (Angle n) -> Angle n
forall s a. s -> Getting a s a -> a
^.Getting (Angle n) (V2 n) (Angle n)
forall n. RealFloat n => Lens' (V2 n) (Angle n)
Lens' (V2 n) (Angle n)
forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta)

------------------------------------------------------------
-- Generators
------------------------------------------------------------

-- $ventrella
-- Much of the approach here is taken from Jeffrey Ventrella,
-- /Brain-filling Curves/. EyeBrain Books, 2nd edition, 2012. ISBN
-- 9780983054627. <http://www.fractalcurves.com/>,
-- <http://www.brainfillingcurves.com/>
--
-- Each generator consists of a sequence of linear segments with
-- endpoints on a square or triangular grid.  Each segment can also
-- have one of four orientations which determines how it is replaced
-- by a copy of the entire fractal path.  Generators are classified by
-- the distance between their start and end points; generators for
-- which the sum of the squared lengths of their segments is equal to
-- the square of this overall distance have fractal dimension 2 and
-- thus are candidates to be space-filling curves.

-- | A /generator segment/ is a vector along with two bits' worth of
--   orientation information: whether there is a reflection swapping
--   its start and end, and whether there is a reflection across its
--   axis.  When a generator segment is replaced by a complex path,
--   the endpoints of the path will match the endpoints of the
--   segment, but the path may first have some reflections applied to
--   it according to the orientation of the segment.
data GeneratorSegment n = GS (V2 n) Bool Bool

-- | A generator is a sequence of consecutive generator segments.
type Generator n = [GeneratorSegment n]

generatorSegmentOffset :: GeneratorSegment n -> V2 n
generatorSegmentOffset :: forall n. GeneratorSegment n -> V2 n
generatorSegmentOffset (GS V2 n
v Bool
_ Bool
_) = V2 n
v

generatorToLine :: (Floating n, Ord n) => Generator n -> Trail' Line V2 n
generatorToLine :: forall n. (Floating n, Ord n) => Generator n -> Trail' Line V2 n
generatorToLine = [Vn (Trail' Line V2 n)] -> Trail' Line V2 n
[V2 n] -> Trail' Line V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([V2 n] -> Trail' Line V2 n)
-> (Generator n -> [V2 n]) -> Generator n -> Trail' Line V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneratorSegment n -> V2 n) -> Generator n -> [V2 n]
forall a b. (a -> b) -> [a] -> [b]
map GeneratorSegment n -> V2 n
forall n. GeneratorSegment n -> V2 n
generatorSegmentOffset

-- | Create a graphical representation of a generator, using half
--   arrowheads to show the orientation of each segment.
showGenerator
  :: (Renderable (Path V2 n) b, TypeableFloat n)
  => Generator n -> QDiagram b V2 n Any
showGenerator :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Generator n -> QDiagram b V2 n Any
showGenerator Generator n
g = [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall a. Monoid a => [a] -> a
mconcat ([QDiagram b V2 n Any] -> QDiagram b V2 n Any)
-> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ (Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any)
-> [Located (Trail V2 n)] -> Generator n -> [QDiagram b V2 n Any]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any
forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any
showGenSeg (Located (Trail V2 n) -> [Located (Trail V2 n)]
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Located (Trail v n) -> [t]
explodeTrail (Trail' Line V2 n -> Trail V2 n
forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail (Generator n -> Trail' Line V2 n
forall n. (Floating n, Ord n) => Generator n -> Trail' Line V2 n
generatorToLine Generator n
g) Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail V2 n)) (N (Trail V2 n))
Point V2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin)) Generator n
g
  where
    showGenSeg
      :: (Renderable (Path V2 n) b, TypeableFloat n)
      => Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any
    showGenSeg :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any
showGenSeg Located (Trail V2 n)
locTr (GS V2 n
_ Bool
flip1 Bool
_) =
      let locTr' :: Located (Trail V2 n)
locTr' = if Bool
flip1 then Located (Trail V2 n) -> Located (Trail V2 n)
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> Located (Trail v n)
reverseLocTrail Located (Trail V2 n)
locTr else Located (Trail V2 n)
locTr
      in  ArrowOpts n -> Point V2 n -> V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
ArrowOpts n -> Point V2 n -> V2 n -> QDiagram b V2 n Any
arrowAt' (ArrowOpts n
forall d. Default d => d
with ArrowOpts n -> (ArrowOpts n -> ArrowOpts n) -> ArrowOpts n
forall a b. a -> (a -> b) -> b
& (ArrowHT n -> Identity (ArrowHT n))
-> ArrowOpts n -> Identity (ArrowOpts n)
forall n (f :: * -> *).
Functor f =>
(ArrowHT n -> f (ArrowHT n)) -> ArrowOpts n -> f (ArrowOpts n)
arrowHead ((ArrowHT n -> Identity (ArrowHT n))
 -> ArrowOpts n -> Identity (ArrowOpts n))
-> ArrowHT n -> ArrowOpts n -> ArrowOpts n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ArrowHT n
forall n. RealFloat n => ArrowHT n
halfDart) (Located (Trail V2 n) -> Point (V (Trail V2 n)) (N (Trail V2 n))
forall a. Located a -> Point (V a) (N a)
loc Located (Trail V2 n)
locTr') (Trail V2 n -> V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> v n
trailOffset (Located (Trail V2 n) -> Trail V2 n
forall a. Located a -> a
unLoc Located (Trail V2 n)
locTr'))


-- | Make a generator segment by specifying an x component, a y
--   component, a \"horizontal\" orientation (1 means normal, -1 means
--   reversing the start and end of the segment) and a \"vertical\"
--   orientation (1 means normal, -1 means reflecting across the axis
--   of the segment).  This corresponds to the notation used by
--   Ventrella in /Brainfilling Curves/.
mkGS :: (n, n, Int, Int) -> GeneratorSegment n
mkGS :: forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS (n
x, n
y, Int
flip1, Int
flip2)
  = V2 n -> Int -> Int -> GeneratorSegment n
forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (n
x,n
y)) Int
flip1 Int
flip2

-- | Make a generator segment on a triangular grid, by specifying a
--   segment on a square grid and then applying a shear and a scale to
--   transform the square grid into a triangular grid, as in the
--   diagram below:
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_gridTransform.svg#diagram=gridTransform&width=400>>
mkGS3 :: Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3 :: forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3 (n
x, n
y, Int
flip1, Int
flip2)
  = V2 n -> Int -> Int -> GeneratorSegment n
forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv ((n, n) -> V2 n
forall n. (n, n) -> V2 n
r2 (n
x,n
y) V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall n t. (InSpace V2 n t, Transformable t) => n -> t -> t
shearX n
0.5 V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY (n -> n
forall a. Floating a => a -> a
sqrt n
3 n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
2)) Int
flip1 Int
flip2

-- > sqGrid =
-- >   mconcat
-- >   [ vec (-1) 1
-- >   , vec 0 1
-- >   , vec 1 0
-- >   , vec 1 (-1)
-- >   , vec 0 (-1)
-- >   , vec (-1) 0
-- >   , replicate 4 (hcat $ replicate 4 (square 1)) # vcat # centerXY # lw thin # lc gray
-- >   ]
-- >   where
-- >     vec x y = arrowAt origin (x ^& y)
-- >
-- > gridTransform = hcat' (with & catMethod .~ Distrib & sep .~ 3.5)
-- >   [ sqGrid
-- >   , arrow 2 # lc blue # centerX
-- >   , sqGrid # shearX 0.5 # scaleY (sqrt 3 / 2)
-- >   ]

-- | General interface used by both mkGS3 and mkGS.
mkGSv :: V2 n -> Int -> Int -> GeneratorSegment n
mkGSv :: forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv V2 n
v Int
flip1 Int
flip2 = V2 n -> Bool -> Bool -> GeneratorSegment n
forall n. V2 n -> Bool -> Bool -> GeneratorSegment n
GS V2 n
v (Int
flip1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (Int
flip2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0)

-- | Use a trail to \"refine\" a generator segment, returning a scaled
--   and/or rotated copy of the trail with the same endpoints as the
--   segment, and with appropriate reflections applied depending on
--   the orientation of the segment.
refineGeneratorSegment :: RealFloat n =>
                          Trail' Line V2 n -> GeneratorSegment n ->
                          Maybe (Trail' Line V2 n)
refineGeneratorSegment :: forall n.
RealFloat n =>
Trail' Line V2 n -> GeneratorSegment n -> Maybe (Trail' Line V2 n)
refineGeneratorSegment Trail' Line V2 n
t (GS V2 n
sOff Bool
flipX Bool
flipY)
  = Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
forall n.
RealFloat n =>
Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
refineSegment (Trail' Line V2 n
t Trail' Line V2 n
-> (Trail' Line V2 n -> Trail' Line V2 n) -> Trail' Line V2 n
forall a b. a -> (a -> b) -> b
# Bool -> Bool -> Trail' Line V2 n -> Trail' Line V2 n
forall n.
(Ord n, Floating n) =>
Bool -> Bool -> Trail' Line V2 n -> Trail' Line V2 n
doFlips Bool
flipX Bool
flipY) V2 n
sOff

doFlips :: (Ord n, Floating n) => Bool -> Bool -> Trail' Line V2 n -> Trail' Line V2 n
doFlips :: forall n.
(Ord n, Floating n) =>
Bool -> Bool -> Trail' Line V2 n -> Trail' Line V2 n
doFlips Bool
flipX Bool
flipY
  = (if Bool
flipX Bool -> Bool -> Bool
forall a. Bits a => a -> a -> a
`xor` Bool
flipY then Trail' Line V2 n -> Trail' Line V2 n
forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY else Trail' Line V2 n -> Trail' Line V2 n
forall a. a -> a
id)
  (Trail' Line V2 n -> Trail' Line V2 n)
-> (Trail' Line V2 n -> Trail' Line V2 n)
-> Trail' Line V2 n
-> Trail' Line V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
flipX then Trail' Line V2 n -> Trail' Line V2 n
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Line v n
reverseLine else Trail' Line V2 n -> Trail' Line V2 n
forall a. a -> a
id)

{-
doFlips flipX flipY
  = (if flipY then reflectY else id) . (if flipX then (reflectY . reverseLine) else id)

   flipX / flipY   T         F
        T     reverseLine    reflectY . reverseLine
        F      reflectY      id

   flipX `xor` flipY -> reflectY
   flipX -> reverseLine
-}

-- | Given a generator, produce a list of successive refinements: the
--   zeroth trail in the output list is a horizontal unit segment, and
--   the nth trail is formed by refining each segment of the generator
--   with the (n-1)st trail.
--
--   > import Diagrams.TwoD.Path.IteratedSubset
--   > iterGenEx = hsep 0.3 . map strokeLine . take 7
--   >           $ iterGenerator dragonGen
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_iterGenEx.svg#diagram=iterGenEx&width=400>>
iterGenerator :: RealFloat n => Generator n -> [Trail' Line V2 n]
iterGenerator :: forall n. RealFloat n => Generator n -> [Trail' Line V2 n]
iterGenerator Generator n
g = (Trail' Line V2 n -> Trail' Line V2 n)
-> Trail' Line V2 n -> [Trail' Line V2 n]
forall a. (a -> a) -> a -> [a]
iterate (\Trail' Line V2 n
tr -> [Trail' Line V2 n] -> Trail' Line V2 n
forall a. Monoid a => [a] -> a
mconcat ([Trail' Line V2 n] -> Trail' Line V2 n)
-> (Generator n -> [Trail' Line V2 n])
-> Generator n
-> Trail' Line V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeneratorSegment n -> Maybe (Trail' Line V2 n))
-> Generator n -> [Trail' Line V2 n]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Trail' Line V2 n -> GeneratorSegment n -> Maybe (Trail' Line V2 n)
forall n.
RealFloat n =>
Trail' Line V2 n -> GeneratorSegment n -> Maybe (Trail' Line V2 n)
refineGeneratorSegment Trail' Line V2 n
tr) (Generator n -> Trail' Line V2 n)
-> Generator n -> Trail' Line V2 n
forall a b. (a -> b) -> a -> b
$ Generator n
g)
                          ([Vn (Trail' Line V2 n)] -> Trail' Line V2 n
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn (Trail' Line V2 n)
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX])

------------------------------------------------------------
-- Examples
------------------------------------------------------------

--------------------------------------------------
-- Example seed trails

-- $seeds

-- These are just a few sample seed trails which give interesting
-- results, but by no means the only ones!  Use them directly, or use
-- them as inspiration for creating your own seed trails.
--
-- All these seed trails can be seen as generators with homogeneous
-- orientation.  For more complex/interesting generators, see the
-- section of generators below.

-- > import Diagrams.TwoD.Path.IteratedSubset
-- > showTrail n t = hcat' (with & sep .~ 0.2) [ iters !! 1, iters !! n ]
-- >             # frame 0.5
-- >   where iters = map strokeLine $ iterTrail t

-- | Seed for the Koch curve (side of the famous Koch 'snowflake').
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_kochD.svg#diagram=kochD&width=400>>
koch :: (TrailLike t, V t ~ V2, N t ~ n) => t
koch :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
koch = [Vn t] -> t
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (n
1n -> n -> n
forall a. Fractional a => a -> a -> a
/n
6), V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (-n
1n -> n -> n
forall a. Fractional a => a -> a -> a
/n
6), Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > kochD = showTrail 4 koch

-- | Seed for the Lévy dragon curve.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_levyD.svg#diagram=levyD&width=400>>
levy :: (TrailLike t, V t ~ V2, N t ~ n) => t
levy :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
levy = [Vn t] -> t
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn t
V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > levyD = showTrail 9 levy

-- | Strange zig-zag seed that produces a dense fractal path with lots
--   of triangles.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_zagD.svg#diagram=zagD&width=400>>
zag :: (TrailLike t, V t ~ V2, N t ~ n) => t
zag :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
zag = [Vn t] -> t
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, (-n
0.5) PrevDim (V2 n) -> FinalCoord (V2 n) -> V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& n
FinalCoord (V2 n)
1, Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > zagD = showTrail 5 zag

-- | A \"square impulse\" seed which produces a quadratic von Koch
--   curve.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_sqUpD.svg#diagram=sqUpD&width=400>>
sqUp :: (TrailLike t, V t ~ V2, N t ~ n) => t
sqUp :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
sqUp = [Vn t] -> t
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, Vn t
V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, Vn t
V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y, Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > sqUpD = showTrail 3 sqUp

-- | A \"double square impulse\" seed which produces fantastic
--   rectilinear spiral patterns.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_sqUpDownD.svg#diagram=sqUpDownD&width=400>>
sqUpDown :: (TrailLike t, V t ~ V2, N t ~ n) => t
sqUpDown :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
sqUpDown = [Vn t] -> t
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, Vn t
V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, n
2 n -> V2 n -> V2 n
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y, Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, Vn t
V2 n
forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, Vn t
V2 n
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > sqUpDownD = showTrail 3 sqUpDown

--------------------------------------------------
-- Example generators
--------------------------------------------------

-- $gens
-- Many of these generators are taken from Jeffrey Ventrella,
-- /Brain-filling Curves/, which has a large number of other examples
-- as well (see <http://www.brainfillingcurves.com/>).

-- > import Diagrams.TwoD.Path.IteratedSubset
-- >
-- > illustrateGen k g
-- >     = hcat' (with & sep .~ 0.2) [ showGenerator g, iters !! 2, iters !! k ]
-- >     # frame 0.5
-- >   where iters = map strokeLine $ iterGenerator g

-- | Generator for the classic Harter-Heighway Dragon (Ventrella
--   p. 52, sqrt 2 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_dragonD.svg#diagram=dragonD&width=400>>
dragonGen :: Generator Double
dragonGen :: Generator Double
dragonGen
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS
    [ (Double
1, Double
0,  Int
1,  Int
1)
    , (Double
0, Double
1, -Int
1, -Int
1)
    ]

-- > dragonD = illustrateGen 7 dragonGen

-- | Generator for the Pólya sweep (Ventrella p. 52, sqrt 2 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_polyaD.svg#diagram=polyaD&width=400>>
polyaGen :: Generator Double
polyaGen :: Generator Double
polyaGen
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS
    [ (Double
1, Double
0,  Int
1, -Int
1)
    , (Double
0, Double
1, -Int
1,  Int
1)
    ]

-- > polyaD = illustrateGen 7 polyaGen

-- | Generator for the Ter-Dragon (Ventrella p. 55, sqrt 3 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_terDragonD.svg#diagram=terDragonD&width=400>>
terDragonGen :: Generator Double
terDragonGen :: Generator Double
terDragonGen
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (Double
0,  Double
1, Int
1, Int
1)
    , (Double
1, -Double
1, Int
1, Int
1)
    , (Double
0,  Double
1, Int
1, Int
1)
    ]

-- > terDragonD = illustrateGen 5 terDragonGen

-- | Inverted Ter-Dragon (Ventrella p. 56, sqrt 3 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_invTerDragonD.svg#diagram=invTerDragonD&width=400>>
invTerDragonGen :: Generator Double
invTerDragonGen :: Generator Double
invTerDragonGen
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (Double
0,  Double
1, -Int
1, Int
1)
    , (Double
1, -Double
1, -Int
1, Int
1)
    , (Double
0,  Double
1, -Int
1, Int
1)
    ]

-- > invTerDragonD = illustrateGen 5 invTerDragonGen

-- | Ventrella p. 56b, sqrt 3 family.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_ventrella56bD.svg#diagram=ventrella56bD&width=400>>
ventrella56b :: Generator Double
ventrella56b :: Generator Double
ventrella56b
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (Double
0,  Double
1, -Int
1, Int
1)
    , (Double
1, -Double
1,  Int
1, Int
1)
    , (Double
0,  Double
1, -Int
1, Int
1)
    ]

-- > ventrella56bD = illustrateGen 5 ventrella56b

-- | Yin Dragon (Ventrella p. 59, sqrt 3 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_yinDragonD.svg#diagram=yinDragonD&width=400>>
yinDragonGen :: Generator Double
yinDragonGen :: Generator Double
yinDragonGen
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (Double
0,  Double
1,  Int
1,  Int
1)
    , (Double
0,  Double
1, -Int
1, -Int
1)
    , (Double
1, -Double
1,  Int
1,  Int
1)
    ]

-- > yinDragonD = illustrateGen 6 yinDragonGen

-- | Ventrella p. 67, sqrt 4 family.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_ventrella67D.svg#diagram=ventrella67D&width=400>>
ventrella67 :: Generator Double
ventrella67 :: Generator Double
ventrella67
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS
    [ (Double
1,  Double
1, -Int
1, -Int
1)
    , (Double
1,  Double
0,  Int
1,  Int
1)
    , (Double
0, -Double
1,  Int
1,  Int
1)
    ]

-- > ventrella67D = illustrateGen 6 ventrella67

-- | "Inner-flip Quartet" (Ventrella p. 85, sqrt 5 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_innerFlipQuartetD.svg#diagram=innerFlipQuartetD&width=600>>
innerFlipQuartetGen :: Generator Double
innerFlipQuartetGen :: Generator Double
innerFlipQuartetGen
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS
    [ (Double
0,  Double
1,  Int
1, -Int
1)
    , (Double
0,  Double
1, -Int
1,  Int
1)
    , (Double
1,  Double
0, -Int
1,  Int
1)
    , (Double
0, -Double
1,  Int
1, -Int
1)
    , (Double
1,  Double
0, -Int
1,  Int
1)
    ]

-- > innerFlipQuartetD = illustrateGen 5 innerFlipQuartetGen

-- | \"Anti-Gosper\" (Ventrella p. 97, sqrt 7 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_antiGosperD.svg#diagram=antiGosperD&width=600>>
antiGosperGen :: Generator Double
antiGosperGen :: Generator Double
antiGosperGen
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ ( Double
1,  Double
0,  Int
1,  Int
1)
    , ( Double
0,  Double
1,  Int
1,  Int
1)
    , (-Double
1,  Double
0, -Int
1, -Int
1)
    , (-Double
1,  Double
1, -Int
1, -Int
1)
    , ( Double
1,  Double
0,  Int
1,  Int
1)
    , ( Double
1,  Double
0, -Int
1, -Int
1)
    , ( Double
1, -Double
1, -Int
1, -Int
1)
    ]

-- > antiGosperD = illustrateGen 4 antiGosperGen

-- | "Mandelbrot Snowflake Sweep #2" (Ventrella p. 197, sqrt 27 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_mandelSnowD.svg#diagram=mandelSnowD&width=600>>
mandelbrotSnowflakeGen :: Generator Double
mandelbrotSnowflakeGen :: Generator Double
mandelbrotSnowflakeGen
  = ((Double, Double, Int, Int) -> GeneratorSegment Double)
-> [(Double, Double, Int, Int)] -> Generator Double
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double, Int, Int) -> GeneratorSegment Double
forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (-Double
1,  Double
2,  Int
1, -Int
1)
    , (-Double
1,  Double
2,  Int
1,  Int
1)
    , ( Double
1,  Double
1,  Int
1,  Int
1)
    , ( Double
2, -Double
1,  Int
1,  Int
1)
    , (-Double
1,  Double
0,  Int
1,  Int
1)
    , (-Double
1,  Double
0,  Int
1, -Int
1)
    , ( Double
0, -Double
1,  Int
1, -Int
1)
    , ( Double
1, -Double
1,  Int
1, -Int
1)
    , ( Double
1,  Double
1,  Int
1,  Int
1)
    , ( Double
0, -Double
1,  Int
1,  Int
1)
    , ( Double
0, -Double
1,  Int
1, -Int
1)
    , ( Double
1,  Double
1,  Int
1, -Int
1)
    , ( Double
1,  Double
1,  Int
1,  Int
1)
    ]

-- > mandelSnowD = illustrateGen 3 mandelbrotSnowflakeGen

-- | Perform a \"level-1 smoothing\" by replacing a list of segments by
--   the segments between their midpoints.  Can be a useful technique
--   for visualizing degenerate space-filling curves, /e.g./ which
--   touch at corners or even share entire edges.
averageLine :: (Metric v, Floating n, Ord n) => Trail' Line v n -> Trail' Line v n
averageLine :: forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
Trail' Line v n -> Trail' Line v n
averageLine = [v n] -> Trail' Line v n
[Vn (Trail' Line v n)] -> Trail' Line v n
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([v n] -> Trail' Line v n)
-> (Trail' Line v n -> [v n]) -> Trail' Line v n -> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v n -> v n -> v n) -> [v n] -> [v n] -> [v n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (n -> v n -> v n -> v n
forall a. Num a => a -> v a -> v a -> v a
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
0.5) ([v n] -> [v n] -> [v n]) -> ([v n] -> [v n]) -> [v n] -> [v n]
forall a b. ([v n] -> a -> b) -> ([v n] -> a) -> [v n] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v n] -> [v n]
forall a. HasCallStack => [a] -> [a]
tail) ([v n] -> [v n])
-> (Trail' Line v n -> [v n]) -> Trail' Line v n -> [v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Closed v n -> v n) -> [Segment Closed v n] -> [v n]
forall a b. (a -> b) -> [a] -> [b]
map Segment Closed v n -> v n
forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset ([Segment Closed v n] -> [v n])
-> (Trail' Line v n -> [Segment Closed v n])
-> Trail' Line v n
-> [v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments

-- | Bevel a line by \"chopping off each corner\", connecting points 1/3
--   and 2/3 of the way along each segment.  Can be a useful technique
--   for visualizing degenerate space-filling curves, /e.g./ which touch
--   at corners or even share entire edges.
bevelLine :: (Metric v, Floating n, Ord n) => Trail' Line v n -> Trail' Line v n
bevelLine :: forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
Trail' Line v n -> Trail' Line v n
bevelLine = [v n] -> Trail' Line v n
[Vn (Trail' Line v n)] -> Trail' Line v n
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([v n] -> Trail' Line v n)
-> (Trail' Line v n -> [v n]) -> Trail' Line v n -> Trail' Line v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[v n]] -> [v n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[v n]] -> [v n])
-> (Trail' Line v n -> [[v n]]) -> Trail' Line v n -> [v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((v n -> v n -> [v n]) -> [v n] -> [v n] -> [[v n]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\v n
v1 v n
v2 -> [v n
v1 v n -> n -> v n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
3, (v n
v1 v n -> v n -> v n
forall a. Num a => v a -> v a -> v a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
v2) v n -> n -> v n
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
3]) ([v n] -> [v n] -> [[v n]]) -> ([v n] -> [v n]) -> [v n] -> [[v n]]
forall a b. ([v n] -> a -> b) -> ([v n] -> a) -> [v n] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [v n] -> [v n]
forall a. HasCallStack => [a] -> [a]
tail) ([v n] -> [[v n]])
-> (Trail' Line v n -> [v n]) -> Trail' Line v n -> [[v n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Segment Closed v n -> v n) -> [Segment Closed v n] -> [v n]
forall a b. (a -> b) -> [a] -> [b]
map Segment Closed v n -> v n
forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset ([Segment Closed v n] -> [v n])
-> (Trail' Line v n -> [Segment Closed v n])
-> Trail' Line v n
-> [v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line v n -> [Segment Closed v n]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments

--------------------------------------------------
-- Miscellaneous examples

-- $other
-- A random collection of other fun things you can do with 'iterTrail'
-- or 'iterGenerator'.  There is no particular emphasis on making
-- these configurable or generic; the point is just to suggest some
-- fun things you can do.  If you want to play with them, copy the
-- source code and modify it as you see fit.

-- | The famous Koch snowflake, made by putting three Koch curves
--   together. @snowflake n@ yields an order-@n@ snowflake.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_snowflake4.svg#diagram=snowflake4&width=300>>
snowflake :: RealFloat n => Int -> Trail V2 n
snowflake :: forall n. RealFloat n => Int -> Trail V2 n
snowflake Int
n = Int
-> (Trail' Line V2 n -> Trail' Line V2 n)
-> Trail' Line V2 n
-> [Trail' Line V2 n]
forall a. Int -> (a -> a) -> a -> [a]
iterateN Int
3 (n -> Trail' Line V2 n -> Trail' Line V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (-n
1n -> n -> n
forall a. Fractional a => a -> a -> a
/n
3)) Trail' Line V2 n
edge
            # mconcat
            # glueLine
            # wrapTrail
  where edge :: Trail' Line V2 n
edge = Trail' Line V2 n -> [Trail' Line V2 n]
forall n. RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail Trail' Line V2 n
forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
koch [Trail' Line V2 n] -> Int -> Trail' Line V2 n
forall a. HasCallStack => [a] -> Int -> a
!! Int
n

-- > import Diagrams.TwoD.Path.IteratedSubset
-- > snowflake4 = snowflake 4 # strokeT # centerXY # pad 1.1

--------------------------------------------------
-- Generating random iterated subset fractals

-- | Parameters to generate an iterated subset fractal.
data IterTrailConfig n = ITC { forall n. IterTrailConfig n -> Trail' Line V2 n
seed :: Trail' Line V2 n -- ^ The seed trail
                           , forall n. IterTrailConfig n -> Colour Double
color  :: Colour Double  -- ^ The line color to use
                           , forall n. IterTrailConfig n -> Int
iters  :: Int            -- ^ Number of iterations
                           }

-- | Generate a random 'IterTrailConfig'.  This features many
--   hard-coded values.  If you want to play with it just copy the
--   code and modify it to suit.
randITC ::
  (MonadRandom m,
   Ord n, Floating n, Random n) =>
           m (IterTrailConfig n)
randITC :: forall (m :: * -> *) n.
(MonadRandom m, Ord n, Floating n, Random n) =>
m (IterTrailConfig n)
randITC = do
  -- use between two and five segments for the seed pattern
  Int
nSegs   <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
2,Int
5)

  -- should we make the seed pattern a cubic spline?
  Bool
spline  <- m Bool
forall a. Random a => m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom

  -- generate a random list of linear segments drawn from (-1,1)^2.
  [Point V2 n]
s       <- [Vn [Point V2 n]] -> [Point V2 n]
[V2 n] -> [Point V2 n]
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([V2 n] -> [Point V2 n]) -> m [V2 n] -> m [Point V2 n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                Int -> m (V2 n) -> m [V2 n]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nSegs (PrevDim (V2 n) -> FinalCoord (V2 n) -> V2 n
forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
(^&) (PrevDim (V2 n) -> FinalCoord (V2 n) -> V2 n)
-> m (PrevDim (V2 n)) -> m (FinalCoord (V2 n) -> V2 n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrevDim (V2 n), PrevDim (V2 n)) -> m (PrevDim (V2 n))
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (-PrevDim (V2 n)
1,PrevDim (V2 n)
1) m (FinalCoord (V2 n) -> V2 n) -> m (FinalCoord (V2 n)) -> m (V2 n)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FinalCoord (V2 n), FinalCoord (V2 n)) -> m (FinalCoord (V2 n))
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (-FinalCoord (V2 n)
1,FinalCoord (V2 n)
1))

  -- generate a random color.
  Colour Double
c       <- Double -> Double -> Double -> Colour Double
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB (Double -> Double -> Double -> Colour Double)
-> m Double -> m (Double -> Double -> Colour Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Double
forall a. Random a => m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom m (Double -> Double -> Colour Double)
-> m Double -> m (Double -> Colour Double)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Double
forall a. Random a => m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom m (Double -> Colour Double) -> m Double -> m (Colour Double)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Double
forall a. Random a => m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom

  -- generate a random number of iterations, with a lower bound of 3
  -- (since fewer is not very interesting) and an upper bound chosen
  -- to ensure we won't get more than 10000 segments in the final
  -- path.
  Int
i       <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
3, Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nSegs :: Double) Double
10000))
  let s' :: Trail' Line V2 n
s'
        | Bool
spline    = Bool -> [Point V2 n] -> Trail' Line V2 n
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t, Fractional (v n)) =>
Bool -> [Point v n] -> t
cubicSpline Bool
False [Point V2 n]
s
        | Bool
otherwise = [Point (V (Trail' Line V2 n)) (N (Trail' Line V2 n))]
-> Trail' Line V2 n
forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices [Point (V (Trail' Line V2 n)) (N (Trail' Line V2 n))]
[Point V2 n]
s
  IterTrailConfig n -> m (IterTrailConfig n)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (IterTrailConfig n -> m (IterTrailConfig n))
-> IterTrailConfig n -> m (IterTrailConfig n)
forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n -> Colour Double -> Int -> IterTrailConfig n
forall n.
Trail' Line V2 n -> Colour Double -> Int -> IterTrailConfig n
ITC Trail' Line V2 n
s' Colour Double
c Int
i

-- | Generate an iterated subset fractal based on the given parameters.
drawITC :: (Renderable (Path V2 n) b, TypeableFloat n) =>
           IterTrailConfig n -> QDiagram b V2 n Any
drawITC :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITC (ITC Trail' Line V2 n
s Colour Double
c Int
i) = (Trail' Line V2 n -> [Trail' Line V2 n]
forall n. RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail Trail' Line V2 n
s [Trail' Line V2 n] -> Int -> Trail' Line V2 n
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) Trail' Line V2 n
-> (Trail' Line V2 n -> QDiagram b V2 n Any) -> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Trail' Line V2 n -> QDiagram b V2 n Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
forall a b. a -> (a -> b) -> b
# Colour Double -> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
c

-- | Like 'drawITC', but also scales, centers, and pads the result so
-- that it fits nicely inside a 4x4 box.
drawITCScaled
  :: (Renderable (Path V2 n) b, RealFloat n, Typeable n)
  => IterTrailConfig n -> QDiagram b V2 n Any
drawITCScaled :: forall n b.
(Renderable (Path V2 n) b, RealFloat n, Typeable n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITCScaled IterTrailConfig n
itc
  = IterTrailConfig n -> QDiagram b V2 n Any
forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITC IterTrailConfig n
itc
  # sized (dims2D 4 4)
  # centerXY
  # pad 1.1

-- | Create a grid of 25 random iterated subset fractals.  Impress
--   your friends!
--
-- <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_randIterGridEx.svg#diagram=randIterGridEx&width=500>>
randIterGrid :: (Renderable (Path V2 n) b, Random n, TypeableFloat n) =>
                IO (QDiagram b V2 n Any)
randIterGrid :: forall n b.
(Renderable (Path V2 n) b, Random n, TypeableFloat n) =>
IO (QDiagram b V2 n Any)
randIterGrid = do
  [IterTrailConfig n]
itcs <- Rand StdGen [IterTrailConfig n] -> IO [IterTrailConfig n]
forall a. Rand StdGen a -> IO a
evalRandIO (Int
-> RandT StdGen Identity (IterTrailConfig n)
-> Rand StdGen [IterTrailConfig n]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
25 RandT StdGen Identity (IterTrailConfig n)
forall (m :: * -> *) n.
(MonadRandom m, Ord n, Floating n, Random n) =>
m (IterTrailConfig n)
randITC)
  QDiagram b V2 n Any -> IO (QDiagram b V2 n Any)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall n b.
TypeableFloat n =>
[QDiagram b V2 n Any] -> QDiagram b V2 n Any
LG.gridCat ([QDiagram b V2 n Any] -> QDiagram b V2 n Any)
-> ([IterTrailConfig n] -> [QDiagram b V2 n Any])
-> [IterTrailConfig n]
-> QDiagram b V2 n Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IterTrailConfig n -> QDiagram b V2 n Any)
-> [IterTrailConfig n] -> [QDiagram b V2 n Any]
forall a b. (a -> b) -> [a] -> [b]
map IterTrailConfig n -> QDiagram b V2 n Any
forall n b.
(Renderable (Path V2 n) b, RealFloat n, Typeable n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITCScaled ([IterTrailConfig n] -> QDiagram b V2 n Any)
-> [IterTrailConfig n] -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ [IterTrailConfig n]
itcs)

-- > import Diagrams.TwoD.Path.IteratedSubset
-- > randIterGridEx = randIterGrid