{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Methods.LineTypes where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.SElts


import Data.Default

import Linear.Vector ((^*))
import Linear.Matrix (M22, (!*))
import Data.Ratio

import Control.Exception (assert)


data CartDir = CD_Up | CD_Down | CD_Left | CD_Right deriving (CartDir -> CartDir -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CartDir -> CartDir -> Bool
$c/= :: CartDir -> CartDir -> Bool
== :: CartDir -> CartDir -> Bool
$c== :: CartDir -> CartDir -> Bool
Eq, forall x. Rep CartDir x -> CartDir
forall x. CartDir -> Rep CartDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CartDir x -> CartDir
$cfrom :: forall x. CartDir -> Rep CartDir x
Generic, Int -> CartDir -> ShowS
[CartDir] -> ShowS
CartDir -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CartDir] -> ShowS
$cshowList :: [CartDir] -> ShowS
show :: CartDir -> String
$cshow :: CartDir -> String
showsPrec :: Int -> CartDir -> ShowS
$cshowsPrec :: Int -> CartDir -> ShowS
Show)
instance NFData CartDir


data AnchorType = AT_End_Up | AT_End_Down | AT_End_Left | AT_End_Right | AT_Elbow_TL | AT_Elbow_TR | AT_Elbow_BR | AT_Elbow_BL | AT_Elbow_Invalid deriving (AnchorType -> AnchorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnchorType -> AnchorType -> Bool
$c/= :: AnchorType -> AnchorType -> Bool
== :: AnchorType -> AnchorType -> Bool
$c== :: AnchorType -> AnchorType -> Bool
Eq, Int -> AnchorType -> ShowS
[AnchorType] -> ShowS
AnchorType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnchorType] -> ShowS
$cshowList :: [AnchorType] -> ShowS
show :: AnchorType -> String
$cshow :: AnchorType -> String
showsPrec :: Int -> AnchorType -> ShowS
$cshowsPrec :: Int -> AnchorType -> ShowS
Show)

flipCartDir :: CartDir -> CartDir
flipCartDir :: CartDir -> CartDir
flipCartDir = \case
  CartDir
CD_Up -> CartDir
CD_Down
  CartDir
CD_Down -> CartDir
CD_Up
  CartDir
CD_Left -> CartDir
CD_Right
  CartDir
CD_Right -> CartDir
CD_Left

cartDirToUnit :: CartDir -> XY
cartDirToUnit :: CartDir -> XY
cartDirToUnit = \case
  CartDir
CD_Up -> forall a. a -> a -> V2 a
V2 Int
0 (-Int
1)
  CartDir
CD_Down -> forall a. a -> a -> V2 a
V2 Int
0 Int
1
  CartDir
CD_Left -> forall a. a -> a -> V2 a
V2 (-Int
1) Int
0
  CartDir
CD_Right -> forall a. a -> a -> V2 a
V2 Int
1 Int
0

cartDirToAnchor :: CartDir -> Maybe CartDir -> AnchorType
cartDirToAnchor :: CartDir -> Maybe CartDir -> AnchorType
cartDirToAnchor CartDir
start Maybe CartDir
mnext = case Maybe CartDir
mnext of
  Maybe CartDir
Nothing -> case CartDir
start of
    CartDir
CD_Up -> AnchorType
AT_End_Up
    CartDir
CD_Down -> AnchorType
AT_End_Down
    CartDir
CD_Left -> AnchorType
AT_End_Left
    CartDir
CD_Right -> AnchorType
AT_End_Right
  Just CartDir
next -> case CartDir
start of
    CartDir
CD_Up -> case CartDir
next of
      CartDir
CD_Left -> AnchorType
AT_Elbow_TR
      CartDir
CD_Right -> AnchorType
AT_Elbow_TL
      CartDir
_ -> AnchorType
AT_Elbow_Invalid
    CartDir
CD_Down -> case CartDir
next of
      CartDir
CD_Left -> AnchorType
AT_Elbow_BR
      CartDir
CD_Right -> AnchorType
AT_Elbow_BL
      CartDir
_ -> AnchorType
AT_Elbow_Invalid
    CartDir
CD_Left -> case CartDir
next of
      CartDir
CD_Up -> AnchorType
AT_Elbow_BL
      CartDir
CD_Down -> AnchorType
AT_Elbow_TL
      CartDir
