{-# LANGUAGE CPP #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Diagrams.TwoD.Path.IteratedSubset
(
refineSegment, iterTrail
, GeneratorSegment(..), mkGS, mkGS3, Generator
, refineGeneratorSegment, iterGenerator
, averageLine
, bevelLine
, showGenerator
, koch
, levy
, zag
, sqUp
, sqUpDown
, dragonGen
, polyaGen
, terDragonGen
, invTerDragonGen
, ventrella56b
, yinDragonGen
, ventrella67
, innerFlipQuartetGen
, antiGosperGen
, mandelbrotSnowflakeGen
, snowflake
, IterTrailConfig(..), randITC, drawITC, drawITCScaled
, randIterGrid
) where
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
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' = forall a. (a -> a) -> a -> [a]
iterate (\Trail' Line V2 n
tr -> forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall n.
RealFloat n =>
Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
refineSegment Trail' Line V2 n
tr) forall a b. (a -> b) -> a -> b
$ [V2 n]
offs)
(forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX])
where offs :: [V2 n]
offs = forall a b. (a -> b) -> [a] -> [b]
map forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n
seed'
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 forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Bool -> Bool -> Bool
|| V2 n
sOff forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a. (Additive f, Num a) => f a
zero = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n
t forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
k forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
r
where
tOff :: V2 n
tOff = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> v n
lineOffset Trail' Line V2 n
t
k :: n
k = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V2 n
sOff forall a. Fractional a => a -> a -> a
/ forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V2 n
tOff
r :: Angle n
r = (V2 n
sOffforall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta) forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (V2 n
tOffforall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta)
data GeneratorSegment n = GS (V2 n) Bool Bool
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 = forall t. TrailLike t => [Vn t] -> t
fromOffsets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. GeneratorSegment n -> V2 n
generatorSegmentOffset
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 = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any
showGenSeg (forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Located (Trail v n) -> [t]
explodeTrail (forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail (forall n. (Floating n, Ord n) => Generator n -> Trail' Line V2 n
generatorToLine Generator n
g) forall a. a -> Point (V a) (N a) -> Located a
`at` 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 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 forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
ArrowOpts n -> Point V2 n -> V2 n -> QDiagram b V2 n Any
arrowAt' (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (ArrowOpts n) (ArrowHT n)
arrowHead forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall n. RealFloat n => ArrowHT n
halfDart) (forall a. Located a -> Point (V a) (N a)
loc Located (Trail V2 n)
locTr') (forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> v n
trailOffset (forall a. Located a -> a
unLoc Located (Trail V2 n)
locTr'))
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)
= forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv (forall n. (n, n) -> V2 n
r2 (n
x,n
y)) Int
flip1 Int
flip2
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)
= forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv (forall n. (n, n) -> V2 n
r2 (n
x,n
y) forall a b. a -> (a -> b) -> b
# forall n t. (InSpace V2 n t, Transformable t) => n -> t -> t
shearX n
0.5 forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY (forall a. Floating a => a -> a
sqrt n
3 forall a. Fractional a => a -> a -> a
/ n
2)) Int
flip1 Int
flip2
mkGSv :: V2 n -> Int -> Int -> GeneratorSegment n
mkGSv :: forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv V2 n
v Int
flip1 Int
flip2 = forall n. V2 n -> Bool -> Bool -> GeneratorSegment n
GS V2 n
v (Int
flip1 forall a. Ord a => a -> a -> Bool
< Int
0) (Int
flip2 forall a. Ord a => a -> a -> Bool
< Int
0)
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)
= forall n.
RealFloat n =>
Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
refineSegment (Trail' Line V2 n
t forall a b. a -> (a -> b) -> b
# 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 forall a. Bits a => a -> a -> a
`xor` Bool
flipY then forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY else forall a. a -> a
id)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
flipX then forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Line v n
reverseLine else forall a. a -> a
id)
iterGenerator :: RealFloat n => Generator n -> [Trail' Line V2 n]
iterGenerator :: forall n. RealFloat n => Generator n -> [Trail' Line V2 n]
iterGenerator Generator n
g = forall a. (a -> a) -> a -> [a]
iterate (\Trail' Line V2 n
tr -> forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall n.
RealFloat n =>
Trail' Line V2 n -> GeneratorSegment n -> Maybe (Trail' Line V2 n)
refineGeneratorSegment Trail' Line V2 n
tr) forall a b. (a -> b) -> a -> b
$ Generator n
g)
(forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX])
koch :: (TrailLike t, V t ~ V2, N t ~ n) => t
koch :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
koch = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (n
1forall a. Fractional a => a -> a -> a
/n
6), forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (-n
1forall a. Fractional a => a -> a -> a
/n
6), forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]
levy :: (TrailLike t, V t ~ V2, N t ~ n) => t
levy :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
levy = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]
zag :: (TrailLike t, V t ~ V2, N t ~ n) => t
zag :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
zag = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, (-n
0.5) forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& n
1, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]
sqUp :: (TrailLike t, V t ~ V2, N t ~ n) => t
sqUp :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
sqUp = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]
sqUpDown :: (TrailLike t, V t ~ V2, N t ~ n) => t
sqUpDown :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
sqUpDown = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, n
2 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]
dragonGen :: Generator Double
dragonGen :: Generator Double
dragonGen
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
polyaGen :: Generator Double
polyaGen :: Generator Double
polyaGen
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
terDragonGen :: Generator Double
terDragonGen :: Generator Double
terDragonGen
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
invTerDragonGen :: Generator Double
invTerDragonGen :: Generator Double
invTerDragonGen
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
ventrella56b :: Generator Double
ventrella56b :: Generator Double
ventrella56b
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
yinDragonGen :: Generator Double
yinDragonGen :: Generator Double
yinDragonGen
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
ventrella67 :: Generator Double
ventrella67 :: Generator Double
ventrella67
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
innerFlipQuartetGen :: Generator Double
innerFlipQuartetGen :: Generator Double
innerFlipQuartetGen
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
antiGosperGen :: Generator Double
antiGosperGen :: Generator Double
antiGosperGen
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
mandelbrotSnowflakeGen :: Generator Double
mandelbrotSnowflakeGen :: Generator Double
mandelbrotSnowflakeGen
= forall a b. (a -> b) -> [a] -> [b]
map 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)
]
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 = forall t. TrailLike t => [Vn t] -> t
fromOffsets forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
0.5) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> [a]
tail) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments
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 = forall t. TrailLike t => [Vn t] -> t
fromOffsets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\v n
v1 v n
v2 -> [v n
v1 forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
3, (v n
v1 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
v2) forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
3]) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> [a]
tail) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments
snowflake :: RealFloat n => Int -> Trail V2 n
snowflake :: forall n. RealFloat n => Int -> Trail V2 n
snowflake Int
n = forall a. Int -> (a -> a) -> a -> [a]
iterateN Int
3 (forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (-n
1forall a. Fractional a => a -> a -> a
/n
3)) Trail' Line V2 n
edge
# mconcat
# glueLine
# wrapTrail
where edge :: Trail' Line V2 n
edge = forall n. RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
koch forall a. [a] -> Int -> a
!! Int
n
data IterTrailConfig n = ITC { forall n. IterTrailConfig n -> Trail' Line V2 n
seed :: Trail' Line V2 n
, forall n. IterTrailConfig n -> Colour Double
color :: Colour Double
, forall n. IterTrailConfig n -> Int
iters :: Int
}
randITC ::
(MonadRandom m,
#if MIN_VERSION_base(4,9,0)
#else
Applicative m,
#endif
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
Int
nSegs <- forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
2,Int
5)
Bool
spline <- forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
[Point V2 n]
s <- forall t. TrailLike t => [Vn t] -> t
fromOffsets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nSegs (forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
(^&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (-PrevDim (V2 n)
1,PrevDim (V2 n)
1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (-FinalCoord (V2 n)
1,FinalCoord (V2 n)
1))
Colour Double
c <- forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
Int
i <- forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
3, forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Floating a => a -> a -> a
logBase (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nSegs :: Double) Double
10000))
let s' :: Trail' Line V2 n
s'
| Bool
spline = 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 = forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices [Point V2 n]
s
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n.
Trail' Line V2 n -> Colour Double -> Int -> IterTrailConfig n
ITC Trail' Line V2 n
s' Colour Double
c Int
i
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) = (forall n. RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail Trail' Line V2 n
s forall a. [a] -> Int -> a
!! Int
i) forall a b. a -> (a -> b) -> b
# forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
c
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
= 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
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 <- forall a. Rand StdGen a -> IO a
evalRandIO (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
25 forall (m :: * -> *) n.
(MonadRandom m, Ord n, Floating n, Random n) =>
m (IterTrailConfig n)
randITC)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall n b.
TypeableFloat n =>
[QDiagram b V2 n Any] -> QDiagram b V2 n Any
LG.gridCat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n b.
(Renderable (Path V2 n) b, RealFloat n, Typeable n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITCScaled forall a b. (a -> b) -> a -> b
$ [IterTrailConfig n]
itcs)