{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.Example.Logo
-- Copyright   :  (c) 2011 Brent Yorgey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@cis.upenn.edu
--
-- Source code for creating the diagrams logo.
--
-- <<diagrams/src_Diagrams_Example_Logo_diaLogo.svg#diagram=diaLogo&height=100>>
--
-----------------------------------------------------------------------------
module Diagrams.Example.Logo where

-- > import Diagrams.Example.Logo
-- > diaLogo = logo

import           Diagrams.Prelude

import           Diagrams.TwoD.Layout.Tree
import           Diagrams.TwoD.Path.Turtle

import           Control.Monad

------------------------------------------------------------
-- D
------------------------------------------------------------

d :: QDiagram b V2 n Any
d = (forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke forall a b. (a -> b) -> a -> b
$
   forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
2 forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBR forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX (-n
0.5)
   forall a. Semigroup a => a -> a -> a
<> (forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
hcat' (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (CatOpts n) n
sepforall s t a b. ASetter s t a b -> b -> s -> t
.~ n
0.2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
vcat' (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (CatOpts n) n
sep forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
0.2))
        forall a b. (a -> b) -> a -> b
$ (forall a. Int -> a -> [a]
replicate Int
2 (forall a. Int -> a -> [a]
replicate Int
9 (forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Path v n -> Path v n
reversePath forall a b. (a -> b) -> a -> b
$ forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
0.3)))) forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBR)
    # fc red
    # lwG 0

-- an icon-ish version of the d

ico_d :: QDiagram b V2 n Any
ico_d = (forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke forall a b. (a -> b) -> a -> b
$
        forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
2 forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBR forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R1 v, Transformable t) =>
n -> t -> t
translateX (-n
0.5)
        forall a. Semigroup a => a -> a -> a
<> (forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
vcat' (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (CatOpts n) n
sepforall s t a b. ASetter s t a b -> b -> s -> t
.~ n
0.3) forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
5 (forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Path v n -> Path v n
reversePath forall a b. (a -> b) -> a -> b
$ forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
0.5)) forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignBR)
        # fc red
        # lwG 0

------------------------------------------------------------
-- I
------------------------------------------------------------

i :: QDiagram b V2 n m
i = (forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
1 forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
=== forall (v :: * -> *) n b m.
(Metric v, R2 v, OrderedField n) =>
n -> QDiagram b v n m
strutY n
0.5 forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
=== forall n t.
(InSpace V2 n t, TrailLike t, RealFloat n) =>
n -> n -> n -> t
roundedRect n
2 n
4 n
0.4)
    # lwG 0.05
    # lc blue
    # fc yellow

------------------------------------------------------------
-- A
------------------------------------------------------------

sierpinski :: t -> a
sierpinski t
1 = forall n t. (InSpace V2 n t, TrailLike t) => PolygonOpts n -> t
polygon (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (PolygonOpts n) (PolyType n)
polyType forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall n. Int -> n -> PolyType n
PolyRegular Int
3 N a
1 )
sierpinski t
n = a
t forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
=== (a
t forall n a.
(InSpace V2 n a, Juxtaposable a, Semigroup a) =>
a -> a -> a
||| a
t) forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, R1 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerX
  where t :: a
t = t -> a
sierpinski (t
nforall a. Num a => a -> a -> a
-t
1)

a1 :: b
a1 = forall {a} {t}.
(V a ~ V2, Semigroup a, Juxtaposable a, Num t, TrailLike a,
 R1 (V a), Alignable a, HasOrigin a, Eq t) =>
t -> a
sierpinski (Integer
4 :: Integer)
     # fc navy
     # lwG 0
     # scale (1/2)

------------------------------------------------------------
-- G
------------------------------------------------------------

grid :: a
grid = forall {a}.
(V a ~ V2, Monoid a, HasOrigin a, Juxtaposable a, TrailLike a) =>
a
verts forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerXY forall a. Semigroup a => a -> a -> a
<> forall {t}.
(V t ~ V2, Transformable t, Monoid t, HasOrigin t, Juxtaposable t,
 TrailLike t) =>
t
horiz forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, R2 v, Fractional n, Alignable a, HasOrigin a) =>
a -> a
centerXY
  where verts :: a