_ -> AnchorType
AT_Elbow_Invalid
    CartDir
CD_Right -> case CartDir
next of
      CartDir
CD_Up -> AnchorType
AT_Elbow_BR
      CartDir
CD_Down -> AnchorType
AT_Elbow_TR
      CartDir
_ -> AnchorType
AT_Elbow_Invalid

cartDirWithDistanceToV2 :: (CartDir, Int, Bool) -> V2 Int
cartDirWithDistanceToV2 :: (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir
cd, Int
d, Bool
_) = CartDir -> XY
cartDirToUnit CartDir
cd forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Int
d


data LineAnchorsForRender = LineAnchorsForRender {
  LineAnchorsForRender -> XY
_lineAnchorsForRender_start :: XY
  -- `Bool` parameter is whether we are at the start of a subsegment (i.e. a midpoint or endpoint)
  , LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
} deriving (Int -> LineAnchorsForRender -> ShowS
[LineAnchorsForRender] -> ShowS
LineAnchorsForRender -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineAnchorsForRender] -> ShowS
$cshowList :: [LineAnchorsForRender] -> ShowS
show :: LineAnchorsForRender -> String
$cshow :: LineAnchorsForRender -> String
showsPrec :: Int -> LineAnchorsForRender -> ShowS
$cshowsPrec :: Int -> LineAnchorsForRender -> ShowS
Show, forall x. Rep LineAnchorsForRender x -> LineAnchorsForRender
forall x. LineAnchorsForRender -> Rep LineAnchorsForRender x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineAnchorsForRender x -> LineAnchorsForRender
$cfrom :: forall x. LineAnchorsForRender -> Rep LineAnchorsForRender x
Generic, LineAnchorsForRender -> LineAnchorsForRender -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineAnchorsForRender -> LineAnchorsForRender -> Bool
$c/= :: LineAnchorsForRender -> LineAnchorsForRender -> Bool
== :: LineAnchorsForRender -> LineAnchorsForRender -> Bool
$c== :: LineAnchorsForRender -> LineAnchorsForRender -> Bool
Eq)

instance NFData LineAnchorsForRender


instance TransformMe LineAnchorsForRender where
  transformMe_rotateLeft :: LineAnchorsForRender -> LineAnchorsForRender
transformMe_rotateLeft LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} = LineAnchorsForRender {
      _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = forall a. TransformMe a => a -> a
transformMe_rotateLeft XY
_lineAnchorsForRender_start
      ,_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CartDir
cd,Int
d,Bool
s) -> (forall a. TransformMe a => a -> a
transformMe_rotateLeft CartDir
cd, Int
d, Bool
s)) [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest
    }
  transformMe_rotateRight :: LineAnchorsForRender -> LineAnchorsForRender
transformMe_rotateRight LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} = LineAnchorsForRender {
      _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = forall a. TransformMe a => a -> a
transformMe_rotateRight XY
_lineAnchorsForRender_start
      ,_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CartDir
cd,Int
d,Bool
s) -> (forall a. TransformMe a => a -> a
transformMe_rotateRight CartDir
cd, Int
d, Bool
s)) [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest
    }
  transformMe_reflectHorizontally :: LineAnchorsForRender -> LineAnchorsForRender
transformMe_reflectHorizontally LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} = LineAnchorsForRender {
      _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = forall a. TransformMe a => a -> a
transformMe_reflectHorizontally XY
_lineAnchorsForRender_start
      ,_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CartDir
cd,Int
d,Bool
s) -> (forall a. TransformMe a => a -> a
transformMe_reflectHorizontally CartDir
cd, Int
d, Bool
s)) [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest
    }


-- NOTE our coordinate system is LEFT HANDED
--  --> +x
-- |
-- v
-- +y
matrix_cw_90 :: M22 Int
matrix_cw_90 :: M22 Int
matrix_cw_90 = forall a. a -> a -> V2 a
V2 (forall a. a -> a -> V2 a
V2 Int
0 (-Int
1)) (forall a. a -> a -> V2 a
V2 Int
1 Int
0)
matrix_ccw_90 :: M22 Int
matrix_ccw_90 :: M22 Int
matrix_ccw_90 = forall a. a -> a -> V2 a
V2 (forall a. a -> a -> V2 a
V2 Int
0 Int
1) (forall a. a -> a -> V2 a
V2 (-Int
1) Int
0)

