{-# 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.Serialization.Snake
import Potato.Flow.Methods.LineTypes

import Data.List (minimumBy)
import Data.Ratio
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
(CartSegment -> CartSegment -> Bool)
-> (CartSegment -> CartSegment -> Bool) -> Eq CartSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CartSegment -> CartSegment -> Bool
== :: CartSegment -> CartSegment -> Bool
$c/= :: CartSegment -> CartSegment -> Bool
/= :: CartSegment -> CartSegment -> Bool
Eq, Int -> CartSegment -> ShowS
[CartSegment] -> ShowS
CartSegment -> String
(Int -> CartSegment -> ShowS)
-> (CartSegment -> String)
-> ([CartSegment] -> ShowS)
-> Show CartSegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CartSegment -> ShowS
showsPrec :: Int -> CartSegment -> ShowS
$cshow :: CartSegment -> String
show :: CartSegment -> String
$cshowList :: [CartSegment] -> ShowS
showList :: [CartSegment] -> ShowS
Show)
-- represents possible place to attach
data AvailableAttachment = AvailableAttachment_CartSegment CartSegment AttachmentLocation deriving (Int -> AvailableAttachment -> ShowS
[AvailableAttachment] -> ShowS
AvailableAttachment -> String
(Int -> AvailableAttachment -> ShowS)
-> (AvailableAttachment -> String)
-> ([AvailableAttachment] -> ShowS)
-> Show AvailableAttachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AvailableAttachment -> ShowS
showsPrec :: Int -> AvailableAttachment -> ShowS
$cshow :: AvailableAttachment -> String
show :: AvailableAttachment -> String
$cshowList :: [AvailableAttachment] -> ShowS
showList :: [AvailableAttachment] -> ShowS
Show, AvailableAttachment -> AvailableAttachment -> Bool
(AvailableAttachment -> AvailableAttachment -> Bool)
-> (AvailableAttachment -> AvailableAttachment -> Bool)
-> Eq AvailableAttachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AvailableAttachment -> AvailableAttachment -> Bool
== :: AvailableAttachment -> AvailableAttachment -> Bool
$c/= :: AvailableAttachment -> AvailableAttachment -> Bool
/= :: AvailableAttachment -> AvailableAttachment -> Bool
Eq)

type BoxWithAttachmentLocation = (LBox, AttachmentLocation, AttachmentOffsetRatio)

-- TODO there is a bug in cartRotationReflection_apply/cartRotationReflection_invert_apply where we don't actually apply the rotation but somehow this only works with that bug... Maybe the rotations cancel out?
-- 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 (CartRotationReflection -> LBox -> LBox
forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_invert_apply CartRotationReflection
crr LBox
box, CartRotationReflection -> AttachmentLocation -> AttachmentLocation
forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_invert_apply CartRotationReflection
crr AttachmentLocation
al, CartRotationReflection
-> AttachmentOffsetRatio -> AttachmentOffsetRatio
forall a. TransformMe a => CartRotationReflection -> a -> a
cartRotationReflection_invert_apply CartRotationReflection
crr AttachmentOffsetRatio
af)
  r :: XY
r = CartRotationReflection -> XY -> XY
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
False (LBox (V2 Int
x Int
y) (V2 Int
w Int
h), AttachmentLocation
al, AttachmentOffsetRatio
af) = case AttachmentLocation
al of
  AttachmentLocation
AL_Top -> Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
d) Int
y
  AttachmentLocation
AL_Bot -> Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
dn Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
d) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  AttachmentLocation
AL_Left -> Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
dn Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
d )
  AttachmentLocation
AL_Right -> Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
d )
  -- or maybe in the middle is better?
  AttachmentLocation
AL_Any -> Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
y
  where
    n :: Int
n = AttachmentOffsetRatio -> Int
forall a. Ratio a -> a
numerator AttachmentOffsetRatio
af
    d :: Int
d = AttachmentOffsetRatio -> Int
forall a. Ratio a -> a
denominator AttachmentOffsetRatio
af
    dn :: Int
dn = Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n


