{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

-- | The seven equality diagrams from the renderer order of record.
module Strings.Svg.Examples
  ( yankingRightExample,
    yankingLeftExample,
    slidingExample,
    traceSlidingExample,
    braidInverseExample,
    tensorInterchangeExample,
    starArdenExample,
    knotBraid3Example,
    knotCircleExample,
    knotTraceExample,
    knotTangleExample,
    allExamples,
    writeAllExamples,
  )
where

import Chart
import Circuit.Poly qualified as Poly
import Circuit.Poly.StringDiagram (SDiagram (..), boxLabelled, skeleton)
import Data.Text (pack)
import Optics.Core
import Strings.Svg.Layout
import Strings.Svg.Palette
import Strings.Svg.Render
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
import Prelude

-- | Tiny labelled identity box (types discarded after 'skeleton').
boxF :: String -> SDiagram
boxF :: String -> SDiagram
boxF String
lbl = Diagram (ZonkAny 1) (ZonkAny 0) (ZonkAny 1) (ZonkAny 0) -> SDiagram
forall a da b db. Diagram a da b db -> SDiagram
skeleton (String
-> Morphism
     (Mono (ZonkAny 0) (ZonkAny 1)) (Mono (ZonkAny 0) (ZonkAny 1))
-> Diagram (ZonkAny 1) (ZonkAny 0) (ZonkAny 1) (ZonkAny 0)
forall da a db b.
String -> Morphism (Mono da a) (Mono db b) -> Diagram a da b db
boxLabelled String
lbl ((ZonkAny 1 -> ZonkAny 1)
-> (ZonkAny 1 -> ZonkAny 0 -> ZonkAny 0)
-> Morphism
     (Mono (ZonkAny 0) (ZonkAny 1)) (Mono (ZonkAny 0) (ZonkAny 1))
forall a b db da.
(a -> b) -> (a -> db -> da) -> Morphism (Mono da a) (Mono db b)
Poly.lens ZonkAny 1 -> ZonkAny 1
forall a. a -> a
id (\ZonkAny 1
_ ZonkAny 0
da -> ZonkAny 0
da)))

-- | @a = b = c = …@ as a single row of layouts.
rowEquals :: [Layout] -> Layout
rowEquals :: [Layout] -> Layout
rowEquals [] = SDiagram -> Layout
layoutSDiagram SDiagram
SWire
rowEquals (Layout
x : [Layout]
xs) = (Layout -> Layout -> Layout) -> Layout -> [Layout] -> Layout
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Layout -> Layout -> Layout
equalityRow Layout
x [Layout]
xs

--------------------------------------------------------------------------------
-- 1. Right yanking
--------------------------------------------------------------------------------

-- | Cap–cup snake equals a straight wire.
yankingRightExample :: ChartOptions
yankingRightExample :: ChartOptions
yankingRightExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    Layout -> Layout -> Layout
equalityRow Layout
snake Layout
idWire
  where
    snake :: Layout
snake =
      SDiagram -> Layout
layoutSDiagram (SDiagram -> Layout) -> SDiagram -> Layout
forall a b. (a -> b) -> a -> b
$
        SDiagram -> SDiagram -> SDiagram
SThenD
          (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SBend' SDiagram
SWire)
          (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SWire SDiagram
SBend)
    idWire :: Layout
idWire = SDiagram -> Layout
layoutSDiagram SDiagram
SWire

--------------------------------------------------------------------------------
-- 2. Left yanking
--------------------------------------------------------------------------------

yankingLeftExample :: ChartOptions
yankingLeftExample :: ChartOptions
yankingLeftExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    Layout -> Layout -> Layout
equalityRow Layout
snake Layout
idWire
  where
    snake :: Layout
snake =
      SDiagram -> Layout
layoutSDiagram (SDiagram -> Layout) -> SDiagram -> Layout
forall a b. (a -> b) -> a -> b
$
        SDiagram -> SDiagram -> SDiagram
SThenD
          (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SWire SDiagram
SBend')
          (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SBend SDiagram
SWire)
    idWire :: Layout
idWire = SDiagram -> Layout
layoutSDiagram SDiagram
SWire

--------------------------------------------------------------------------------
-- 3. Sliding: f;id = f = id;f
--------------------------------------------------------------------------------

slidingExample :: ChartOptions
slidingExample :: ChartOptions
slidingExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    [Layout] -> Layout
rowEquals
      [ SDiagram -> Layout
layoutSDiagram (SDiagram -> SDiagram -> SDiagram
SThenD (String -> SDiagram
boxF String
"f") SDiagram
SWire),
        SDiagram -> Layout
layoutSDiagram (String -> SDiagram
boxF String
"f"),
        SDiagram -> Layout
layoutSDiagram (SDiagram -> SDiagram -> SDiagram
SThenD SDiagram
SWire (String -> SDiagram
boxF String
"f"))
      ]

--------------------------------------------------------------------------------
-- 4. Trace sliding: box outside feedback = box inside feedback
--------------------------------------------------------------------------------

traceSlidingExample :: ChartOptions
traceSlidingExample :: ChartOptions
traceSlidingExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    Layout -> Layout -> Layout
equalityRow Layout
outside Layout
inside
  where
    -- feedback loop drawn as dashed cubic around a wire; box outside vs inside
    outside :: Layout
outside = Maybe String -> Bool -> Layout
feedbackWith (String -> Maybe String
forall a. a -> Maybe a
Just String
"f") Bool
False
    inside :: Layout
inside = Maybe String -> Bool -> Layout
feedbackWith (String -> Maybe String
forall a. a -> Maybe a
Just String
"f") Bool
True

-- | Simple feedback cartoon: through-wire plus a loop above.
-- When @boxInside@, the label sits on the loop; otherwise on the through-wire.
feedbackWith :: Maybe String -> Bool -> Layout
feedbackWith :: Maybe String -> Bool -> Layout
feedbackWith Maybe String
mlab Bool
boxInside =
  Layout
    { picture :: ChartTree
picture =
        [Chart] -> ChartTree
unnamed ([Chart] -> ChartTree) -> [Chart] -> ChartTree
forall a b. (a -> b) -> a -> b
$
          [ Style -> [[Point Double]] -> Chart
LineChart (Colour -> Style
wireStyle Colour
wireGrey) [[Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
2 Double
0]],
            Style -> [PathData Double] -> Chart
PathChart
              ( Colour -> Double -> Style
pathStroke Colour
accentBlue Double
0.035
                  Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style (Maybe [Double]) (Maybe [Double])
-> Maybe [Double] -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style (Maybe [Double]) (Maybe [Double])
#dasharray ([Double] -> Maybe [Double]
forall a. a -> Maybe a
Just [Double
0.08, Double
0.05])
              )
              [ Point Double -> PathData Double
forall a. Point a -> PathData a
StartP (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.4 Double
0),
                Point Double -> Point Double -> Point Double -> PathData Double
forall a. Point a -> Point a -> Point a -> PathData a
CubicP (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.4 Double
0.7) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.6 Double
0.7) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.6 Double
0),
                Point Double -> Point Double -> Point Double -> PathData Double
forall a. Point a -> Point a -> Point a -> PathData a
CubicP (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.6 (-Double
0.05)) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.4 (-Double
0.05)) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.4 Double
0)
              ]
          ]
            [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> [Chart]
boxCharts,
      leftPorts :: [Point Double]
leftPorts = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0],
      rightPorts :: [Point Double]