-- TODO rename me so it include reflection
-- TODO rename so it's lower case
class TransformMe a where
  -- CCW
  transformMe_rotateLeft :: a -> a
  transformMe_rotateLeft = forall a. TransformMe a => a -> a
transformMe_rotateRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TransformMe a => a -> a
transformMe_rotateRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TransformMe a => a -> a
transformMe_rotateRight
  -- CW
  transformMe_rotateRight :: a -> a
  transformMe_rotateRight = forall a. TransformMe a => a -> a
transformMe_rotateLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TransformMe a => a -> a
transformMe_rotateLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TransformMe a => a -> a
transformMe_rotateLeft

  transformMe_reflectHorizontally :: a -> a
  transformMe_reflectHorizontally = forall a. TransformMe a => a -> a
transformMe_rotateLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TransformMe a => a -> a
transformMe_rotateLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TransformMe a => a -> a
transformMe_reflectVertically

  transformMe_reflectVertically :: a -> a
  transformMe_reflectVertically = forall a. TransformMe a => a -> a
transformMe_rotateLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TransformMe a => a -> a
transformMe_rotateLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TransformMe a => a -> a
transformMe_reflectHorizontally

instance TransformMe AttachmentLocation where
  transformMe_rotateLeft :: AttachmentLocation -> AttachmentLocation
transformMe_rotateLeft = \case
    AttachmentLocation
AL_Top -> AttachmentLocation
AL_Left
    AttachmentLocation
AL_Bot -> AttachmentLocation
AL_Right
    AttachmentLocation
AL_Left -> AttachmentLocation
AL_Bot
    AttachmentLocation
AL_Right -> AttachmentLocation
AL_Top
    AttachmentLocation
AL_Any -> AttachmentLocation
AL_Any
  transformMe_rotateRight :: AttachmentLocation -> AttachmentLocation
transformMe_rotateRight = \case
    AttachmentLocation
AL_Top -> AttachmentLocation
AL_Right
    AttachmentLocation
AL_Bot -> AttachmentLocation
AL_Left
    AttachmentLocation
AL_Left -> AttachmentLocation
AL_Top
    AttachmentLocation
AL_Right -> AttachmentLocation
AL_Bot
    AttachmentLocation
AL_Any -> AttachmentLocation
AL_Any
  transformMe_reflectHorizontally :: AttachmentLocation -> AttachmentLocation
transformMe_reflectHorizontally = \case
    AttachmentLocation
AL_Left -> AttachmentLocation
AL_Right
    AttachmentLocation
AL_Right -> AttachmentLocation
AL_Left
    AttachmentLocation
x -> AttachmentLocation
x


instance TransformMe CartDir where
  transformMe_rotateLeft :: CartDir -> CartDir
transformMe_rotateLeft = \case
    CartDir
CD_Up -> CartDir
CD_Left
    CartDir
CD_Down -> CartDir
CD_Right
    CartDir
CD_Left -> CartDir
CD_Down
    CartDir
CD_Right -> CartDir
CD_Up
  transformMe_rotateRight :: CartDir -> CartDir
transformMe_rotateRight = \case
    CartDir
CD_Up -> CartDir
CD_Right
    CartDir
CD_Down -> CartDir
CD_Left
    CartDir
CD_Left -> CartDir
CD_Up
    CartDir
CD_Right -> CartDir
CD_Down
  transformMe_reflectHorizontally :: CartDir -> CartDir
transformMe_reflectHorizontally = \case
    CartDir
CD_Right -> CartDir
CD_Left
    CartDir
CD_Left -> CartDir
CD_Right
    CartDir
x -> CartDir
x

instance TransformMe AnchorType where
  transformMe_rotateLeft :: AnchorType -> AnchorType
transformMe_rotateLeft = \case
    AnchorType
AT_End_Up -> AnchorType
AT_End_Left
    AnchorType
AT_End_Down -> AnchorType
AT_End_Right
    AnchorType
AT_End_Left -> AnchorType
AT_End_Down
    AnchorType
AT_End_Right -> AnchorType
AT_End_Up
    AnchorType
AT_Elbow_TL -> AnchorType
AT_Elbow_BL
    AnchorType
AT_Elbow_TR -> AnchorType
AT_Elbow_TL
    AnchorType
AT_Elbow_BR -> AnchorType
AT_Elbow_TR
    AnchorType