verts = forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
hcat' (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (CatOpts n) n
sepforall s t a b. ASetter s t a b -> b -> s -> t
.~N a
0.5) forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
20 (forall n t. (InSpace V2 n t, TrailLike t) => n -> t
vrule N a
10)
        horiz :: t
horiz = forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (N t
1forall a. Fractional a => a -> a -> a
/N t
4) forall {a}.
(V a ~ V2, Monoid a, HasOrigin a, Juxtaposable a, TrailLike a) =>
a
verts

gbkg :: forall b n m. (TrailLike (QDiagram b V2 n m), Monoid m, Semigroup m,
                       TypeableFloat n) =>
        QDiagram b V2 n m
gbkg :: forall b n m.
(TrailLike (QDiagram b V2 n m), Monoid m, Semigroup m,
 TypeableFloat n) =>
QDiagram b V2 n m
gbkg = forall {a}.
(V a ~ V2, Monoid a, HasOrigin a, Juxtaposable a, TrailLike a,
 Alignable a, Transformable a, R2 (V a)) =>
a
grid
    # lc gray
    # rotateBy (-1/20)
    # clipBy p
    # withEnvelope (p :: Path V2 n)
    # lwG 0.05
  where p :: t
p = forall n t. (InSpace V2 n t, TrailLike t) => n -> t
square N t
5

g :: QDiagram b V2 n Any
g = (forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
String -> QDiagram b V2 n Any
text String
"G" forall a b. a -> (a -> b) -> b
# forall a n. (N a ~ n, Typeable n, Num n, HasStyle a) => n -> a -> a
fontSizeG n
4 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
20)) forall a. Semigroup a => a -> a -> a
<> forall b n m.
(TrailLike (QDiagram b V2 n m), Monoid m, Semigroup m,
 TypeableFloat n) =>
QDiagram b V2 n m
gbkg

------------------------------------------------------------
-- R
------------------------------------------------------------

r :: QDiagram b V2 n Any
r = forall n a. (Floating n, Ord n) => Turtle n a -> Path V2 n
sketchTurtle (forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
setHeading n
90 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
forward n
5 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
right n
90
                 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
5 (forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
forward n
0.9 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
right n
36)
                 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
forward n
0.9 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
left n
135 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall n (m :: * -> *).
(OrderedField n, Monad m) =>
n -> TurtleT n m ()
forward n
3
                 )
  # reversePath
  # stroke' (with & vertexNames .~ [["end"]] )
  # lwG 0.3
  # lineJoin LineJoinRound
  # lineCap LineCapRound
  # lc orange
  # (withName "end" $ atop . place turtle . location)
  where
    turtle :: b
turtle = forall n t. (InSpace V2 n t, TrailLike t) => n -> t
eqTriangle N b
1 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 N b
1.3 forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (-N b
135 forall b a. b -> AReview a b -> a
@@ forall n. Floating n => Iso' (Angle n) n
deg)
             # lwG 0.1

------------------------------------------------------------
-- A
------------------------------------------------------------

aTree :: BTree ()
aTree = forall a. a -> BTree a -> BTree a -> BTree a
BNode () BTree ()
f BTree ()
f
  where f :: BTree ()
f = forall a. a -> BTree a -> BTree a -> BTree a
BNode () (forall a. a -> BTree a
leaf ()) (forall a. a -> BTree a
leaf ())