rightPorts = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
2 Double
0],
      bounds :: Rect Double
bounds = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
2 (-Double
0.35) Double
0.85
    }
  where
    boxCharts :: [Chart]
boxCharts = case Maybe String
mlab of
      Maybe String
Nothing -> []
      Just String
lbl ->
        let (Double
cx, Double
cy) = if Bool
boxInside then (Double
1.0, Double
0.55) else (Double
1.0, Double
0)
            hw :: Double
hw = Double
0.28
            hh :: Double
hh = Double
0.18
         in [ Style -> [Rect Double] -> Chart
RectChart (Colour -> Style
boxStyle Colour
accentBlue) [Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hw) (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hw) (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
hh) (Double
cy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hh)],
              Style -> [(Text, Point Double)] -> Chart
TextChart Style
labelStyle [(String -> Text
pack String
lbl, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
cx Double
cy)]
            ]

--------------------------------------------------------------------------------
-- 5. Braid inverse: swap;swap = id⊗id
--------------------------------------------------------------------------------

braidInverseExample :: ChartOptions
braidInverseExample :: ChartOptions
braidInverseExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    Layout -> Layout -> Layout
equalityRow
      (SDiagram -> Layout
layoutSDiagram (SDiagram -> SDiagram -> SDiagram
SThenD SDiagram
SSwap SDiagram
SSwap))
      (SDiagram -> Layout
layoutSDiagram (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SWire SDiagram
SWire))

