{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Attachments (
  AvailableAttachment
  , BoxWithAttachmentLocation
  , attachLocationFromLBox_conjugateCartRotationReflection
  , attachLocationFromLBox
  , availableAttachLocationsFromLBox
  , owlItem_availableAttachments
  , owlItem_availableAttachmentsAtDefaultLocation
  , isOverAttachment
  , projectAttachment
  , attachmentRenderChar

) where

import           Relude

import           Potato.Flow.Math
import           Potato.Flow.OwlItem
import Potato.Flow.Owl
import Potato.Flow.SElts
import Potato.Flow.Methods.LineTypes

import Data.List (minimumBy)
import Data.Ratio
import Data.Tuple.Extra
import Control.Exception (assert)


data CartSegment = CartSegment {
    CartSegment -> Bool
_cartSegment_isVertical :: Bool
    , CartSegment -> Int
_cartSegment_common :: Int
    , CartSegment -> Int
_cartSegment_leftOrTop :: Int
    , CartSegment -> Int
_cartSegment_rightOrBot :: Int
  } deriving (CartSegment -> CartSegment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CartSegment -> CartSegment -> Bool
$c/= :: CartSegment -> CartSegment -> Bool
== :: CartSegment -> CartSegment -> Bool
$c== :: CartSegment -> CartSegment -> Bool
Eq, Int -> CartSegment -> ShowS
[CartSegment] -> ShowS
CartSegment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CartSegment] -> ShowS
$cshowList :: [CartSegment] -> ShowS
show :: CartSegment -> String
$cshow :: CartSegment -> String
showsPrec :: Int -> CartSegment -> ShowS
$cshowsPrec :: Int -> CartSegment -> ShowS
Show)
-- represents possible place to attach
data AvailableAttachment = AvailableAttachment_CartSegment CartSegment AttachmentLocation deriving (Int -> AvailableAttachment -> ShowS
[AvailableAttachment] -> ShowS
AvailableAttachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AvailableAttachment] -> ShowS
$cshowList :: [AvailableAttachment] -> ShowS
show :: AvailableAttachment -> String
$cshow :: AvailableAttachment -> String
showsPrec :: Int -> AvailableAttachment -> ShowS
$cshowsPrec :: Int -> AvailableAttachment -> ShowS
Show, AvailableAttachment -> AvailableAttachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AvailableAttachment -> AvailableAttachment -> Bool
$c/= :: AvailableAttachment -> AvailableAttachment -> Bool
== :: AvailableAttachment -> AvailableAttachment -> Bool
$c== :: AvailableAttachment -> AvailableAttachment -> Bool
Eq)

type BoxWithAttachmentLocation = (LBox, AttachmentLocation, AttachmentOffsetRatio)

-- uh not sure if this is actually conjugation...
attachLocationFromLBox_conjugateCartRotationReflection :: CartRotationReflection -> Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox_conjugateCartRotationReflection :: CartRotationReflection -> Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox_conjugateCartRotationReflection CartRotationReflection
crr Bool
offsetBorder (LBox
box, AttachmentLocation
al, AttachmentOffsetRatio
af) = XY
r where
  r' :: XY
r' = Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox Bool
offsetBorder (forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_invert_apply CartRotationReflection
crr LBox
box, forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_invert_apply CartRotationReflection
crr AttachmentLocation
al, forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_invert_apply CartRotationReflection
crr AttachmentOffsetRatio
af)
  r :: XY
r = forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_apply CartRotationReflection
crr XY
r'

-- NOTE assumes LBox is canonical
attachLocationFromLBox :: Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox :: Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox Bool
True (LBox
lbx, AttachmentLocation
al, AttachmentOffsetRatio
af) = Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox Bool
False (LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand LBox
lbx (Int
1,Int
1,Int
1,Int
1), AttachmentLocation
al, AttachmentOffsetRatio
af)
attachLocationFromLBox Bool
offset (LBox (V2 Int
x Int
y) (V2 Int
w Int
h), AttachmentLocation
al, AttachmentOffsetRatio
af) = case AttachmentLocation
al of
  AttachmentLocation
AL_Top -> forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
+Int
w forall a. Num a => a -> a -> a
* Int
n forall a. Integral a => a -> a -> a
`div` Int
d) Int
y
  AttachmentLocation
AL_Bot -> forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
+(Int
wforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
* Int
dn forall a. Integral a => a -> a -> a
`div` Int
d) (Int
yforall a. Num a => a -> a -> a
+Int
hforall a. Num a => a -> a -> a
-Int
1)
  AttachmentLocation