defaultAttachLocationsFromLBox :: Bool -> LBox -> [(AttachmentLocation, XY)]
defaultAttachLocationsFromLBox :: Bool -> LBox -> [(AttachmentLocation, XY)]
defaultAttachLocationsFromLBox Bool
offsetBorder LBox
lbx = (AttachmentLocation -> (AttachmentLocation, XY))
-> [AttachmentLocation] -> [(AttachmentLocation, XY)]
forall a b. (a -> b) -> [a] -> [b]
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 = (CartSegment -> AttachmentLocation -> AvailableAttachment)
-> AttachmentLocation -> CartSegment -> AvailableAttachment
forall a b c. (a -> b -> c) -> b -> a -> c
flip CartSegment -> AttachmentLocation -> AvailableAttachment
AvailableAttachment_CartSegment AttachmentLocation
al (CartSegment -> AvailableAttachment)
-> CartSegment -> AvailableAttachment
forall a b. (a -> b) -> a -> b
$ case AttachmentLocation
al of
    AttachmentLocation
AL_Top -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
x (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)
    AttachmentLocation
AL_Bot -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h) Int
x (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)
    AttachmentLocation
AL_Left -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
True (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
y (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h)
    AttachmentLocation
AL_Right -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
True (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w) Int
y (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h)
    AttachmentLocation
AL_Any -> Bool -> CartSegment -> CartSegment
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (CartSegment -> CartSegment) -> CartSegment -> CartSegment
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False Int
x Int
y Int
y
  | Bool
otherwise = (CartSegment -> AttachmentLocation -> AvailableAttachment)
-> AttachmentLocation -> CartSegment -> AvailableAttachment
forall a b c. (a -> b -> c) -> b -> a -> c
flip CartSegment -> AttachmentLocation -> AvailableAttachment
AvailableAttachment_CartSegment AttachmentLocation
al (CartSegment -> AvailableAttachment)
-> CartSegment -> AvailableAttachment
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
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)
    AttachmentLocation
AL_Bot -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
False (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
x (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w)
    AttachmentLocation
AL_Left -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
True Int
x Int
y (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h)
    AttachmentLocation
AL_Right -> Bool -> Int -> Int -> Int -> CartSegment
CartSegment Bool
True (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
y (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h)
    AttachmentLocation
AL_Any -> Bool -> CartSegment -> CartSegment
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (CartSegment -> CartSegment) -> CartSegment -> CartSegment
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 = (AttachmentLocation -> AvailableAttachment)
-> [AttachmentLocation] -> [AvailableAttachment]
forall a b. (a -> b) -> [a] -> [b]
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 = ((Attachment, XY) -> Bool)
-> [(Attachment, XY)] -> Maybe (Attachment, XY)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Attachment
_,XY
x) -> XY
x XY -> XY -> Bool
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_isVertical :: CartSegment -> Bool
_cartSegment_common :: CartSegment -> Int
_cartSegment_leftOrTop :: CartSegment -> Int
_cartSegment_rightOrBot :: CartSegment -> Int
_cartSegment_isVertical :: Bool
_cartSegment_common :: Int
_cartSegment_leftOrTop :: Int
_cartSegment_rightOrBot :: Int
..}) 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) = (Int -> Int
forall a. Num a => a -> a
abs (Int
projcomp Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
_cartSegment_leftOrTop
      then (Int
_cartSegment_leftOrTop Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
slidecomp, Int
_cartSegment_leftOrTop)
      else if Int
slidecomp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
_cartSegment_rightOrBot
        then (Int
slidecomp Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
_cartSegment_rightOrBot, Int
_cartSegment_rightOrBot)
        else (Int
0, Int
slidecomp)

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

    r2 :: (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
r2 = (Int
paradInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
orthd, (AttachmentOffsetRatio
ratio2, XY
pos2), AvailableAttachment
aa)

  rslts :: [(Int, (AttachmentOffsetRatio, XY), AvailableAttachment)]
rslts = (AvailableAttachment
 -> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment))
-> [AvailableAttachment]
-> [(Int, (AttachmentOffsetRatio, XY), AvailableAttachment)]
forall a b. (a -> b) -> [a] -> [b]
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) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
d1 Int
d2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
preval) (AttachmentLocation
al1 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
preval)
  (Int
d, (AttachmentOffsetRatio
ratio1, XY
pos1), AvailableAttachment_CartSegment CartSegment
_ AttachmentLocation
alfinal) = ((Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
 -> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
 -> Ordering)
-> [(Int, (AttachmentOffsetRatio, XY), AvailableAttachment)]
-> (Int, (AttachmentOffsetRatio, XY), AvailableAttachment)
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
alfinal
      , _attachment_offset_rel :: AttachmentOffsetRatio
_attachment_offset_rel = AttachmentOffsetRatio
ratio1
    }

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



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