LineTypes.hs

{-# 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 (Eq, Generic, 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 (Eq, Show)

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

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

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

cartDirWithDistanceToV2 :: (CartDir, Int, Bool) -> V2 Int
cartDirWithDistanceToV2 (cd, d, _) = cartDirToUnit cd ^* d


data LineAnchorsForRender = LineAnchorsForRender {
  _lineAnchorsForRender_start :: XY
  -- `Bool` parameter is whether we are at the start of a subsegment (i.e. a midpoint or endpoint)
  , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
} deriving (Show, Generic, Eq)

instance NFData LineAnchorsForRender


instance TransformMe LineAnchorsForRender where
  transformMe_rotateLeft LineAnchorsForRender {..} = LineAnchorsForRender {
      _lineAnchorsForRender_start = transformMe_rotateLeft _lineAnchorsForRender_start
      ,_lineAnchorsForRender_rest = fmap (\(cd,d,s) -> (transformMe_rotateLeft cd, d, s)) _lineAnchorsForRender_rest
    }
  transformMe_rotateRight LineAnchorsForRender {..} = LineAnchorsForRender {
      _lineAnchorsForRender_start = transformMe_rotateRight _lineAnchorsForRender_start
      ,_lineAnchorsForRender_rest = fmap (\(cd,d,s) -> (transformMe_rotateRight cd, d, s)) _lineAnchorsForRender_rest
    }
  transformMe_reflectHorizontally LineAnchorsForRender {..} = LineAnchorsForRender {
      _lineAnchorsForRender_start = transformMe_reflectHorizontally _lineAnchorsForRender_start
      ,_lineAnchorsForRender_rest = fmap (\(cd,d,s) -> (transformMe_reflectHorizontally cd, d, s)) _lineAnchorsForRender_rest
    }


-- NOTE our coordinate system is LEFT HANDED
--  --> +x
-- |
-- v
-- +y
matrix_cw_90 :: M22 Int
matrix_cw_90 = V2 (V2 0 (-1)) (V2 1 0)
matrix_ccw_90 :: M22 Int
matrix_ccw_90 = V2 (V2 0 1) (V2 (-1) 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 = transformMe_rotateRight . transformMe_rotateRight . transformMe_rotateRight
  -- CW
  transformMe_rotateRight :: a -> a
  transformMe_rotateRight = transformMe_rotateLeft . transformMe_rotateLeft . transformMe_rotateLeft

  transformMe_reflectHorizontally :: a -> a
  transformMe_reflectHorizontally = transformMe_rotateLeft . transformMe_rotateLeft . transformMe_reflectVertically

  transformMe_reflectVertically :: a -> a
  transformMe_reflectVertically = transformMe_rotateLeft . transformMe_rotateLeft . transformMe_reflectHorizontally

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


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

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

instance TransformMe XY where
  transformMe_rotateLeft p = (!*) matrix_ccw_90 p - (V2 0 1)
  transformMe_rotateRight p = (!*) matrix_cw_90 p - (V2 1 0)
  transformMe_reflectHorizontally (V2 x y) = V2 (-(x+1)) y

instance (TransformMe a, TransformMe b) => TransformMe (a,b) where
  transformMe_rotateLeft (a,b) = (transformMe_rotateLeft a, transformMe_rotateLeft b)
  transformMe_rotateRight (a,b) = (transformMe_rotateRight a, transformMe_rotateRight b)
  transformMe_reflectHorizontally (a,b) = (transformMe_reflectHorizontally a, transformMe_reflectHorizontally b)

instance (TransformMe a, TransformMe b, TransformMe c) => TransformMe (a,b,c) where
  transformMe_rotateLeft (a,b,c) = (transformMe_rotateLeft a, transformMe_rotateLeft b, transformMe_rotateLeft c)
  transformMe_rotateRight (a,b,c) = (transformMe_rotateRight a, transformMe_rotateRight b, transformMe_rotateRight c)
  transformMe_reflectHorizontally (a,b,c) = (transformMe_reflectHorizontally a, transformMe_reflectHorizontally b, transformMe_reflectHorizontally c)


-- NOTE assumes LBox is Canonical
instance TransformMe LBox where
  transformMe_rotateLeft lbox@(LBox tl (V2 w h)) = assert (lBox_isCanonicalLBox lbox) r where
    V2 blx bly = (!*) matrix_ccw_90 tl
    r = LBox (V2 blx (bly - w)) (V2 h w)
  transformMe_rotateRight lbox@(LBox tl (V2 w h)) = assert (lBox_isCanonicalLBox lbox) r where
    V2 trx try = (!*) matrix_cw_90 tl
    r = LBox (V2 (trx-h) try) (V2 h w)
  transformMe_reflectHorizontally lbox@(LBox (V2 x y) (V2 w h)) = assert (lBox_isCanonicalLBox lbox) r where
    r = LBox (V2 (-(x+w)) y) (V2 w h)



-- very specific to the way AttachmentOffsetRatio is associated with a certain side of a box
instance TransformMe AttachmentOffsetRatio where
  transformMe_rotateLeft = id
  transformMe_rotateRight = id
  transformMe_reflectHorizontally r = (d-n) % d where
    n = numerator r
    d = denominator r


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

instance TransformMe CartRotationReflection where
  transformMe_rotateLeft x@CartRotationReflection {..} = if _cartRotationReflection_reflectVertical
    then x { _cartRotationReflection_rotateLeftTimes = (_cartRotationReflection_rotateLeftTimes + 3) `mod` 4 }
    else x { _cartRotationReflection_rotateLeftTimes = (_cartRotationReflection_rotateLeftTimes + 1) `mod` 4 }
  transformMe_reflectHorizontally x@CartRotationReflection {..} = x { _cartRotationReflection_reflectVertical = not _cartRotationReflection_reflectVertical }

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

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

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

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