AL_Left -> forall a. a -> a -> V2 a
V2 Int
x (Int
yforall a. Num a => a -> a -> a
+(Int
hforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
* Int
dn forall a. Integral a => a -> a -> a
`div` Int
d )
  AttachmentLocation
AL_Right -> forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
+Int
wforall a. Num a => a -> a -> a
-Int
1) (Int
yforall a. Num a => a -> a -> a
+Int
h forall a. Num a => a -> a -> a
* Int
n forall a. Integral a => a -> a -> a
`div` Int
d )
  -- or maybe in the middle is better?
  AttachmentLocation
AL_Any -> forall a. a -> a -> V2 a
V2 Int
x Int
y
  where
    n :: Int
n = forall a. Ratio a -> a
numerator AttachmentOffsetRatio
af
    d :: Int
d = forall a. Ratio a -> a
denominator AttachmentOffsetRatio
af
    dn :: Int
dn = Int
dforall a. Num a => a -> a -> a
-Int
n


defaultAttachLocationsFromLBox :: Bool -> LBox -> [(AttachmentLocation, XY)]
defaultAttachLocationsFromLBox :: Bool -> LBox -> [(AttachmentLocation, XY)]
defaultAttachLocationsFromLBox Bool
offsetBorder LBox
lbx = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AttachmentLocation
a -> (AttachmentLocation
a, Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox Bool
offsetBorder (LBox
lbx, AttachmentLocation
a, AttachmentOffsetRatio
attachment_offset_rel_default))) [AttachmentLocation
AL_Top, AttachmentLocation
AL_Bot, AttachmentLocation
AL_Left, AttachmentLocation
AL_Right]

-- NOTE assumes LBox is canonical
availableAttachLocationFromLBox :: Bool -> (LBox, AttachmentLocation) -> AvailableAttachment
availableAttachLocationFromLBox :: Bool -> (LBox, AttachmentLocation) -> AvailableAttachment
availableAttachLocationFromLBox Bool
offset (LBox (V2 Int
x Int
y) (V2 Int
w Int
h), AttachmentLocation
al)
  | Bool
offset = forall a b c. (a -> b -> c) -> b -> a -> c
flip CartSegment -> AttachmentLocation -> AvailableAttachment
AvailableAttachment_CartSegment AttachmentLocation
al forall a b. (a -> b) -> a -> b
$ case AttachmentLocation
al of
    AttachmentLocation
AL_Top -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False (Int
yforall a. Num a => a -> a -> a
-Int
1) Int
x (Int
xforall a. Num a => a -> a -> a
+Int
w)
    AttachmentLocation
AL_Bot -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False (Int
yforall a. Num a => a -> a -> a
+Int
h) Int
x (Int
xforall a. Num a => a -> a -> a
+Int
w)
    AttachmentLocation
AL_Left -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
True (Int
xforall a. Num a => a -> a -> a
-Int
1) Int
y (Int
yforall a. Num a => a -> a -> a
+Int
h)
    AttachmentLocation
AL_Right -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
True (Int
xforall a. Num a => a -> a -> a
+Int
w) Int
y (Int
yforall a. Num a => a -> a -> a
+Int
h)
    AttachmentLocation
AL_Any -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False Int
x Int
y Int
y
  | Bool
otherwise = forall a b c. (a -> b -> c) -> b -> a -> c
flip CartSegment -> AttachmentLocation -> AvailableAttachment
AvailableAttachment_CartSegment AttachmentLocation
al forall a b. (a -> b) -> a -> b
$ case AttachmentLocation
al of
    AttachmentLocation
AL_Top -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False Int
y Int
x (Int
xforall a. Num a => a -> a -> a
+Int
w)
    AttachmentLocation
AL_Bot -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False (Int
yforall a. Num a => a -> a -> a
+Int
hforall a. Num a => a -> a -> a
-Int
1) Int
x (Int
xforall a. Num a => a -> a -> a
+Int
w)
    AttachmentLocation
AL_Left -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
True Int
x Int
y (Int
yforall a. Num a => a -> a -> a
+Int
h)
    AttachmentLocation
AL_Right -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
True (Int
xforall a. Num a => a -> a -> a
+Int
wforall a. Num a => a -> a -> a
-Int
1) Int
y (Int
yforall a. Num a => a -> a -> a
+Int
h)
    AttachmentLocation
AL_Any -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False Int
x Int
y Int
y