a2 :: QDiagram b V2 n m
a2 = forall m n a b.
(Monoid' m, Floating n, Ord n) =>
(a -> QDiagram b V2 n m)
-> (P2 n -> P2 n -> QDiagram b V2 n m)
-> Tree (a, P2 n)
-> QDiagram b V2 n m
renderTree (\()
_ -> forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle n
0.5 forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc forall a. (Ord a, Floating a) => Colour a
purple) forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Point v n -> Point v n -> t
(~~) forall {n}. (Floating n, Ord n) => Tree ((), P2 n)
t'' forall a b. a -> (a -> b) -> b
# forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG n
0.1
  where Just Tree ((), P2 n)
t' = forall n a. Num n => n -> n -> BTree a -> Maybe (Tree (a, P2 n))
uniqueXLayout n
1 n
2 BTree ()
aTree
        t'' :: Tree ((), P2 n)
t''     = forall n a. (Floating n, Ord n) => Tree (a, P2 n) -> Tree (a, P2 n)
forceLayoutTree forall {n}. Num n => Tree ((), P2 n)
t'

------------------------------------------------------------
-- M
------------------------------------------------------------

m :: QDiagram b V2 n Any
m = forall n t. (InSpace V2 n t, TrailLike t) => n -> t
square n
5 forall a b. a -> (a -> b) -> b
# forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG n
0.05 forall a. Semigroup a => a -> a -> a
<>
    forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
String -> QDiagram b V2 n Any
text String
"m"
      # fontSizeG 6 # italic # font "freeserif" # fc green

------------------------------------------------------------
-- S
------------------------------------------------------------

ps :: [P2 n]
ps = forall a b. (a -> b) -> [a] -> [b]
map forall n. (n, n) -> P2 n
p2 [(n
5,n
5), (n
3,n
6), (n
1,n
5), (n
1,n
4), (n
3,n
3), (n
5,n
2), (n
4,n
0), (n
0,n
0.5)]
s :: b
s = (forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall (v :: * -> *) n t.
(InSpace v n t, HasOrigin t) =>
t -> Point v n -> t
place (forall {b}.
(V b ~ V2, Transformable b, TrailLike b, Typeable (N b),
 HasStyle b) =>
Colour Double -> b
disk forall a. (Ord a, Floating a) => Colour a
blue)) forall {n}. Fractional n => [P2 n]
ps) forall a. Semigroup a => a -> a -> a
<>
    forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t, Fractional (v n)) =>
Bool -> [Point v n] -> t
cubicSpline Bool
False forall {n}. Fractional n => [P2 n]
ps forall a b. a -> (a -> b) -> b
# forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG N b
0.20)
    # scale 0.8

disk :: Colour Double -> b
disk Colour Double
c = forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Transformable t) =>
n -> t
circle N b
0.4 forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
c forall a b. a -> (a -> b) -> b
# forall a n. (N a ~ n, HasStyle a, Typeable n, Num n) => n -> a -> a
lwG N b
0

------------------------------------------------------------
-- Logo
------------------------------------------------------------

logo :: QDiagram b V2 n Any
logo = (forall n a.
(InSpace V2 n a, Floating n, Juxtaposable a, HasOrigin a,
 Monoid' a) =>
CatOpts n -> [a] -> a
hcat' (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (CatOpts n) n
sep forall s t a b. ASetter s t a b -> b -> s -> t
.~ n
0.5) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n a.
(InSpace V2 n a, Fractional n, Alignable a, HasOrigin a) =>
a -> a
alignB forall a b. (a -> b) -> a -> b
$ [ forall {n} {b}.
(Renderable (Path V2 n) b, RealFloat n, Typeable n) =>
QDiagram b V2 n Any
d, forall {m} {n} {b}.
(Monoid m, TrailLike (QDiagram b V2 n m), RealFloat n,
 Typeable n) =>
QDiagram b V2 n m
i, forall {b}.
(V b ~ V2, HasOrigin b, Alignable b, R1 (V b), TrailLike b,
 Juxtaposable b, Semigroup b, Typeable (N b), HasStyle b,
 Transformable b) =>
b
a1, forall {n} {b}.
(Typeable n, RealFloat n, Renderable (Path V2 n) b,
 Renderable (Text n) b) =>
QDiagram b V2 n Any
g, forall {n} {b}.
(Typeable n, RealFloat n, Renderable (Path V2 n) b) =>
QDiagram b V2 n Any
r, forall {m} {n} {b}.
(Monoid m, Floating n, Ord n, TrailLike (QDiagram b V2 n m),
 Typeable n) =>
QDiagram b V2 n m
a2, forall {n} {b}.
(Typeable n, RealFloat n, Renderable (Path V2 n) b,
 Renderable (Text n) b) =>
QDiagram b V2 n Any
m, forall {b}.
(V b ~ V2, Monoid b, HasOrigin b, Transformable b, TrailLike b,
 Typeable (N b), HasStyle b) =>
b
s ])
       # centerXY