Cases.hs

module Bench.Cases where

-- brush-strokes
import Calligraphy.Brushes
import Math.Bezier.Spline
import Math.Bezier.Stroke
import Math.Interval
import Math.Linear
import Math.Module
import Math.Root.Isolation

-- brush-strokes bench:cusps
import Bench.Types

--------------------------------------------------------------------------------

defaultStartBoxes :: [ Int ] -> [ ( Int, [ Box 2 ] ) ]
defaultStartBoxes is =
  [ ( i, [ 𝕀ℝ2 ( 𝕀 0 1 ) ( 𝕀 0 1 ) ] ) | i <- is ]

--------------------------------------------------------------------------------

ellipseTestCase :: RootIsolationOptions N 3 -> ( Double, Double ) -> Double -> [ ( Int, [ Box 2 ] ) ] -> TestCase
ellipseTestCase opts k0k1 rot startBoxes =
  TestCase
    { testDescription = ""
    , testBrushStroke = ellipseBrushStroke k0k1 rot
    , testCuspOptions = opts
    , testStartBoxes  = startBoxes
    }

ellipseBrushStroke :: ( Double, Double ) -> Double -> BrushStroke
ellipseBrushStroke ( k0, k1 ) rot =
  BrushStroke
    { brush  = ellipseBrush
    , stroke = ( p0, LineTo ( NextPoint p1 ) () ) }
  where
    mkPt x y w h phi =
      Point
        { pointCoords = ℝ2 x y
        , pointParams = Params $ ℝ3 w h phi
        }
    l :: Double -> Double -> Double -> Double
    l k = lerp @( T Double ) k
    p k = mkPt ( l k 0 100 ) 0 ( l k 10 15 ) ( l k 25 40 ) ( l k 0 rot )
    p0 = p k0
    p1 = p k1

trickyCusp2TestCase :: TestCase
trickyCusp2TestCase =
  TestCase
    { testDescription = ""
    , testBrushStroke = trickyCusp2BrushStroke
    , testCuspOptions = defaultRootIsolationOptions
    , testStartBoxes  = defaultStartBoxes [ 0 .. 3 ]
    }

trickyCusp2BrushStroke :: BrushStroke
trickyCusp2BrushStroke =
  BrushStroke
    { brush = circleBrush
    , stroke = ( p0, Bezier3To p1 p2 ( NextPoint p3 ) () )
    }
  where
    mkPt x y =
      Point
        { pointCoords = ℝ2 x y
        , pointParams = Params $ ℝ1 5.0
        }
    p0 = mkPt 5e+1 -5e+1
    p1 = mkPt -7.72994362904069e+1 -3.124468786098509e+1
    p2 = mkPt -5.1505430313958364e+1 -3.9826386521527986e+1
    p3 = mkPt -5e+1 -5e+1

rotationTestCase :: RootIsolationOptions N 3 -> TestCase
rotationTestCase opts =
  TestCase
    { testDescription = ""
    , testBrushStroke = rotationCuspBrushStroke
    , testCuspOptions = opts
    , testStartBoxes  = defaultStartBoxes [0 .. 3 ]
    }
{-
Expecting exactly two cusps. I computed one of them with Mathematica:

  - t = 0.551437802322262119984220362508195622632
  - s = 0.4493675650062704654881343190165751812803
  - i = 2
-}

rotationCuspBrushStroke :: BrushStroke
rotationCuspBrushStroke =
  BrushStroke
    { brush  = ellipseBrush
    , stroke = ( p0, Bezier2To p1 ( NextPoint p2 ) () )
    }
  where
    mkPt x y a b phi =
      Point
        { pointCoords = ℝ2 x y
        , pointParams = Params $ ℝ3 a b phi
        }
    p0 = mkPt -100 -200 40 20 ( -pi / 4 )
    p1 = mkPt    0  100 40 20 0
    p2 = mkPt  100 -200 40 20 (  pi / 4 )

missingCusp2TestCase :: TestCase
missingCusp2TestCase =
  TestCase
    { testDescription = ""
    , testBrushStroke = missingCusp2BrushStroke
    , testCuspOptions = defaultRootIsolationOptions
    , testStartBoxes  = defaultStartBoxes [ 0 ]
    }

{-
Two cusps expected:
  - cusp 1: t = 0.32055820458595224, s = 0.3575339430663827
  - cusp 2: t = 0.527772951374112, s = 0.6271234239242184
-}
missingCusp2BrushStroke :: BrushStroke
missingCusp2BrushStroke =
  BrushStroke
    { brush = tearDropBrush
    , stroke = ( p0, Bezier3To p1 p2 ( NextPoint p3 ) () )
    }
  where
    mkPt x y =
      Point
        { pointCoords = ℝ2 x y
        , pointParams = Params $ ℝ3 18.90303454818744 7.655839954858216 2.356194490192345
        }
    p0 = mkPt -174.8456710674493   58.621320343559674
    p1 = mkPt -181.07339185171972  91.21769601156711
    p2 = mkPt -187.7254115637175   92.08897689831758
    p3 = mkPt -233.5              106.5