AT_Elbow_BL -> AnchorType
AT_Elbow_BR
    AnchorType
AT_Elbow_Invalid -> AnchorType
AT_Elbow_Invalid
  transformMe_rotateRight :: AnchorType -> AnchorType
transformMe_rotateRight = \case
    AnchorType
AT_End_Up -> AnchorType
AT_End_Right
    AnchorType
AT_End_Down -> AnchorType
AT_End_Left
    AnchorType
AT_End_Left -> AnchorType
AT_End_Up
    AnchorType
AT_End_Right -> AnchorType
AT_End_Down
    AnchorType
AT_Elbow_TL -> AnchorType
AT_Elbow_TR
    AnchorType
AT_Elbow_TR -> AnchorType
AT_Elbow_BR
    AnchorType
AT_Elbow_BR -> AnchorType
AT_Elbow_BL
    AnchorType
AT_Elbow_BL -> AnchorType
AT_Elbow_TL
    AnchorType
AT_Elbow_Invalid -> AnchorType
AT_Elbow_Invalid
  transformMe_reflectHorizontally :: AnchorType -> AnchorType
transformMe_reflectHorizontally = \case
    AnchorType
AT_End_Left -> AnchorType
AT_End_Right
    AnchorType
AT_End_Right -> AnchorType
AT_End_Left
    AnchorType
AT_Elbow_TL -> AnchorType
AT_Elbow_TR
    AnchorType
AT_Elbow_TR -> AnchorType
AT_Elbow_TL
    AnchorType
AT_Elbow_BR -> AnchorType
AT_Elbow_BL
    AnchorType
AT_Elbow_BL -> AnchorType
AT_Elbow_BR
    AnchorType
AT_Elbow_Invalid -> AnchorType
AT_Elbow_Invalid

instance TransformMe XY where
  transformMe_rotateLeft :: XY -> XY
transformMe_rotateLeft XY
p = forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
(!*) M22 Int
matrix_ccw_90 XY
p forall a. Num a => a -> a -> a
- (forall a. a -> a -> V2 a
V2 Int
0 Int
1)
  transformMe_rotateRight :: XY -> XY
transformMe_rotateRight XY
p = forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
(!*) M22 Int
matrix_cw_90 XY
p forall a. Num a => a -> a -> a
- (forall a. a -> a -> V2 a
V2 Int
1 Int
0)
  transformMe_reflectHorizontally :: XY -> XY
transformMe_reflectHorizontally (V2 Int
x Int
y) = forall a. a -> a -> V2 a
V2 (-(Int
xforall a. Num a => a -> a -> a
+Int
1)) Int
y

instance (TransformMe a, TransformMe b) => TransformMe (a,b) where
  transformMe_rotateLeft :: (a, b) -> (a, b)
transformMe_rotateLeft (a
a,b
b) = (forall a. TransformMe a => a -> a
transformMe_rotateLeft a
a, forall a. TransformMe a => a -> a
transformMe_rotateLeft b
b)
  transformMe_rotateRight :: (a, b) -> (a, b)
transformMe_rotateRight (a
a,b
b) = (forall a. TransformMe a => a -> a
transformMe_rotateRight a
a, forall a. TransformMe a => a -> a
transformMe_rotateRight b
b)
  transformMe_reflectHorizontally :: (a, b) -> (a, b)
transformMe_reflectHorizontally (a
a,b
b) = (forall a. TransformMe a => a -> a
transformMe_reflectHorizontally a
a, forall a. TransformMe a => a -> a
transformMe_reflectHorizontally b
b)

instance (TransformMe a, TransformMe b, TransformMe c) => TransformMe (a,b,c) where
  transformMe_rotateLeft :: (a, b, c) -> (a, b, c)
transformMe_rotateLeft (a
a,b
b,c
c) = (forall a. TransformMe a => a -> a
transformMe_rotateLeft a
a, forall a. TransformMe a => a -> a
transformMe_rotateLeft b
b, forall a. TransformMe a => a -> a
transformMe_rotateLeft c
c)
  transformMe_rotateRight :: (a, b, c) -> (a, b, c)
transformMe_rotateRight (a
a,b
b,c
c) = (forall a. TransformMe a => a -> a
transformMe_rotateRight a
a, forall a. TransformMe a => a -> a
transformMe_rotateRight b
b, forall a. TransformMe a => a -> a
transformMe_rotateRight c
c)
  transformMe_reflectHorizontally :: (a, b, c) -> (a, b, c)