--------------------------------------------------------------------------------
-- 6. Tensor interchange: (f⊗g);(h⊗k) = (f;h)⊗(g;k)
--------------------------------------------------------------------------------

tensorInterchangeExample :: ChartOptions
tensorInterchangeExample :: ChartOptions
tensorInterchangeExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    Layout -> Layout -> Layout
equalityRow Layout
lhs Layout
rhs
  where
    f :: SDiagram
f = String -> SDiagram
boxF String
"f"
    g :: SDiagram
g = String -> SDiagram
boxF String
"g"
    h :: SDiagram
h = String -> SDiagram
boxF String
"h"
    k :: SDiagram
k = String -> SDiagram
boxF String
"k"
    lhs :: Layout
lhs =
      SDiagram -> Layout
layoutSDiagram (SDiagram -> Layout) -> SDiagram -> Layout
forall a b. (a -> b) -> a -> b
$
        SDiagram -> SDiagram -> SDiagram
SThenD
          (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
f SDiagram
g)
          (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
h SDiagram
k)
    rhs :: Layout
rhs =
      SDiagram -> Layout
layoutSDiagram (SDiagram -> Layout) -> SDiagram -> Layout
forall a b. (a -> b) -> a -> b
$
        SDiagram -> SDiagram -> SDiagram
SBeside
          (SDiagram -> SDiagram -> SDiagram
SThenD SDiagram
f SDiagram
h)
          (SDiagram -> SDiagram -> SDiagram
SThenD SDiagram
g SDiagram
k)

--------------------------------------------------------------------------------
-- 7. Star / Arden: a* = 1 ∨ (a ; a*)
--------------------------------------------------------------------------------

starArdenExample :: ChartOptions
starArdenExample :: ChartOptions
starArdenExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    Layout -> Layout -> Layout
equalityRow Layout
lhs Layout
rhs
  where
    lhs :: Layout
lhs = SDiagram -> Layout
layoutSDiagram (String -> SDiagram
boxF String
"a*")
    -- algebraic RHS: join of unit wire and series a ; a*
    rhs :: Layout
rhs =
      Layout
        { picture :: ChartTree
picture =
            Maybe Text -> [ChartTree] -> ChartTree
group
              Maybe Text
forall a. Maybe a
Nothing
              [ Layout -> ChartTree
picture Layout
unitPath,
                Layout -> ChartTree
picture Layout
seriesPath,
                [Chart] -> ChartTree
unnamed
                  [ -- join node
                    Style -> [Point Double] -> Chart
GlyphChart
                      ( Style
defaultGlyphStyle
                          Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
CircleGlyph
                          Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.12
                          Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
accentBlue
                          Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor Colour
accentBlue
                          Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.02
                          Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style ScaleP ScaleP
-> ScaleP -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style ScaleP ScaleP
#scaleP ScaleP
NoScaleP
                      )
                      [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.15 Double
0],
                    Style -> [[Point Double]] -> Chart
LineChart (Colour -> Style
wireStyle Colour
wireGrey) [[Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.15 Double
0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0]],
                    Style -> [[Point Double]] -> Chart
LineChart (Colour -> Style
wireStyle Colour
wireGrey) [[Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.9 Double
0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
2.1 Double
0]]
                  ]
              ],
          leftPorts :: [Point Double]
leftPorts = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0],
          rightPorts :: [Point Double]