availableAttachLocationsFromLBox :: Bool -> LBox -> [AvailableAttachment]
availableAttachLocationsFromLBox :: Bool -> LBox -> [AvailableAttachment]
availableAttachLocationsFromLBox Bool
offsetBorder LBox
lbx = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AttachmentLocation
a -> (Bool -> (LBox, AttachmentLocation) -> AvailableAttachment
availableAttachLocationFromLBox Bool
offsetBorder (LBox
lbx, AttachmentLocation
a))) [AttachmentLocation
AL_Top, AttachmentLocation
AL_Bot, AttachmentLocation
AL_Left, AttachmentLocation
AL_Right]

owlItem_availableAttachmentsAtDefaultLocation :: Bool -> Bool -> OwlItem -> [(AttachmentLocation, XY)]
owlItem_availableAttachmentsAtDefaultLocation :: Bool -> Bool -> OwlItem -> [(AttachmentLocation, XY)]
owlItem_availableAttachmentsAtDefaultLocation Bool
includeNoBorder Bool
offsetBorder OwlItem
o = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
o of
  OwlSubItemBox SBox
sbox | Bool -> Bool
not Bool
includeNoBorder Bool -> Bool -> Bool
&& Bool -> Bool
not (SBoxType -> Bool
sBoxType_hasBorder (SBox -> SBoxType
_sBox_boxType SBox
sbox)) -> []
  OwlSubItemBox SBox
sbox -> Bool -> LBox -> [(AttachmentLocation, XY)]
defaultAttachLocationsFromLBox Bool
offsetBorder (SBox -> LBox
_sBox_box SBox
sbox)
  OwlSubItem
_ -> []

owlItem_availableAttachments :: Bool -> Bool -> OwlItem -> [AvailableAttachment]
owlItem_availableAttachments :: Bool -> Bool -> OwlItem -> [AvailableAttachment]
owlItem_availableAttachments Bool
includeNoBorder Bool
offsetBorder OwlItem
o = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
o of
  OwlSubItemBox SBox
sbox | Bool -> Bool
not Bool
includeNoBorder Bool -> Bool -> Bool
&& Bool -> Bool
not (SBoxType -> Bool
sBoxType_hasBorder (SBox -> SBoxType
_sBox_boxType SBox
sbox)) -> []
  OwlSubItemBox SBox
sbox -> Bool -> LBox -> [AvailableAttachment]
availableAttachLocationsFromLBox Bool
offsetBorder (SBox -> LBox
_sBox_box SBox
sbox)
  OwlSubItem
_ -> []

isOverAttachment :: XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)
isOverAttachment :: XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)
isOverAttachment XY
pos [(Attachment, XY)]
attachments = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Attachment
a,XY
x) -> XY
x forall a. Eq a => a -> a -> Bool
== XY
pos) [(Attachment, XY)]
attachments


projectAttachment :: AttachmentLocation -> XY -> REltId -> LBox -> Maybe (Attachment, XY)
projectAttachment :: AttachmentLocation -> XY -> Int -> LBox -> Maybe (Attachment, XY)
projectAttachment AttachmentLocation
preval (V2 Int
x Int
y) Int
rid LBox
lbox = Maybe (Attachment, XY)
r where
  als :: [AvailableAttachment]