transformMe_reflectHorizontally (a
a,b
b,c
c) = (forall a. TransformMe a => a -> a
transformMe_reflectHorizontally a
a, forall a. TransformMe a => a -> a
transformMe_reflectHorizontally b
b, forall a. TransformMe a => a -> a
transformMe_reflectHorizontally c
c)


-- NOTE assumes LBox is Canonical
instance TransformMe LBox where
  transformMe_rotateLeft :: LBox -> LBox
transformMe_rotateLeft lbox :: LBox
lbox@(LBox XY
tl (V2 Int
w Int
h)) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (LBox -> Bool
lBox_isCanonicalLBox LBox
lbox) LBox
r where
    V2 Int
blx Int
bly = forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
(!*) M22 Int
matrix_ccw_90 XY
tl
    r :: LBox
r = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
blx (Int
bly forall a. Num a => a -> a -> a
- Int
w)) (forall a. a -> a -> V2 a
V2 Int
h Int
w)
  transformMe_rotateRight :: LBox -> LBox
transformMe_rotateRight lbox :: LBox
lbox@(LBox XY
tl (V2 Int
w Int
h)) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (LBox -> Bool
lBox_isCanonicalLBox LBox
lbox) LBox
r where
    V2 Int
trx Int
try = forall (m :: * -> *) (r :: * -> *) a.
(Functor m, Foldable r, Additive r, Num a) =>
m (r a) -> r a -> m a
(!*) M22 Int
matrix_cw_90 XY
tl
    r :: LBox
r = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 (Int
trxforall a. Num a => a -> a -> a
-Int
h) Int
try) (forall a. a -> a -> V2 a
V2 Int
h Int
w)
  transformMe_reflectHorizontally :: LBox -> LBox
transformMe_reflectHorizontally lbox :: LBox
lbox@(LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (LBox -> Bool
lBox_isCanonicalLBox LBox
lbox) LBox
r where
    r :: LBox
r = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 (-(Int
xforall a. Num a => a -> a -> a
+Int
w)) Int
y) (forall a. a -> a -> V2 a
V2 Int
w Int
h)



-- very specific to the way AttachmentOffsetRatio is associated with a certain side of a box
instance TransformMe AttachmentOffsetRatio where
  transformMe_rotateLeft :: AttachmentOffsetRatio -> AttachmentOffsetRatio
transformMe_rotateLeft = forall a. a -> a
id
  transformMe_rotateRight :: AttachmentOffsetRatio -> AttachmentOffsetRatio
transformMe_rotateRight = forall a. a -> a
id
  transformMe_reflectHorizontally :: AttachmentOffsetRatio -> AttachmentOffsetRatio
transformMe_reflectHorizontally AttachmentOffsetRatio
r = (Int
dforall a. Num a => a -> a -> a
-Int
n) forall a. Integral a => a -> a -> Ratio a
% Int
d where
    n :: Int
n = forall a. Ratio a -> a
numerator AttachmentOffsetRatio
r
    d :: Int
d = forall a. Ratio a -> a
denominator AttachmentOffsetRatio
r


-- TODO UTs for CartRotationReflection stuff
-- apply rotation first, then apply reflections
data CartRotationReflection = CartRotationReflection {
  CartRotationReflection -> Int
_cartRotationReflection_rotateLeftTimes :: Int -- number of times we rotated left
  , CartRotationReflection -> Bool
_cartRotationReflection_reflectVertical :: Bool -- did we reflect accross vertical axis
}

instance TransformMe CartRotationReflection where
  transformMe_rotateLeft :: CartRotationReflection -> CartRotationReflection
transformMe_rotateLeft x :: CartRotationReflection
x@CartRotationReflection {Bool
Int
_cartRotationReflection_reflectVertical :: Bool
_cartRotationReflection_rotateLeftTimes :: Int
_cartRotationReflection_reflectVertical :: CartRotationReflection -> Bool
_cartRotationReflection_rotateLeftTimes :: CartRotationReflection -> Int
..} = if Bool
_cartRotationReflection_reflectVertical
    then CartRotationReflection