rightPorts = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
2.1 Double
0],
          bounds :: Rect Double
bounds = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
2.1 (-Double
0.55) Double
0.55
        }
    unitPath :: Layout
unitPath =
      Point Double -> Layout -> Layout
moveLayout (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.15 Double
0.35) (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$
        Layout
          { picture :: ChartTree
picture =
              [Chart] -> ChartTree
unnamed
                [ Style -> [[Point Double]] -> Chart
LineChart (Colour -> Style
wireStyle Colour
accentGreen) [[Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.5 Double
0]],
                  Style -> [(Text, Point Double)] -> Chart
TextChart
                    (Style
labelStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.14 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
muteGrey)
                    [(Text
"1", Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.75 Double
0.18)]
                ],
            leftPorts :: [Point Double]
leftPorts = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0 Double
0],
            rightPorts :: [Point Double]
rightPorts = [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1.5 Double
0],
            bounds :: Rect Double
bounds = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
1.5 (-Double
0.1) Double
0.25
          }
    seriesPath :: Layout
seriesPath =
      Point Double -> Layout -> Layout
moveLayout (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.15 (-Double
0.35)) (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$
        SDiagram -> Layout
layoutSDiagram (SDiagram -> SDiagram -> SDiagram
SThenD (String -> SDiagram
boxF String
"a") (String -> SDiagram
boxF String
"a*"))

--------------------------------------------------------------------------------
-- 8. Three-strand braid
--------------------------------------------------------------------------------

-- | Braid on three strands: σ1 then σ2.
knotBraid3Example :: ChartOptions
knotBraid3Example :: ChartOptions
knotBraid3Example =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    SDiagram -> Layout
layoutSDiagram (SDiagram -> Layout) -> SDiagram -> Layout
forall a b. (a -> b) -> a -> b
$
      SDiagram -> SDiagram -> SDiagram
SThenD
        (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SSwap SDiagram
SWire)
        (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SWire SDiagram
SSwap)

--------------------------------------------------------------------------------
-- 9. Closed loop: cap then cup
--------------------------------------------------------------------------------

-- | A single wire that leaves the unit, travels right, and returns to the unit.
-- In the geometric picture this is a circle.
knotCircleExample :: ChartOptions
knotCircleExample :: ChartOptions
knotCircleExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    SDiagram -> Layout
layoutSDiagram (SDiagram -> SDiagram -> SDiagram
SThenD SDiagram
SBend' SDiagram
SBend)

--------------------------------------------------------------------------------
-- 10. Trace loop around a box
--------------------------------------------------------------------------------

-- | A feedback loop with a box inside: trace of a one-wire morphism.
knotTraceExample :: ChartOptions
knotTraceExample :: ChartOptions
knotTraceExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    SDiagram -> Layout
layoutSDiagram (SDiagram -> Layout) -> SDiagram -> Layout
forall a b. (a -> b) -> a -> b
$
      SDiagram -> SDiagram -> SDiagram
SThenD
        SDiagram
SBend'
        (SDiagram -> SDiagram -> SDiagram
SThenD (SDiagram -> SDiagram -> SDiagram
SBeside (String -> SDiagram
boxF String
"f") SDiagram
SWire) SDiagram
SBend)

--------------------------------------------------------------------------------
-- 11. Tangle: swap, cap, cup
--------------------------------------------------------------------------------

-- | A small tangle: two wires cross, one bends back and forth.
knotTangleExample :: ChartOptions
knotTangleExample :: ChartOptions
knotTangleExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    SDiagram -> Layout
layoutSDiagram (SDiagram -> Layout) -> SDiagram -> Layout
forall a b. (a -> b) -> a -> b
$
      SDiagram -> SDiagram -> SDiagram
SThenD
        (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SSwap SDiagram
SBend')
        (SDiagram -> SDiagram -> SDiagram
SBeside SDiagram
SBend SDiagram
SSwap)

--------------------------------------------------------------------------------
-- 12. Copy–merge round trip
--------------------------------------------------------------------------------

-- | A copy spider followed by a merge spider: both dots visible, the two
-- fanned wires meeting port-to-port.
copyMergeExample :: ChartOptions
copyMergeExample :: ChartOptions
copyMergeExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    SDiagram -> Layout
layoutSDiagram (SDiagram -> SDiagram -> SDiagram
SThenD (Int -> Int -> SDiagram
SSpider Int
1 Int
2) (Int -> Int -> SDiagram
SSpider Int
2 Int
1))

--------------------------------------------------------------------------------
-- 13. Multi-port boxes
--------------------------------------------------------------------------------

-- | Two-port boxes chained port-to-port, tensored with a plain wire whose
-- stretch clears the box bodies.
multiPortBoxExample :: ChartOptions
multiPortBoxExample :: ChartOptions
multiPortBoxExample =
  Layout -> ChartOptions
renderLayout (Layout -> ChartOptions) -> Layout -> ChartOptions
forall a b. (a -> b) -> a -> b
$
    SDiagram -> Layout
layoutSDiagram (SDiagram -> Layout) -> SDiagram -> Layout
forall a b. (a -> b) -> a -> b
$
      SDiagram -> SDiagram -> SDiagram
SBeside
        (SDiagram -> SDiagram -> SDiagram
SThenD (String -> Int -> Int -> SDiagram
SBox String
"f" Int
2 Int
2) (String -> Int -> Int -> SDiagram
SBox String
"g" Int
2 Int
2))
        SDiagram
SWire

--------------------------------------------------------------------------------
-- gallery
--------------------------------------------------------------------------------

-- | Named example SVGs.
allExamples :: [(FilePath, ChartOptions)]
allExamples :: [(String, ChartOptions)]
allExamples =
  [ (String
"yanking-right.svg", ChartOptions
yankingRightExample),
    (String
"yanking-left.svg", ChartOptions
yankingLeftExample),
    (String
"sliding.svg", ChartOptions
slidingExample),
    (String
"trace-sliding.svg", ChartOptions
traceSlidingExample),
    (String
"braid-inverse.svg", ChartOptions
braidInverseExample),
    (String
"tensor-interchange.svg", ChartOptions
tensorInterchangeExample),
    (String
"star-arden.svg", ChartOptions
starArdenExample),
    (String
"knot-braid3.svg", ChartOptions
knotBraid3Example),
    (String
"knot-circle.svg", ChartOptions
knotCircleExample),
    (String
"knot-trace.svg", ChartOptions
knotTraceExample),
    (String
"knot-tangle.svg", ChartOptions
knotTangleExample),
    (String
"copy-merge.svg", ChartOptions
copyMergeExample),
    (String
"multi-port-box.svg", ChartOptions
multiPortBoxExample)
  ]

-- | Write every example SVG into the given directory.
writeAllExamples :: FilePath -> IO ()
writeAllExamples :: String -> IO ()
writeAllExamples String
dir = do
  Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
  ((String, ChartOptions) -> IO ())
-> [(String, ChartOptions)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(String
fp, ChartOptions
co) -> String -> ChartOptions -> IO ()
writeChartOptions (String
dir String -> String -> String
</> String
fp) ChartOptions
co) [(String, ChartOptions)]
allExamples