als = Bool -> LBox -> [AvailableAttachment]
availableAttachLocationsFromLBox Bool
False LBox
lbox

  -- returns (projection distance, (projection ratio, projection position)
  projdfn :: AvailableAttachment -> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
  projdfn :: AvailableAttachment
-> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
projdfn aa :: AvailableAttachment
aa@(AvailableAttachment_CartSegment (CartSegment {Bool
Int
_cartSegment_rightOrBot :: Int
_cartSegment_leftOrTop :: Int
_cartSegment_common :: Int
_cartSegment_isVertical :: Bool
_cartSegment_rightOrBot :: CartSegment -> Int
_cartSegment_leftOrTop :: CartSegment -> Int
_cartSegment_common :: CartSegment -> Int
_cartSegment_isVertical :: CartSegment -> Bool
..}) AttachmentLocation
al) = (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
r2 where
    projcomp :: Int
projcomp = if Bool
_cartSegment_isVertical then Int
x else Int
y
    (Int
orthd, Int
orthcomp) = (forall a. Num a => a -> a
abs (Int
projcomp forall a. Num a => a -> a -> a
- Int
_cartSegment_common), Int
_cartSegment_common)
    slidecomp :: Int
slidecomp = if Bool
_cartSegment_isVertical then Int
y else Int
x
    (Int
parad, Int
paracomp) = if Int
slidecomp forall a. Ord a => a -> a -> Bool
< Int
_cartSegment_leftOrTop
      then (Int
_cartSegment_leftOrTop forall a. Num a => a -> a -> a
- Int
slidecomp, Int
_cartSegment_leftOrTop)
      else if Int
slidecomp forall a. Ord a => a -> a -> Bool
> Int
_cartSegment_rightOrBot
        then (Int
slidecomp forall a. Num a => a -> a -> a
- Int
_cartSegment_rightOrBot, Int
_cartSegment_rightOrBot)
        else (Int
0, Int
slidecomp)

    pos :: XY
pos@(V2 Int
px Int
py) = if Bool
_cartSegment_isVertical then forall a. a -> a -> V2 a
V2 Int
orthcomp Int
paracomp else forall a. a -> a -> V2 a
V2 Int
paracomp Int
orthcomp
    segl :: Int
segl = Int
_cartSegment_rightOrBot forall a. Num a => a -> a -> a
- Int
_cartSegment_leftOrTop
    ratio :: AttachmentOffsetRatio
ratio = case AttachmentLocation
al of
      AttachmentLocation
AL_Top -> (Int
px forall a. Num a => a -> a -> a
- Int
_cartSegment_leftOrTop) forall a. Integral a => a -> a -> Ratio a
% Int
segl
      AttachmentLocation
AL_Bot -> (Int
_cartSegment_rightOrBot forall a. Num a => a -> a -> a
- Int
px) forall a. Integral a => a -> a -> Ratio a
% Int
segl
      AttachmentLocation
AL_Left -> (Int
_cartSegment_rightOrBot forall a. Num a => a -> a -> a
- Int
py) forall a. Integral a => a -> a -> Ratio a
% Int
segl
      AttachmentLocation
AL_Right -> (Int
py forall a. Num a => a -> a -> a
- Int
_cartSegment_leftOrTop) forall a. Integral a => a -> a -> Ratio a
% Int
segl
      AttachmentLocation
AL_Any -> forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"unexpected"

    r2 :: (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
r2 = (Int
paradforall a. Num a => a -> a -> a
+Int
orthd, (AttachmentOffsetRatio
ratio, XY
pos), AvailableAttachment
aa)

  rslts :: [(Int, (AttachmentOffsetRatio, XY), AvailableAttachment)]
rslts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AvailableAttachment
-> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
projdfn [AvailableAttachment]
als
  cmpfn :: (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
-> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
-> Ordering
cmpfn (Int
d1, (AttachmentOffsetRatio, XY)
_, AvailableAttachment_CartSegment CartSegment
_ AttachmentLocation
al1) (Int
d2, (AttachmentOffsetRatio, XY)
_, AvailableAttachment_CartSegment CartSegment
_ AttachmentLocation
al2) = forall a. Ord a => a -> a -> Ordering
compare Int
d1 Int
d2 forall a. Semigroup a => a -> a -> a
<> forall a. Ord a => a -> a -> Ordering
compare (AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
preval) (AttachmentLocation
al1 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
preval)
  (Int
d, (AttachmentOffsetRatio
ratio, XY
pos), AvailableAttachment_CartSegment CartSegment
_ AttachmentLocation
al) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
-> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
-> Ordering
cmpfn [(Int, (AttachmentOffsetRatio, XY), AvailableAttachment)]
rslts

  attachment :: Attachment
attachment = Attachment {
      _attachment_target :: Int
_attachment_target = Int
rid
      , _attachment_location :: AttachmentLocation
_attachment_location = AttachmentLocation
al
      , _attachment_offset_rel :: AttachmentOffsetRatio
_attachment_offset_rel = AttachmentOffsetRatio
ratio
    }

  r :: Maybe (Attachment, XY)
r = if Int
d forall a. Ord a => a -> a -> Bool
> Int
2
    then forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Attachment
attachment, XY
pos)



attachmentRenderChar :: Attachment -> PChar
attachmentRenderChar :: Attachment -> PChar
attachmentRenderChar Attachment
att = case Attachment -> AttachmentLocation
_attachment_location Attachment
att of
  AttachmentLocation
AL_Top -> PChar
'⇈'
  AttachmentLocation
AL_Bot -> PChar
'⇊'
  AttachmentLocation
AL_Left -> PChar
'⇇'
  AttachmentLocation
AL_Right -> PChar
'⇉'
  AttachmentLocation
AL_Any -> PChar
' ' -- should never be rendered