x { _cartRotationReflection_rotateLeftTimes :: Int
_cartRotationReflection_rotateLeftTimes = (Int
_cartRotationReflection_rotateLeftTimes forall a. Num a => a -> a -> a
+ Int
3) forall a. Integral a => a -> a -> a
`mod` Int
4 }
    else CartRotationReflection
x { _cartRotationReflection_rotateLeftTimes :: Int
_cartRotationReflection_rotateLeftTimes = (Int
_cartRotationReflection_rotateLeftTimes forall a. Num a => a -> a -> a
+ Int
1) forall a. Integral a => a -> a -> a
`mod` Int
4 }
  transformMe_reflectHorizontally :: CartRotationReflection -> CartRotationReflection
transformMe_reflectHorizontally x :: CartRotationReflection
x@CartRotationReflection {Bool
Int
_cartRotationReflection_reflectVertical :: Bool
_cartRotationReflection_rotateLeftTimes :: Int
_cartRotationReflection_reflectVertical :: CartRotationReflection -> Bool
_cartRotationReflection_rotateLeftTimes :: CartRotationReflection -> Int
..} = CartRotationReflection
x { _cartRotationReflection_reflectVertical :: Bool
_cartRotationReflection_reflectVertical = Bool -> Bool
not Bool
_cartRotationReflection_reflectVertical }

cartRotationReflection_identity :: CartRotationReflection
cartRotationReflection_identity :: CartRotationReflection
cartRotationReflection_identity = CartRotationReflection {
    _cartRotationReflection_rotateLeftTimes :: Int
_cartRotationReflection_rotateLeftTimes = Int
0
    , _cartRotationReflection_reflectVertical :: Bool
_cartRotationReflection_reflectVertical = Bool
False
  }
cartRotationReflection_invert :: CartRotationReflection -> CartRotationReflection
cartRotationReflection_invert :: CartRotationReflection -> CartRotationReflection
cartRotationReflection_invert x :: CartRotationReflection
x@CartRotationReflection {Bool
Int
_cartRotationReflection_reflectVertical :: Bool
_cartRotationReflection_rotateLeftTimes :: Int
_cartRotationReflection_reflectVertical :: CartRotationReflection -> Bool
_cartRotationReflection_rotateLeftTimes :: CartRotationReflection -> Int
..} = if Bool
_cartRotationReflection_reflectVertical
  then CartRotationReflection
x
  else CartRotationReflection
x { _cartRotationReflection_rotateLeftTimes :: Int
_cartRotationReflection_rotateLeftTimes = (Int
_cartRotationReflection_rotateLeftTimes forall a. Num a => a -> a -> a
+ Int
3) forall a. Integral a => a -> a -> a
`mod` Int
4 }

cartRotationReflection_invert_apply :: (TransformMe a) => CartRotationReflection -> a -> a
cartRotationReflection_invert_apply :: forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_invert_apply CartRotationReflection
crr a
a = forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_apply (CartRotationReflection -> CartRotationReflection
cartRotationReflection_invert CartRotationReflection
crr) a
a

-- | Apply a function @n@ times to a given value.
nTimes :: Int -> (a -> a) -> (a -> a)
nTimes :: forall a. Int -> (a -> a) -> a -> a
nTimes Int
0 a -> a
_ = forall a. a -> a
id
nTimes Int
1 a -> a
f = a -> a
f
nTimes Int
n a -> a
f = a -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> (a -> a) -> a -> a
nTimes (Int
nforall a. Num a => a -> a -> a
-Int
1) a -> a
f

cartRotationReflection_apply :: (TransformMe a) => CartRotationReflection -> a -> a
cartRotationReflection_apply :: forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_apply CartRotationReflection {Bool
Int
_cartRotationReflection_reflectVertical :: Bool
_cartRotationReflection_rotateLeftTimes :: Int
_cartRotationReflection_reflectVertical :: CartRotationReflection -> Bool
_cartRotationReflection_rotateLeftTimes :: CartRotationReflection -> Int
..} a
a = a
r where
  nrl :: Int
nrl = Int
_cartRotationReflection_rotateLeftTimes forall a. Integral a => a -> a -> a
`mod` Int
4
  r' :: a
r' = forall a. Int -> (a -> a) -> a -> a
nTimes Int
nrl forall a. TransformMe a => a -> a
transformMe_rotateLeft a
a
  r :: a
r = if Bool
_cartRotationReflection_reflectVertical then forall a. TransformMe a => a -> a
transformMe_reflectVertically a
a else a
a