{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Methods.LineDrawer (
  LineAnchorsForRender(..)
  , lineAnchorsForRender_doesIntersectPoint
  , lineAnchorsForRender_doesIntersectBox
  , lineAnchorsForRender_findIntersectingSubsegment
  , lineAnchorsForRender_length

  , sAutoLine_to_lineAnchorsForRenderList
  , sSimpleLineNewRenderFn
  , sSimpleLineNewRenderFnComputeCache

  , getSAutoLineLabelPosition
  , getSAutoLineLabelPositionFromLineAnchorsForRender
  , getSortedSAutoLineLabelPositions
  , getClosestPointOnLineFromLineAnchorsForRenderList



  -- * exposed for testing
  , CartDir(..)
  , TransformMe(..)
  , determineSeparation
  , lineAnchorsForRender_simplify
  , internal_getSAutoLineLabelPosition_walk
) where


import           Relude                         hiding (tail)
import           Relude.Unsafe                  (tail)

import           Potato.Flow.Attachments
import           Potato.Flow.Math
import           Potato.Flow.Methods.LineTypes
import           Potato.Flow.Methods.TextCommon
import           Potato.Flow.Methods.Types
import           Potato.Flow.Owl
import           Potato.Flow.OwlItem
import           Potato.Flow.Serialization.Snake
import Potato.Flow.DebugHelpers

import qualified Data.List                      as L
import qualified Data.List.Index                as L
import qualified Data.Text                      as T
import           Data.Tuple.Extra
import qualified Potato.Data.Text.Zipper        as TZ


import           Linear.Metric                  (norm)
import           Linear.Vector                  ((^*))

import           Control.Exception              (assert)

-- TODO I think you need notion of half separation?
determineSeparation :: (LBox, (Int, Int, Int, Int)) -> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)
determineSeparation :: (LBox, (Int, Int, Int, Int))
-> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)
determineSeparation (LBox
lbx1, (Int, Int, Int, Int)
p1) (LBox
lbx2, (Int, Int, Int, Int)
p2) = (Bool, Bool)
r where
  (Int
l1,Int
r1,Int
t1,Int
b1) = LBox -> (Int, Int, Int, Int)
lBox_to_axis forall a b. (a -> b) -> a -> b
$ LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand LBox
lbx1 (Int, Int, Int, Int)
p1
  (Int
l2,Int
r2,Int
t2,Int
b2) = LBox -> (Int, Int, Int, Int)
lBox_to_axis forall a b. (a -> b) -> a -> b
$ LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand LBox
lbx2 (Int, Int, Int, Int)
p2
  hsep :: Bool
hsep = Int
l1 forall a. Ord a => a -> a -> Bool
>= Int
r2 Bool -> Bool -> Bool
|| Int
l2 forall a. Ord a => a -> a -> Bool
>= Int
r1
  vsep :: Bool
vsep = Int
t1 forall a. Ord a => a -> a -> Bool
>= Int
b2 Bool -> Bool -> Bool
|| Int
t2 forall a. Ord a => a -> a -> Bool
>= Int
b1
  r :: (Bool, Bool)
r = (Bool
hsep, Bool
vsep)

determineSeparationForAttachment_custom :: (LBox, (Int, Int, Int, Int)) -> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)
determineSeparationForAttachment_custom :: (LBox, (Int, Int, Int, Int))
-> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)
determineSeparationForAttachment_custom = (LBox, (Int, Int, Int, Int))
-> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)
determineSeparation


-- TODO DELETE this version was to help support arrows very close to each other but not in one line (see diagram), however it causes undesireable behavior in other cases so we don't use it anymore, it needs to be fixed on an ad-hoc bases
-- in order to be separated for attachment, there must be space for a line in between the two boxes
-- e.g. both ends are offset by 2 but they only need a space of 3 between them
--   +-*
--   |
-- *-+
--determineSeparationForAttachment_custom :: (LBox, (Int, Int, Int, Int)) -> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)
--determineSeparationForAttachment_custom (lbx1, p1) (lbx2, p2) = r where
--  (l1,r1,t1,b1) = lBox_to_axis $ lBox_expand lbx1 p1
--  (l2,r2,t2,b2) = lBox_to_axis $ lBox_expand lbx2 p2
--  hsep = l1 >= r2+1 || l2 >= r1+1
--  vsep = t1 >= b2+1 || t2 >= b1+1
--  r = (hsep, vsep)


determineSeparationForAttachment :: (LBox, Int) -> (LBox, Int) -> (Bool, Bool)
determineSeparationForAttachment :: (LBox, Int) -> (LBox, Int) -> (Bool, Bool)
determineSeparationForAttachment (LBox
lbx1, Int
amt1') (LBox
lbx2, Int
amt2') = (LBox, (Int, Int, Int, Int))
-> (LBox, (Int, Int, Int, Int)) -> (Bool, Bool)
determineSeparationForAttachment_custom (LBox
lbx1, (Int, Int, Int, Int)
amt1) (LBox
lbx2, (Int, Int, Int, Int)
amt2) where
  amt1 :: (Int, Int, Int, Int)
amt1 = (Int
amt1',Int
amt1',Int
amt1',Int
amt1')
  amt2 :: (Int, Int, Int, Int)
amt2 = (Int
amt2',Int
amt2',Int
amt2',Int
amt2')



maybeIndex :: Text -> Int -> Maybe MPChar
maybeIndex :: Text -> Int -> Maybe MPChar
maybeIndex Text
t Int
i = if Int
i forall a. Ord a => a -> a -> Bool
< Text -> Int
T.length Text
t
  then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Int -> Char
T.index Text
t Int
i)
  else forall a. Maybe a
Nothing

renderLine :: SuperStyle -> CartDir -> MPChar
renderLine :: SuperStyle -> CartDir -> MPChar
renderLine SuperStyle {MPChar
FillStyle
_superStyle_fill :: SuperStyle -> FillStyle
_superStyle_point :: SuperStyle -> MPChar
_superStyle_horizontal :: SuperStyle -> MPChar
_superStyle_vertical :: SuperStyle -> MPChar
_superStyle_br :: SuperStyle -> MPChar
_superStyle_bl :: SuperStyle -> MPChar
_superStyle_tr :: SuperStyle -> MPChar
_superStyle_tl :: SuperStyle -> MPChar
_superStyle_fill :: FillStyle
_superStyle_point :: MPChar
_superStyle_horizontal :: MPChar
_superStyle_vertical :: MPChar
_superStyle_br :: MPChar
_superStyle_bl :: MPChar
_superStyle_tr :: MPChar
_superStyle_tl :: MPChar
..} CartDir
cd = case CartDir
cd of
  CartDir
CD_Up    -> MPChar
_superStyle_vertical
  CartDir
CD_Down  -> MPChar
_superStyle_vertical
  CartDir
CD_Left  -> MPChar
_superStyle_horizontal
  CartDir
CD_Right -> MPChar
_superStyle_horizontal

renderLineEnd :: SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd :: SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle {MPChar
FillStyle
_superStyle_fill :: FillStyle
_superStyle_point :: MPChar
_superStyle_horizontal :: MPChar
_superStyle_vertical :: MPChar
_superStyle_br :: MPChar
_superStyle_bl :: MPChar
_superStyle_tr :: MPChar
_superStyle_tl :: MPChar
_superStyle_fill :: SuperStyle -> FillStyle
_superStyle_point :: SuperStyle -> MPChar
_superStyle_horizontal :: SuperStyle -> MPChar
_superStyle_vertical :: SuperStyle -> MPChar
_superStyle_br :: SuperStyle -> MPChar
_superStyle_bl :: SuperStyle -> MPChar
_superStyle_tr :: SuperStyle -> MPChar
_superStyle_tl :: SuperStyle -> MPChar
..} LineStyle {Text
_lineStyle_downArrows :: LineStyle -> Text
_lineStyle_upArrows :: LineStyle -> Text
_lineStyle_rightArrows :: LineStyle -> Text
_lineStyle_leftArrows :: LineStyle -> Text
_lineStyle_downArrows :: Text
_lineStyle_upArrows :: Text
_lineStyle_rightArrows :: Text
_lineStyle_leftArrows :: Text
..} CartDir
cd Int
distancefromend = MPChar
r where
  r :: MPChar
r = case CartDir
cd of
    CartDir
CD_Up -> forall a. a -> Maybe a -> a
fromMaybe MPChar
_superStyle_vertical forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe MPChar
maybeIndex Text
_lineStyle_upArrows Int
distancefromend
    CartDir
CD_Down -> forall a. a -> Maybe a -> a
fromMaybe MPChar
_superStyle_vertical forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe MPChar
maybeIndex (Text -> Text
T.reverse Text
_lineStyle_downArrows) Int
distancefromend
    CartDir
CD_Left -> forall a. a -> Maybe a -> a
fromMaybe MPChar
_superStyle_horizontal forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe MPChar
maybeIndex Text
_lineStyle_leftArrows Int
distancefromend
    CartDir
CD_Right -> forall a. a -> Maybe a -> a
fromMaybe MPChar
_superStyle_horizontal forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe MPChar
maybeIndex (Text -> Text
T.reverse Text
_lineStyle_rightArrows) Int
distancefromend


renderAnchorType :: SuperStyle -> LineStyle -> AnchorType -> MPChar
renderAnchorType :: SuperStyle -> LineStyle -> AnchorType -> MPChar
renderAnchorType ss :: SuperStyle
ss@SuperStyle {MPChar
FillStyle
_superStyle_fill :: FillStyle
_superStyle_point :: MPChar
_superStyle_horizontal :: MPChar
_superStyle_vertical :: MPChar
_superStyle_br :: MPChar
_superStyle_bl :: MPChar
_superStyle_tr :: MPChar
_superStyle_tl :: MPChar
_superStyle_fill :: SuperStyle -> FillStyle
_superStyle_point :: SuperStyle -> MPChar
_superStyle_horizontal :: SuperStyle -> MPChar
_superStyle_vertical :: SuperStyle -> MPChar
_superStyle_br :: SuperStyle -> MPChar
_superStyle_bl :: SuperStyle -> MPChar
_superStyle_tr :: SuperStyle -> MPChar
_superStyle_tl :: SuperStyle -> MPChar
..} LineStyle
ls AnchorType
at = MPChar
r where
  r :: MPChar
r = case AnchorType
at of
    AnchorType
AT_End_Up        -> SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle
ss LineStyle
ls CartDir
CD_Up Int
0
    AnchorType
AT_End_Down      -> SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle
ss LineStyle
ls CartDir
CD_Down Int
0
    AnchorType
AT_End_Left      -> SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle
ss LineStyle
ls CartDir
CD_Left Int
0
    AnchorType
AT_End_Right     -> SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle
ss LineStyle
ls CartDir
CD_Right Int
0
    AnchorType
AT_Elbow_TL      -> MPChar
_superStyle_tl
    AnchorType
AT_Elbow_TR      -> MPChar
_superStyle_tr
    AnchorType
AT_Elbow_BR      -> MPChar
_superStyle_br
    AnchorType
AT_Elbow_BL      -> MPChar
_superStyle_bl
    AnchorType
AT_Elbow_Invalid -> forall a. a -> Maybe a
Just Char
'?'


lineAnchorsForRender_simplify :: LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_simplify :: LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_simplify LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
..} = LineAnchorsForRender
r where
  -- remove 0 distance lines except at front and back
  withoutzeros :: [(CartDir, Int, Bool)]
withoutzeros = case [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest of
    []   -> []
    (CartDir, Int, Bool)
x:[(CartDir, Int, Bool)]
xs -> (CartDir, Int, Bool)
xforall a. a -> [a] -> [a]
:forall {a}. [(a, Int, Bool)] -> [(a, Int, Bool)]
withoutzerosback [(CartDir, Int, Bool)]
xs
    where
      withoutzerosback :: [(a, Int, Bool)] -> [(a, Int, Bool)]
withoutzerosback = \case
        [] -> []
        (a, Int, Bool)
x:[] -> [(a, Int, Bool)
x]
        (a
_, Int
0, Bool
False):[(a, Int, Bool)]
xs -> [(a, Int, Bool)]
xs
        -- this can happen now in a few cases, I don't think it's a big deal
        -- it does mess up our subsegmenting starting flags but I think in that case the midpoint probably got removed entirely due to it being too close to another one maybe??
        --(_, 0, True):_ -> error "unexpected 0 length subsegment starting anchor"
        (a
_, Int
0, Bool
True):[(a, Int, Bool)]
xs -> [(a, Int, Bool)]
xs
        (a, Int, Bool)
x:[(a, Int, Bool)]
xs -> (a, Int, Bool)
xforall a. a -> [a] -> [a]
:[(a, Int, Bool)] -> [(a, Int, Bool)]
withoutzerosback [(a, Int, Bool)]
xs

  foldrfn :: (a, b, c) -> [(a, b, c)] -> [(a, b, c)]
foldrfn (a
cd, b
d, c
s) [] = [(a
cd, b
d, c
s)]
  foldrfn (a
cd, b
d, c
firstisstart) ((a
cd',b
d', c
nextisstart):[(a, b, c)]
xs) = if a
cd forall a. Eq a => a -> a -> Bool
== a
cd'
    then (a
cd, b
dforall a. Num a => a -> a -> a
+b
d', c
firstisstart)forall a. a -> [a] -> [a]
:[(a, b, c)]
xs
    else (a
cd,b
d,c
firstisstart)forall a. a -> [a] -> [a]
:(a
cd',b
d',c
nextisstart)forall a. a -> [a] -> [a]
:[(a, b, c)]
xs
  withoutdoubles :: [(CartDir, Int, Bool)]
withoutdoubles = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b} {c}.
(Eq a, Num b) =>
(a, b, c) -> [(a, b, c)] -> [(a, b, c)]
foldrfn [] [(CartDir, Int, Bool)]
withoutzeros
  r :: LineAnchorsForRender
r = LineAnchorsForRender {
      _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
_lineAnchorsForRender_start
      , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = [(CartDir, Int, Bool)]
withoutdoubles
    }

lineAnchorsForRender_end :: LineAnchorsForRender -> XY
lineAnchorsForRender_end :: LineAnchorsForRender -> XY
lineAnchorsForRender_end LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\XY
p (CartDir, Int, Bool)
cdd -> XY
p forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir, Int, Bool)
cdd) XY
_lineAnchorsForRender_start [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest

lineAnchorsForRender_reverse :: LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_reverse :: LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_reverse lafr :: LineAnchorsForRender
lafr@LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} = LineAnchorsForRender
r where
  end :: XY
end = LineAnchorsForRender -> XY
lineAnchorsForRender_end LineAnchorsForRender
lafr
  revgo :: [(CartDir, b, Bool)]
-> [(CartDir, b, Bool)] -> [(CartDir, b, Bool)]
revgo [(CartDir, b, Bool)]
acc [] = [(CartDir, b, Bool)]
acc
  revgo [(CartDir, b, Bool)]
acc ((CartDir
cd,b
d,Bool
False):[]) = (CartDir -> CartDir
flipCartDir CartDir
cd,b
d,Bool
True)forall a. a -> [a] -> [a]
:[(CartDir, b, Bool)]
acc
  revgo [(CartDir, b, Bool)]
_ ((CartDir
_,b
_,Bool
True):[]) = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected subsegment starting anchor at end"
  revgo [(CartDir, b, Bool)]
acc ((CartDir
cd,b
d,Bool
False):[(CartDir, b, Bool)]
xs) = [(CartDir, b, Bool)]
-> [(CartDir, b, Bool)] -> [(CartDir, b, Bool)]
revgo ((CartDir -> CartDir
flipCartDir CartDir
cd, b
d, Bool
False)forall a. a -> [a] -> [a]
:[(CartDir, b, Bool)]
acc) [(CartDir, b, Bool)]
xs
  revgo [(CartDir, b, Bool)]
_ ((CartDir
_,b
_,Bool
True):[(CartDir, b, Bool)]
_) = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"TODO this does not handle midpoint subsegment starting anchors correctly (not that it needs to right now)"
  revgostart :: [(CartDir, b, Bool)] -> [(CartDir, b, Bool)]
revgostart [] = []
  revgostart ((CartDir
cd,b
d,Bool
True):[(CartDir, b, Bool)]
xs) = forall {b}.
[(CartDir, b, Bool)]
-> [(CartDir, b, Bool)] -> [(CartDir, b, Bool)]
revgo [(CartDir -> CartDir
flipCartDir CartDir
cd,b
d,Bool
False)] [(CartDir, b, Bool)]
xs
  revgostart [(CartDir, b, Bool)]
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected non-subsegment starting anchor at start"
  r :: LineAnchorsForRender
r = LineAnchorsForRender {
      _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
end
      , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = forall {b}. [(CartDir, b, Bool)] -> [(CartDir, b, Bool)]
revgostart [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest
    }

lineAnchorsForRender_toPointList :: LineAnchorsForRender -> [XY]
lineAnchorsForRender_toPointList :: LineAnchorsForRender -> [XY]
lineAnchorsForRender_toPointList LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} = [XY]
r where
  scanlfn :: XY -> (CartDir, Int, c) -> XY
scanlfn XY
pos (CartDir
cd,Int
d,c
_) = XY
pos forall a. Num a => a -> a -> a
+ (CartDir -> XY
cartDirToUnit CartDir
cd) forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Int
d
  r :: [XY]
r = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall {c}. XY -> (CartDir, Int, c) -> XY
scanlfn XY
_lineAnchorsForRender_start [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest

data SimpleLineSolverParameters_NEW = SimpleLineSolverParameters_NEW {
  SimpleLineSolverParameters_NEW -> Int
_simpleLineSolverParameters_NEW_attachOffset :: Int -- cells to offset attach to box by
}

instance TransformMe SimpleLineSolverParameters_NEW where
  transformMe_rotateLeft :: SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
transformMe_rotateLeft = forall a. a -> a
id
  transformMe_rotateRight :: SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
transformMe_rotateRight = forall a. a -> a
id
  transformMe_reflectHorizontally :: SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
transformMe_reflectHorizontally = forall a. a -> a
id


restify :: [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify :: [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify []          = []
restify ((CartDir
cd,Int
d):[(CartDir, Int)]
xs) = (CartDir
cd,Int
d,Bool
True)forall a. a -> [a] -> [a]
:forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(CartDir
a,Int
b) -> (CartDir
a,Int
b,Bool
False)) [(CartDir, Int)]
xs

-- used to convert AL_ANY at (ax, ay) to an AttachmentLocation based on target position (tx, ty)
-- TODO test that this function is rotationally/reflectively symmetric (although it doesn't really matter if it isn't, however due to recursive implementation of sSimpleLineSolver it's kind of awkward if it's not)
makeAL :: XY -> XY -> AttachmentLocation
makeAL :: XY -> XY -> AttachmentLocation
makeAL (V2 Int
ax Int
ay) (V2 Int
tx Int
ty) = AttachmentLocation
r where
  dx :: Int
dx = Int
tx forall a. Num a => a -> a -> a
- Int
ax
  dy :: Int
dy = Int
ty forall a. Num a => a -> a -> a
- Int
ay
  r :: AttachmentLocation
r = if forall a. Num a => a -> a
abs Int
dx forall a. Ord a => a -> a -> Bool
> forall a. Num a => a -> a
abs Int
dy
    then if Int
dx forall a. Ord a => a -> a -> Bool
> Int
0
      then AttachmentLocation
AL_Right
      else AttachmentLocation
AL_Left
    else if Int
dy forall a. Ord a => a -> a -> Bool
> Int
0
      then AttachmentLocation
AL_Bot
      else AttachmentLocation
AL_Top

-- | configuration to determine whether the attachment point is offest by the border of the box
newtype OffsetBorder = OffsetBorder { OffsetBorder -> Bool
unOffsetBorder :: Bool } deriving (Int -> OffsetBorder -> ShowS
[OffsetBorder] -> ShowS
OffsetBorder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OffsetBorder] -> ShowS
$cshowList :: [OffsetBorder] -> ShowS
show :: OffsetBorder -> String
$cshow :: OffsetBorder -> String
showsPrec :: Int -> OffsetBorder -> ShowS
$cshowsPrec :: Int -> OffsetBorder -> ShowS
Show)

instance TransformMe OffsetBorder where
  transformMe_rotateLeft :: OffsetBorder -> OffsetBorder
transformMe_rotateLeft = forall a. a -> a
id
  transformMe_rotateRight :: OffsetBorder -> OffsetBorder
transformMe_rotateRight = forall a. a -> a
id
  transformMe_reflectHorizontally :: OffsetBorder -> OffsetBorder
transformMe_reflectHorizontally = forall a. a -> a
id


-- 🙈🙈🙈
-- TODO update to be (LBox, AttachmentLocation, AttachmentOffsetRatio, OffsetBorder)
sSimpleLineSolver_NEW :: (Text, Int) -> CartRotationReflection -> SimpleLineSolverParameters_NEW -> (BoxWithAttachmentLocation, OffsetBorder) -> (BoxWithAttachmentLocation, OffsetBorder) -> LineAnchorsForRender
sSimpleLineSolver_NEW :: (Text, Int)
-> CartRotationReflection
-> SimpleLineSolverParameters_NEW
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> LineAnchorsForRender
sSimpleLineSolver_NEW (Text
errormsg, Int
depth) CartRotationReflection
crr SimpleLineSolverParameters_NEW
sls ((LBox
lbx1, AttachmentLocation
al1_, AttachmentOffsetRatio
af1), OffsetBorder
offb1) ((LBox
lbx2, AttachmentLocation
al2_, AttachmentOffsetRatio
af2), OffsetBorder
offb2) =  LineAnchorsForRender
finaloutput where
  --LBox (V2 x1 y1) (V2 w1 h1) = lbx1
  LBox (V2 Int
_ Int
y2) (V2 Int
_ Int
h2) = LBox
lbx2

  attachoffset :: Int
attachoffset = SimpleLineSolverParameters_NEW -> Int
_simpleLineSolverParameters_NEW_attachOffset SimpleLineSolverParameters_NEW
sls

  al1 :: AttachmentLocation
al1 = case AttachmentLocation
al1_ of
    AttachmentLocation
AL_Any -> forall a. HasCallStack => Bool -> a -> a
assert (AttachmentOffsetRatio
af1 forall a. Eq a => a -> a -> Bool
== AttachmentOffsetRatio
attachment_offset_rel_default) forall a b. (a -> b) -> a -> b
$ XY -> XY -> AttachmentLocation
makeAL (LBox -> XY
_lBox_tl LBox
lbx1) forall a b. (a -> b) -> a -> b
$ case AttachmentLocation
al2_ of
      AttachmentLocation
AL_Any -> LBox -> XY
_lBox_tl LBox
lbx2
      AttachmentLocation
_      -> XY
end
    AttachmentLocation
x -> AttachmentLocation
x
  al2 :: AttachmentLocation
al2 = case AttachmentLocation
al2_ of
    AttachmentLocation
AL_Any -> forall a. HasCallStack => Bool -> a -> a
assert (AttachmentOffsetRatio
af2 forall a. Eq a => a -> a -> Bool
== AttachmentOffsetRatio
attachment_offset_rel_default) forall a b. (a -> b) -> a -> b
$ XY -> XY -> AttachmentLocation
makeAL (LBox -> XY
_lBox_tl LBox
lbx2) forall a b. (a -> b) -> a -> b
$ case AttachmentLocation
al1_ of
      AttachmentLocation
AL_Any -> LBox -> XY
_lBox_tl LBox
lbx1
      AttachmentLocation
_      -> XY
start
    AttachmentLocation
x -> AttachmentLocation
x

  lbal1 :: ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1 = ((LBox
lbx1, AttachmentLocation
al1, AttachmentOffsetRatio
af1), OffsetBorder
offb1)
  lbal2 :: ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2 = ((LBox
lbx2, AttachmentLocation
al2, AttachmentOffsetRatio
af2), OffsetBorder
offb2)

  start :: XY
start@(V2 Int
ax1 Int
ay1) = CartRotationReflection
-> Bool -> (LBox, AttachmentLocation, AttachmentOffsetRatio) -> XY
attachLocationFromLBox_conjugateCartRotationReflection CartRotationReflection
crr (OffsetBorder -> Bool
unOffsetBorder OffsetBorder
offb1) (LBox
lbx1, AttachmentLocation
al1, AttachmentOffsetRatio
af1)
  end :: XY
end@(V2 Int
ax2 Int
ay2) = CartRotationReflection
-> Bool -> (LBox, AttachmentLocation, AttachmentOffsetRatio) -> XY
attachLocationFromLBox_conjugateCartRotationReflection CartRotationReflection
crr (OffsetBorder -> Bool
unOffsetBorder OffsetBorder
offb2) (LBox
lbx2, AttachmentLocation
al2, AttachmentOffsetRatio
af2)


  -- TODO need to selectively remove offset border based on whether there is an arrow or not (you need to set sSimpleLineSolver_NEW OffsetBorder parameter, issue isn't here)
  -- this causes stuff like this right now
              -- ╔═════════════╗
              -- ║╔GoatState═══║═══════════╗
              -- ║║            ║           ║
              -- ║║            ║           ║
              -- ║║            ║           ║
              -- ║║            ║           ║
              -- ║╚════════════║═══════════╝
              -- ║            ║║
              -- ║            ║v
              -- ║╔OwlPFWorksp║ce══════════╗
              -- ║║           ║            ║
              -- ║║           ║            ║
              -- ║║           ║            ║
              -- ║║           ║            ║
              -- ║╚═══════════║════════════╝
              -- ╚════════════╝
  (Bool
hsep, Bool
vsep) = (LBox, Int) -> (LBox, Int) -> (Bool, Bool)
determineSeparationForAttachment (LBox
lbx1, if OffsetBorder -> Bool
unOffsetBorder OffsetBorder
offb1 then Int
1 else Int
0) (LBox
lbx2, if OffsetBorder -> Bool
unOffsetBorder OffsetBorder
offb2 then Int
1 else Int
0)

  lbx1isstrictlyleft :: Bool
lbx1isstrictlyleft = Int
ax1 forall a. Ord a => a -> a -> Bool
< Int
ax2
  lbx1isleft :: Bool
lbx1isleft = Int
ax1 forall a. Ord a => a -> a -> Bool
<= Int
ax2
  lbx1isstrictlyabove :: Bool
lbx1isstrictlyabove = Int
ay1 forall a. Ord a => a -> a -> Bool
< Int
ay2
  ay1isvsepfromlbx2 :: Bool
ay1isvsepfromlbx2 = Int
ay1 forall a. Ord a => a -> a -> Bool
< Int
y2 Bool -> Bool -> Bool
|| Int
ay1 forall a. Ord a => a -> a -> Bool
>= Int
y2 forall a. Num a => a -> a -> a
+ Int
h2

  traceStep :: String -> a -> a
  traceStep :: forall a. String -> a -> a
traceStep String
_ a
x = a
x
  --traceStep = trace  
  stepdetail :: Text
stepdetail = forall b a. (Show a, IsString b) => a -> b
show ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1 forall a. Semigroup a => a -> a -> a
<> Text
" | " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2 forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  nextmsg :: Text -> (Text, Int)
nextmsg Text
step = (Text
errormsg forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
step forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
stepdetail, Int
depthforall a. Num a => a -> a -> a
+Int
1)

  (Int
l1_inc,Int
r1,Int
t1_inc,Int
b1) = LBox -> (Int, Int, Int, Int)
lBox_to_axis LBox
lbx1
  (Int
l2_inc,Int
r2,Int
t2_inc,Int
b2) = LBox -> (Int, Int, Int, Int)
lBox_to_axis LBox
lbx2

  -- TODO offset by boundaryoffset from parameters
  l :: Int
l = forall a. Ord a => a -> a -> a
min (Int
l1_incforall a. Num a => a -> a -> a
-Int
1) (Int
l2_incforall a. Num a => a -> a -> a
-Int
1)
  t :: Int
t = forall a. Ord a => a -> a -> a
min (Int
t1_incforall a. Num a => a -> a -> a
-Int
1) (Int
t2_incforall a. Num a => a -> a -> a
-Int
1)
  b :: Int
b = forall a. Ord a => a -> a -> a
max Int
b1 Int
b2

  anchors :: LineAnchorsForRender
anchors = case AttachmentLocation
al1 of
    -- WORKING
    -- degenerate case
    AttachmentLocation
AL_Right | Int
ax1 forall a. Eq a => a -> a -> Bool
== Int
ax2 Bool -> Bool -> Bool
&& Int
ay1 forall a. Eq a => a -> a -> Bool
== Int
ay2 -> LineAnchorsForRender {
        _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
        , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = []
      }
    -- WORKING
    -- 1->  <-2
    AttachmentLocation
AL_Right | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
&& Bool
lbx1isstrictlyleft Bool -> Bool -> Bool
&& Bool
hsep -> forall a. String -> a -> a
traceStep String
"case 1" forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where

      halfway :: Int
halfway = (Int
ax2forall a. Num a => a -> a -> a
+Int
ax1) forall a. Integral a => a -> a -> a
`div` Int
2
      lb1_to_center :: (CartDir, Int)
lb1_to_center = (CartDir
CD_Right, (Int
halfwayforall a. Num a => a -> a -> a
-Int
ax1))
      centerverticalline :: (CartDir, Int)
centerverticalline = if Int
ay1 forall a. Ord a => a -> a -> Bool
< Int
ay2
        then (CartDir
CD_Down, Int
ay2forall a. Num a => a -> a -> a
-Int
ay1)
        else (CartDir
CD_Up, Int
ay1forall a. Num a => a -> a -> a
-Int
ay2)
      center_to_lb2 :: (CartDir, Int)
center_to_lb2 = (CartDir
CD_Right, (Int
ax2forall a. Num a => a -> a -> a
-Int
halfway))
      r :: LineAnchorsForRender
r = LineAnchorsForRender {
          _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
          , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify [(CartDir, Int)
lb1_to_center, (CartDir, Int)
centerverticalline, (CartDir, Int)
center_to_lb2]
        }

    -- WORKING
    -- <-2  1->
    AttachmentLocation
AL_Right | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
vsep -> forall a. String -> a -> a
traceStep String
"case 2" forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where

      goup :: Bool
goup = (Int
ay1forall a. Num a => a -> a -> a
-Int
t)forall a. Num a => a -> a -> a
+(Int
ay2forall a. Num a => a -> a -> a
-Int
t) forall a. Ord a => a -> a -> Bool
< (Int
bforall a. Num a => a -> a -> a
-Int
ay1)forall a. Num a => a -> a -> a
+(Int
bforall a. Num a => a -> a -> a
-Int
ay2)

      rightedge :: Int
rightedge = if (Bool -> Bool
not Bool
goup Bool -> Bool -> Bool
&& Int
b2 forall a. Ord a => a -> a -> Bool
< Int
ay1) Bool -> Bool -> Bool
|| (Bool
goup Bool -> Bool -> Bool
&& Int
ay1 forall a. Ord a => a -> a -> Bool
< Int
t2_inc)
        then Int
r1 forall a. Num a => a -> a -> a
+ Int
attachoffset
        else (forall a. Ord a => a -> a -> a
max (Int
r1forall a. Num a => a -> a -> a
+Int
attachoffset) Int
r2)

      lb1_to_right :: (CartDir, Int)
lb1_to_right = (CartDir
CD_Right, Int
rightedgeforall a. Num a => a -> a -> a
-Int
ax1)
      right_to_torb :: (CartDir, Int)
right_to_torb = if Bool
goup
        then (CartDir
CD_Up, Int
ay1forall a. Num a => a -> a -> a
-Int
t)
        else (CartDir
CD_Down, Int
bforall a. Num a => a -> a -> a
-Int
ay1)

      leftedge :: Int
leftedge = if (Bool
goup Bool -> Bool -> Bool
&& Int
t2_inc forall a. Ord a => a -> a -> Bool
<= Int
t1_inc) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
goup Bool -> Bool -> Bool
&& Int
b2 forall a. Ord a => a -> a -> Bool
> Int
b1)
        then Int
ax2forall a. Num a => a -> a -> a
-Int
attachoffset
        else forall a. Ord a => a -> a -> a
min (Int
ax2forall a. Num a => a -> a -> a
-Int
attachoffset) (Int
l1_incforall a. Num a => a -> a -> a
-Int
attachoffset)

      torb :: (CartDir, Int)
torb = (CartDir
CD_Left, Int
rightedge forall a. Num a => a -> a -> a
- Int
leftedge)

      torb_to_left :: (CartDir, Int)
torb_to_left = if Bool
goup
        then (CartDir
CD_Down, Int
ay2forall a. Num a => a -> a -> a
-Int
t)
        else (CartDir
CD_Up, Int
bforall a. Num a => a -> a -> a
-Int
ay2)
      left_to_lb2 :: (CartDir, Int)
left_to_lb2 = (CartDir
CD_Right, Int
ax2forall a. Num a => a -> a -> a
-Int
leftedge)
      r :: LineAnchorsForRender
r = LineAnchorsForRender {
          _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
          , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify [(CartDir, Int)
lb1_to_right, (CartDir, Int)
right_to_torb, (CartDir, Int)
torb, (CartDir, Int)
torb_to_left, (CartDir, Int)
left_to_lb2]
        }

    -- WORKING
    -- <-2
    --      1->
    AttachmentLocation
AL_Right | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
&& Bool
vsep -> forall a. String -> a -> a
traceStep String
"case 3" forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where
      halfway :: Int
halfway = if Int
b1 forall a. Ord a => a -> a -> Bool
< Int
t2_inc
        then (Int
b1forall a. Num a => a -> a -> a
+Int
t2_inc) forall a. Integral a => a -> a -> a
`div` Int
2
        else (Int
b2forall a. Num a => a -> a -> a
+Int
t1_inc) forall a. Integral a => a -> a -> a
`div` Int
2
      lb1_to_right :: (CartDir, Int)
lb1_to_right = (CartDir
CD_Right, Int
attachoffset)
      right_to_center :: (CartDir, Int)
right_to_center = if Bool
lbx1isstrictlyabove
        then (CartDir
CD_Down, Int
halfwayforall a. Num a => a -> a -> a
-Int
ay1)
        else (CartDir
CD_Up, Int
ay1forall a. Num a => a -> a -> a
-Int
halfway)
      center :: (CartDir, Int)
center = (CartDir
CD_Left, Int
attachoffsetforall a. Num a => a -> a -> a
*Int
2 forall a. Num a => a -> a -> a
+ (Int
ax1forall a. Num a => a -> a -> a
-Int
ax2))
      center_to_left :: (CartDir, Int)
center_to_left = if Bool
lbx1isstrictlyabove
        then (CartDir
CD_Down, Int
ay2forall a. Num a => a -> a -> a
-Int
halfway)
        else (CartDir
CD_Up, Int
halfwayforall a. Num a => a -> a -> a
-Int
ay2)
      left_to_lb2 :: (CartDir, Int)
left_to_lb2 = (CartDir
CD_Right, Int
attachoffset)
      r :: LineAnchorsForRender
r = LineAnchorsForRender {
          _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
          , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify [(CartDir, Int)
lb1_to_right, (CartDir, Int)
right_to_center, (CartDir, Int)
center, (CartDir, Int)
center_to_left, (CartDir, Int)
left_to_lb2]
        }

    -- WORKING
    --
    -- 1->
    --     2->
    -- ay1isvsepfromlbx2 (different boxes)
    --
    -- OR
    --
    -- ->1
    -- ->2
    -- r1 == r2 (special case when the 2 boxes are the same)
    AttachmentLocation
AL_Right | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right Bool -> Bool -> Bool
&& (Bool
ay1isvsepfromlbx2 Bool -> Bool -> Bool
|| Int
r1 forall a. Eq a => a -> a -> Bool
== Int
r2) -> forall a. String -> a -> a
traceStep String
"case 4" forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
answer where
      rightedge :: Int
rightedge = forall a. Ord a => a -> a -> a
max Int
r1 Int
r2 forall a. Num a => a -> a -> a
+ Int
attachoffset
      lb1_to_right1 :: (CartDir, Int)
lb1_to_right1 = (CartDir
CD_Right, Int
rightedgeforall a. Num a => a -> a -> a
-Int
r1)
      right1_to_right2 :: (CartDir, Int)
right1_to_right2 = if Bool
lbx1isstrictlyabove
        then (CartDir
CD_Down, Int
ay2forall a. Num a => a -> a -> a
-Int
ay1)
        else (CartDir
CD_Up, Int
ay1forall a. Num a => a -> a -> a
-Int
ay2)
      right2_to_lb2 :: (CartDir, Int)
right2_to_lb2 = (CartDir
CD_Left, Int
rightedgeforall a. Num a => a -> a -> a
-Int
r2)
      answer :: LineAnchorsForRender
answer = LineAnchorsForRender {
          _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
          , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify [(CartDir, Int)
lb1_to_right1, (CartDir, Int)
right1_to_right2, (CartDir, Int)
right2_to_lb2]
        }

    -- WORKING
    -- ->1 ->2
    AttachmentLocation
AL_Right | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right Bool -> Bool -> Bool
&& Bool
lbx1isleft Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ay1isvsepfromlbx2 -> forall a. String -> a -> a
traceStep String
"case 5b" forall a b. (a -> b) -> a -> b
$  LineAnchorsForRender
answer where


      goupordown :: Bool
goupordown = (Int
ay1forall a. Num a => a -> a -> a
-Int
t)forall a. Num a => a -> a -> a
+(Int
ay2forall a. Num a => a -> a -> a
-Int
t) forall a. Ord a => a -> a -> Bool
< (Int
bforall a. Num a => a -> a -> a
-Int
ay1)forall a. Num a => a -> a -> a
+(Int
bforall a. Num a => a -> a -> a
-Int
ay2)

      -- TODO maybe it would be nice if this traveled a little further right
      lb1_to_right1 :: (CartDir, Int)
lb1_to_right1 = (CartDir
CD_Right, Int
attachoffset)

      right1_to_torb :: (CartDir, Int)
right1_to_torb = if Bool
goupordown
        then (CartDir
CD_Up, Int
ay1forall a. Num a => a -> a -> a
-Int
t)
        else (CartDir
CD_Down, Int
bforall a. Num a => a -> a -> a
-Int
ay1)
      torb :: (CartDir, Int)
torb = (CartDir
CD_Right, Int
r2forall a. Num a => a -> a -> a
-Int
r1)
      torb_to_right2 :: (CartDir, Int)
torb_to_right2 = if Bool
goupordown
        then (CartDir
CD_Down, Int
ay2forall a. Num a => a -> a -> a
-Int
t)
        else (CartDir
CD_Up, Int
bforall a. Num a => a -> a -> a
-Int
ay2)
      right2_to_lb2 :: (CartDir, Int)
right2_to_lb2 = (CartDir
CD_Left, Int
attachoffset)
      answer :: LineAnchorsForRender
answer = LineAnchorsForRender {
          _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
          , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify [(CartDir, Int)
lb1_to_right1, (CartDir, Int)
right1_to_torb, (CartDir, Int)
torb, (CartDir, Int)
torb_to_right2, (CartDir, Int)
right2_to_lb2]
        }

    -- ->2 ->1 (will not get covered by rotation)
    AttachmentLocation
AL_Right | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ay1isvsepfromlbx2 -> forall a. String -> a -> a
traceStep String
"case 6 (reverse)" forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_reverse forall a b. (a -> b) -> a -> b
$ (Text, Int)
-> CartRotationReflection
-> SimpleLineSolverParameters_NEW
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> LineAnchorsForRender
sSimpleLineSolver_NEW (Text -> (Text, Int)
nextmsg Text
"case 6") CartRotationReflection
crr SimpleLineSolverParameters_NEW
sls ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2 ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1

    --     2->
    --  ^
    --  |
    --  1
    --     2->
    AttachmentLocation
AL_Top | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right Bool -> Bool -> Bool
&& Bool
lbx1isleft -> forall a. String -> a -> a
traceStep String
"case 7" forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where
      upd :: Int
upd = if Bool
vsep
        then Int
attachoffset
        else Int
ay1forall a. Num a => a -> a -> a
-Int
t forall a. Num a => a -> a -> a
+ Int
attachoffset
      topline :: Int
topline = Int
ay1forall a. Num a => a -> a -> a
-Int
upd
      lb1_to_up :: (CartDir, Int)
lb1_to_up = (CartDir
CD_Up, Int
upd)
      right :: Int
right = if Int
topline forall a. Ord a => a -> a -> Bool
< Int
ay2
        then (forall a. Ord a => a -> a -> a
max Int
ax2 Int
r1) forall a. Num a => a -> a -> a
+ Int
attachoffset
        else Int
ax2 forall a. Num a => a -> a -> a
+ Int
attachoffset
      up_to_right1 :: (CartDir, Int)
up_to_right1 =  (CartDir
CD_Right, Int
rightforall a. Num a => a -> a -> a
-Int
ax1)
      right1_to_right2 :: (CartDir, Int)
right1_to_right2 = if Int
topline forall a. Ord a => a -> a -> Bool
< Int
ay2
        then (CartDir
CD_Down, Int
ay2forall a. Num a => a -> a -> a
-Int
topline)
        else (CartDir
CD_Up, Int
toplineforall a. Num a => a -> a -> a
-Int
ay2)
      right2_to_lb2 :: (CartDir, Int)
right2_to_lb2 = (CartDir
CD_Left, Int
rightforall a. Num a => a -> a -> a
-Int
ax2)
      r :: LineAnchorsForRender
r = LineAnchorsForRender {
          _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
          , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify [(CartDir, Int)
lb1_to_up,(CartDir, Int)
up_to_right1,(CartDir, Int)
right1_to_right2,(CartDir, Int)
right2_to_lb2]
        }
    --     <-2
    --  ^
    --  |
    --  1   <-2 (this one handles both vsep cases)
    AttachmentLocation
AL_Top | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
&& Bool
lbx1isleft -> forall a. String -> a -> a
traceStep String
"case 9" forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where
      topedge :: Int
topedge = forall a. Ord a => a -> a -> a
min (Int
ay1 forall a. Num a => a -> a -> a
- Int
attachoffset) Int
ay2
      leftedge :: Int
leftedge = Int
l
      halfway :: Int
halfway = (Int
ax1 forall a. Num a => a -> a -> a
+ Int
ax2) forall a. Integral a => a -> a -> a
`div` Int
2

      lb1_to_up :: (CartDir, Int)
lb1_to_up = (CartDir
CD_Up, Int
ay1forall a. Num a => a -> a -> a
-Int
topedge)
      ((CartDir, Int)
up_to_over, Int
up_to_over_xpos) = if Bool
lbx1isstrictlyabove Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hsep
        -- go around from the left
        then ((CartDir
CD_Left, Int
ax1forall a. Num a => a -> a -> a
-Int
leftedge), Int
leftedge)
        else ((CartDir
CD_Right, Int
halfwayforall a. Num a => a -> a -> a
-Int
ax1), Int
halfway)
      over_to_down :: (CartDir, Int)
over_to_down = (CartDir
CD_Down, Int
ay2forall a. Num a => a -> a -> a
-Int
topedge)
      down_to_lb2 :: (CartDir, Int)
down_to_lb2 = (CartDir
CD_Right, Int
ax2forall a. Num a => a -> a -> a
-Int
up_to_over_xpos)
      r :: LineAnchorsForRender
r = LineAnchorsForRender {
          _lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
          , _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = [(CartDir, Int)] -> [(CartDir, Int, Bool)]
restify [(CartDir, Int)
lb1_to_up, (CartDir, Int)
up_to_over,(CartDir, Int)
over_to_down,(CartDir, Int)
down_to_lb2]
        }

    --        ^
    --        |
    -- <-2->  1 (will not get covered by rotation)
    AttachmentLocation
AL_Top | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
|| AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right -> forall a. String -> a -> a
traceStep String
"case 10 (flip)" forall a b. (a -> b) -> a -> b
$  forall a. TransformMe a => a -> a
transformMe_reflectHorizontally forall a b. (a -> b) -> a -> b
$ (Text, Int)
-> CartRotationReflection
-> SimpleLineSolverParameters_NEW
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> LineAnchorsForRender
sSimpleLineSolver_NEW (Text -> (Text, Int)
nextmsg Text
"case 10") (forall a. TransformMe a => a -> a
transformMe_reflectHorizontally CartRotationReflection
crr) (forall a. TransformMe a => a -> a
transformMe_reflectHorizontally SimpleLineSolverParameters_NEW
sls) (forall a. TransformMe a => a -> a
transformMe_reflectHorizontally ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1) (forall a. TransformMe a => a -> a
transformMe_reflectHorizontally ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2)

    AttachmentLocation
AL_Top | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Any -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should have been handled by earlier substitution"
    AttachmentLocation
AL_Any | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Top -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should have been handled by earlier substitution"
    AttachmentLocation
AL_Any | AttachmentLocation
al2 forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Any -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should have been handled by earlier substitution"

    AttachmentLocation
_ -> forall a. String -> a -> a
traceStep String
"case 14 (rotate)" forall a b. (a -> b) -> a -> b
$ forall a. TransformMe a => a -> a
transformMe_rotateRight forall a b. (a -> b) -> a -> b
$ (Text, Int)
-> CartRotationReflection
-> SimpleLineSolverParameters_NEW
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> LineAnchorsForRender
sSimpleLineSolver_NEW (Text -> (Text, Int)
nextmsg Text
"case 14") (forall a. TransformMe a => a -> a
transformMe_rotateLeft CartRotationReflection
crr) (forall a. TransformMe a => a -> a
transformMe_rotateLeft SimpleLineSolverParameters_NEW
sls) (forall a. TransformMe a => a -> a
transformMe_rotateLeft ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1) (forall a. TransformMe a => a -> a
transformMe_rotateLeft ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2)

  finaloutput :: LineAnchorsForRender
finaloutput = if Int
depth forall a. Ord a => a -> a -> Bool
> Int
10
    then forall a t. (HasCallStack, IsText t) => t -> a
error Text
errormsg
    else LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_simplify LineAnchorsForRender
anchors

doesLineContain :: XY -> XY -> (CartDir, Int, Bool) -> Maybe Int
doesLineContain :: XY -> XY -> (CartDir, Int, Bool) -> Maybe Int
doesLineContain (V2 Int
px Int
py) (V2 Int
sx Int
sy) (CartDir
tcd, Int
tl, Bool
_) = case CartDir
tcd of
  CartDir
CD_Left | Int
py forall a. Eq a => a -> a -> Bool
== Int
sy -> if Int
px forall a. Ord a => a -> a -> Bool
<= Int
sx Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
>= Int
sxforall a. Num a => a -> a -> a
-Int
tl then forall a. a -> Maybe a
Just (Int
sxforall a. Num a => a -> a -> a
-Int
px) else forall a. Maybe a
Nothing
  CartDir
CD_Right | Int
py forall a. Eq a => a -> a -> Bool
== Int
sy -> if Int
px forall a. Ord a => a -> a -> Bool
>= Int
sx Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
<= Int
sxforall a. Num a => a -> a -> a
+Int
tl then forall a. a -> Maybe a
Just (Int
pxforall a. Num a => a -> a -> a
-Int
sx) else forall a. Maybe a
Nothing
  CartDir
CD_Up | Int
px forall a. Eq a => a -> a -> Bool
== Int
sx -> if Int
py forall a. Ord a => a -> a -> Bool
<= Int
sy Bool -> Bool -> Bool
&& Int
py forall a. Ord a => a -> a -> Bool
>= Int
syforall a. Num a => a -> a -> a
-Int
tl then forall a. a -> Maybe a
Just (Int
syforall a. Num a => a -> a -> a
-Int
py) else forall a. Maybe a
Nothing
  CartDir
CD_Down | Int
px forall a. Eq a => a -> a -> Bool
== Int
sx -> if Int
py forall a. Ord a => a -> a -> Bool
>= Int
sy Bool -> Bool -> Bool
&& Int
py forall a. Ord a => a -> a -> Bool
<= Int
syforall a. Num a => a -> a -> a
+Int
tl then forall a. a -> Maybe a
Just (Int
pyforall a. Num a => a -> a -> a
-Int
sy) else forall a. Maybe a
Nothing
  CartDir
_ -> forall a. Maybe a
Nothing

-- TODO test
doesLineContainBox :: LBox -> XY -> (CartDir, Int, Bool) -> Bool
doesLineContainBox :: LBox -> XY -> (CartDir, Int, Bool) -> Bool
doesLineContainBox LBox
lbox (V2 Int
sx Int
sy) (CartDir
tcd, Int
tl, Bool
_) = Bool
r where
  (Int
x,Int
y, Int
w,Int
h) = case CartDir
tcd of
    CartDir
CD_Left  -> (Int
sxforall a. Num a => a -> a -> a
-Int
tl, Int
sy, Int
tlforall a. Num a => a -> a -> a
+Int
1, Int
1)
    CartDir
CD_Right -> (Int
sx, Int
sy, Int
tlforall a. Num a => a -> a -> a
+Int
1, Int
1)
    CartDir
CD_Up    -> (Int
sx, Int
syforall a. Num a => a -> a -> a
-Int
tl, Int
1, Int
tlforall a. Num a => a -> a -> a
+Int
1)
    CartDir
CD_Down  -> (Int
sx, Int
sy, Int
1, Int
tlforall a. Num a => a -> a -> a
+Int
1)
  lbox2 :: LBox
lbox2 = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
x Int
y) (forall a. a -> a -> V2 a
V2 Int
w Int
h)
  r :: Bool
r = LBox -> LBox -> Bool
does_lBox_intersect LBox
lbox LBox
lbox2


walkToRender :: SuperStyle -> LineStyle -> LineStyle -> Bool -> XY -> (CartDir, Int, Bool) -> Maybe (CartDir, Int, Bool) -> Int -> (XY, MPChar)
walkToRender :: SuperStyle
-> LineStyle
-> LineStyle
-> Bool
-> XY
-> (CartDir, Int, Bool)
-> Maybe (CartDir, Int, Bool)
-> Int
-> (XY, MPChar)
walkToRender SuperStyle
ss LineStyle
ls LineStyle
lse Bool
isstart XY
begin (CartDir
tcd, Int
tl, Bool
_) Maybe (CartDir, Int, Bool)
mnext Int
d = (XY, MPChar)
r where
  currentpos :: XY
currentpos = XY
begin forall a. Num a => a -> a -> a
+ (CartDir -> XY
cartDirToUnit CartDir
tcd) forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Int
d

  endorelbow :: MPChar
endorelbow = SuperStyle -> LineStyle -> AnchorType -> MPChar
renderAnchorType SuperStyle
ss LineStyle
lse forall a b. (a -> b) -> a -> b
$ CartDir -> Maybe CartDir -> AnchorType
cartDirToAnchor CartDir
tcd (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b c. (a, b, c) -> a
fst3 Maybe (CartDir, Int, Bool)
mnext)
  startorregular :: MPChar
startorregular = if Bool
isstart
    then if Int
d forall a. Ord a => a -> a -> Bool
<= Int
tl forall a. Integral a => a -> a -> a
`div` Int
2
      -- if we are at the start and near the beginning then render start of line
      then SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle
ss LineStyle
ls (CartDir -> CartDir
flipCartDir CartDir
tcd) Int
d
      else if forall a. Maybe a -> Bool
isNothing Maybe (CartDir, Int, Bool)
mnext
        -- if we are not at the start and at the end then render end of line
        then SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle
ss LineStyle
ls CartDir
tcd (Int
tlforall a. Num a => a -> a -> a
-Int
d)
        -- otherwise render line as usual
        else SuperStyle -> CartDir -> MPChar
renderLine SuperStyle
ss CartDir
tcd
    else SuperStyle -> CartDir -> MPChar
renderLine SuperStyle
ss CartDir
tcd
  r :: (XY, MPChar)
r = if Int
d forall a. Eq a => a -> a -> Bool
== Int
tl
    then (XY
currentpos, MPChar
endorelbow)
    else (XY
currentpos, MPChar
startorregular)

lineAnchorsForRender_length :: LineAnchorsForRender -> Int
lineAnchorsForRender_length :: LineAnchorsForRender -> Int
lineAnchorsForRender_length LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} = Int
r where
  foldfn :: (a, a, c) -> a -> a
foldfn (a
_,a
d,c
_) a
acc = a
acc forall a. Num a => a -> a -> a
+ a
d
  r :: Int
r = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a} {c}. Num a => (a, a, c) -> a -> a
foldfn Int
1 [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest

lineAnchorsForRender_renderAt :: SuperStyle -> LineStyle -> LineStyle -> LineAnchorsForRender -> XY -> MPChar
lineAnchorsForRender_renderAt :: SuperStyle
-> LineStyle -> LineStyle -> LineAnchorsForRender -> XY -> MPChar
lineAnchorsForRender_renderAt SuperStyle
ss LineStyle
ls LineStyle
lse LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} XY
pos = MPChar
r where
  walk :: (Bool, XY) -> [(CartDir, Int, Bool)] -> Maybe (XY, MPChar)
walk (Bool
isstart, XY
curbegin) [(CartDir, Int, Bool)]
a = case [(CartDir, Int, Bool)]
a of
    [] -> forall a. Maybe a
Nothing
    (CartDir, Int, Bool)
x:[(CartDir, Int, Bool)]
xs -> case XY -> XY -> (CartDir, Int, Bool) -> Maybe Int
doesLineContain XY
pos XY
curbegin (CartDir, Int, Bool)
x of
      Maybe Int
Nothing ->  (Bool, XY) -> [(CartDir, Int, Bool)] -> Maybe (XY, MPChar)
walk (Bool
False, XY
nextbegin) [(CartDir, Int, Bool)]
xs
      Just Int
d -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case [(CartDir, Int, Bool)]
xs of
        []  -> SuperStyle
-> LineStyle
-> LineStyle
-> Bool
-> XY
-> (CartDir, Int, Bool)
-> Maybe (CartDir, Int, Bool)
-> Int
-> (XY, MPChar)
walkToRender SuperStyle
ss LineStyle
ls LineStyle
lse Bool
isstart XY
curbegin (CartDir, Int, Bool)
x forall a. Maybe a
Nothing Int
d
        (CartDir, Int, Bool)
y:[(CartDir, Int, Bool)]
_ -> SuperStyle
-> LineStyle
-> LineStyle
-> Bool
-> XY
-> (CartDir, Int, Bool)
-> Maybe (CartDir, Int, Bool)
-> Int
-> (XY, MPChar)
walkToRender SuperStyle
ss LineStyle
ls LineStyle
lse Bool
isstart XY
curbegin (CartDir, Int, Bool)
x (forall a. a -> Maybe a
Just (CartDir, Int, Bool)
y) Int
d
      where
        nextbegin :: XY
nextbegin = XY
curbegin forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir, Int, Bool)
x

  manswer :: Maybe (XY, MPChar)
manswer = (Bool, XY) -> [(CartDir, Int, Bool)] -> Maybe (XY, MPChar)
walk (Bool
True, XY
_lineAnchorsForRender_start) [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest
  r :: MPChar
r = case Maybe (XY, MPChar)
manswer of
    Maybe (XY, MPChar)
Nothing             -> forall a. Maybe a
Nothing
    Just (XY
pos', MPChar
mpchar) -> forall a. HasCallStack => Bool -> a -> a
assert (XY
pos forall a. Eq a => a -> a -> Bool
== XY
pos') MPChar
mpchar

-- UNTESTED
-- returns index of subsegment that intersects with pos
-- e.g.
--      0 ---(x)-- 1 ------ 2
-- returns Just 0
lineAnchorsForRender_findIntersectingSubsegment :: LineAnchorsForRender -> XY -> Maybe Int
lineAnchorsForRender_findIntersectingSubsegment :: LineAnchorsForRender -> XY -> Maybe Int
lineAnchorsForRender_findIntersectingSubsegment  LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} XY
pos = Maybe Int
r where
  walk :: Int -> XY -> [(CartDir, Int, Bool)] -> Maybe Int
walk Int
i XY
curbegin [(CartDir, Int, Bool)]
a = case [(CartDir, Int, Bool)]
a of
    [] -> forall a. Maybe a
Nothing
    x :: (CartDir, Int, Bool)
x@(CartDir
_,Int
_,Bool
s):[(CartDir, Int, Bool)]
xs -> case XY -> XY -> (CartDir, Int, Bool) -> Maybe Int
doesLineContain XY
pos XY
curbegin (CartDir, Int, Bool)
x of
      Maybe Int
Nothing ->  Int -> XY -> [(CartDir, Int, Bool)] -> Maybe Int
walk Int
new_i (XY
curbegin forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir, Int, Bool)
x) [(CartDir, Int, Bool)]
xs
      Just Int
_  -> forall a. a -> Maybe a
Just Int
new_i
      where new_i :: Int
new_i = if Bool
s then Int
iforall a. Num a => a -> a -> a
+Int
1 else Int
i
  r :: Maybe Int
r = Int -> XY -> [(CartDir, Int, Bool)] -> Maybe Int
walk (-Int
1) XY
_lineAnchorsForRender_start [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest

lineAnchorsForRender_doesIntersectPoint :: LineAnchorsForRender -> XY -> Bool
lineAnchorsForRender_doesIntersectPoint :: LineAnchorsForRender -> XY -> Bool
lineAnchorsForRender_doesIntersectPoint LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} XY
pos = Bool
r where
  walk :: XY -> [(CartDir, Int, Bool)] -> Bool
walk XY
curbegin [(CartDir, Int, Bool)]
a = case [(CartDir, Int, Bool)]
a of
    [] -> Bool
False
    (CartDir, Int, Bool)
x:[(CartDir, Int, Bool)]
xs -> case XY -> XY -> (CartDir, Int, Bool) -> Maybe Int
doesLineContain XY
pos XY
curbegin (CartDir, Int, Bool)
x of
      Maybe Int
Nothing ->  XY -> [(CartDir, Int, Bool)] -> Bool
walk (XY
curbegin forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir, Int, Bool)
x) [(CartDir, Int, Bool)]
xs

      Just Int
_  -> Bool
True
  r :: Bool
r = XY -> [(CartDir, Int, Bool)] -> Bool
walk XY
_lineAnchorsForRender_start [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest


lineAnchorsForRender_doesIntersectBox :: LineAnchorsForRender -> LBox -> Bool
lineAnchorsForRender_doesIntersectBox :: LineAnchorsForRender -> LBox -> Bool
lineAnchorsForRender_doesIntersectBox LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
..} LBox
lbox = Bool
r where
  walk :: XY -> [(CartDir, Int, Bool)] -> Bool
walk XY
curbegin [(CartDir, Int, Bool)]
a = case [(CartDir, Int, Bool)]
a of
    [] -> Bool
False
    (CartDir, Int, Bool)
x:[(CartDir, Int, Bool)]
xs -> if LBox -> XY -> (CartDir, Int, Bool) -> Bool
doesLineContainBox LBox
lbox XY
curbegin (CartDir, Int, Bool)
x
      then Bool
True
      else XY -> [(CartDir, Int, Bool)] -> Bool
walk (XY
curbegin forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir, Int, Bool)
x) [(CartDir, Int, Bool)]
xs
  r :: Bool
r = XY -> [(CartDir, Int, Bool)] -> Bool
walk XY
_lineAnchorsForRender_start [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest



renderLabelFn :: (XY, SAutoLineLabel) -> XY -> MPChar
renderLabelFn :: (XY, SAutoLineLabel) -> XY -> MPChar
renderLabelFn (V2 Int
llx Int
lly, SAutoLineLabel
llabel) (V2 Int
x Int
y) = MPChar
r where
  text :: Text
text = SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
  tz :: TextZipper
tz = TextZipper -> TextZipper
TZ.top (Text -> TextZipper
TZ.fromText Text
text)
  dl :: DisplayLines Int
dl = forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
TZ.TextAlignment_Left forall a. Bounded a => a
maxBound Int
0 Int
1 TextZipper
tz
  offset :: (Int, Int)
offset = (- (Text -> Int
T.length Text
text) forall a. Integral a => a -> a -> a
`div` Int
2, Int
0)
  r :: MPChar
r = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ (Int, Int)
-> DisplayLines Int -> (Int, Int) -> (Int, Int) -> Maybe MPChar
displayLinesToChar (Int
llx, Int
lly) DisplayLines Int
dl (Int
x,Int
y) (Int, Int)
offset



-- TODO also render labels
sSimpleLineNewRenderFn :: SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer
sSimpleLineNewRenderFn :: SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer
sSimpleLineNewRenderFn ssline :: SAutoLine
ssline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
..} Maybe LineAnchorsForRender
mcache = SEltDrawer
drawer where

  getAnchors :: (HasOwlTree a) => a -> LineAnchorsForRender
  getAnchors :: forall a. HasOwlTree a => a -> LineAnchorsForRender
getAnchors a
ot = case Maybe LineAnchorsForRender
mcache of
    Just LineAnchorsForRender
x  -> LineAnchorsForRender
x
    Maybe LineAnchorsForRender
Nothing -> forall a. HasOwlTree a => a -> SAutoLine -> LineAnchorsForRender
sSimpleLineNewRenderFnComputeCache a
ot SAutoLine
ssline

  renderfn :: SEltDrawerRenderFn
  renderfn :: SEltDrawerRenderFn
renderfn a
ot XY
xy = MPChar
r where
    anchors :: LineAnchorsForRender
anchors = forall a. HasOwlTree a => a -> LineAnchorsForRender
getAnchors a
ot


    -- m1 takes priority over m2
    mergeMaybe :: MPChar -> MPChar -> MPChar
    mergeMaybe :: MPChar -> MPChar -> MPChar
mergeMaybe MPChar
m1 MPChar
m2 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe MPChar
m2 forall a. a -> Maybe a
Just MPChar
m1

    -- TODO someday cache this too
    llabels :: [(XY, Int, SAutoLineLabel)]
llabels = forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions a
ot SAutoLine
ssline
    llabelsrendered :: [MPChar]
llabelsrendered = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(XY
pos,Int
_,SAutoLineLabel
llabel) -> (XY, SAutoLineLabel) -> XY -> MPChar
renderLabelFn (XY
pos, SAutoLineLabel
llabel) XY
xy) [(XY, Int, SAutoLineLabel)]
llabels
    mlabelchar :: MPChar
mlabelchar = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MPChar -> MPChar -> MPChar
mergeMaybe forall a. Maybe a
Nothing [MPChar]
llabelsrendered
    mlinechar :: MPChar
mlinechar = SuperStyle
-> LineStyle -> LineStyle -> LineAnchorsForRender -> XY -> MPChar
lineAnchorsForRender_renderAt SuperStyle
_sAutoLine_superStyle LineStyle
_sAutoLine_lineStyle LineStyle
_sAutoLine_lineStyleEnd LineAnchorsForRender
anchors XY
xy

    -- render label over lines
    r :: MPChar
r = MPChar -> MPChar -> MPChar
mergeMaybe MPChar
mlabelchar MPChar
mlinechar

  boxfn :: SEltDrawerBoxFn
  boxfn :: SEltDrawerBoxFn
boxfn a
ot = LBox
r where
    anchorbox :: LBox
anchorbox = case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (LineAnchorsForRender -> [XY]
lineAnchorsForRender_toPointList (forall a. HasOwlTree a => a -> LineAnchorsForRender
getAnchors a
ot)) of
      Maybe (NonEmpty XY)
Nothing -> XY -> XY -> LBox
LBox XY
0 XY
0
      -- add_XY_to_lBox is non-inclusive with bottom/right so we expand by 1 to make it inclusive
      Just (XY
x :| [XY]
xs) -> LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip XY -> LBox -> LBox
add_XY_to_lBox) (XY -> LBox
make_0area_lBox_from_XY XY
x) [XY]
xs) (Int
0,Int
1,Int
0,Int
1)

    -- UNTESTED
    -- TODO someday cache this too
    llabels :: [(XY, Int, SAutoLineLabel)]
llabels = forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions a
ot SAutoLine
ssline
    llabelbox :: XY -> SAutoLineLabel -> LBox
llabelbox (V2 Int
x Int
y) SAutoLineLabel
llabel = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 (Int
x forall a. Num a => a -> a -> a
- Int
wover2) Int
y) (forall a. a -> a -> V2 a
V2 Int
w Int
1) where
      w :: Int
w = Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
      wover2 :: Int
wover2 = (Int
wforall a. Num a => a -> a -> a
+Int
1) forall a. Integral a => a -> a -> a
`div` Int
2
    mlabelbox :: Maybe LBox
mlabelbox = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(XY
pos, Int
_, SAutoLineLabel
llabel) Maybe LBox
mbox -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ XY -> SAutoLineLabel -> LBox
llabelbox XY
pos SAutoLineLabel
llabel) (\LBox
box -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LBox
box LBox -> LBox -> LBox
`union_lBox` XY -> SAutoLineLabel -> LBox
llabelbox XY
pos SAutoLineLabel
llabel) Maybe LBox
mbox) forall a. Maybe a
Nothing [(XY, Int, SAutoLineLabel)]
llabels

    r :: LBox
r = case Maybe LBox
mlabelbox of
      Maybe LBox
Nothing       -> LBox
anchorbox
      Just LBox
labelbox -> LBox -> LBox -> LBox
union_lBox LBox
anchorbox LBox
labelbox



  drawer :: SEltDrawer
drawer = SEltDrawer {
      _sEltDrawer_box :: SEltDrawerBoxFn
_sEltDrawer_box = SEltDrawerBoxFn
boxfn
      , _sEltDrawer_renderFn :: SEltDrawerRenderFn
_sEltDrawer_renderFn = SEltDrawerRenderFn
renderfn

      -- TODO
      , _sEltDrawer_maxCharWidth :: Int
_sEltDrawer_maxCharWidth = Int
1
    }

lineAnchorsForRender_concat :: [LineAnchorsForRender] -> LineAnchorsForRender
lineAnchorsForRender_concat :: [LineAnchorsForRender] -> LineAnchorsForRender
lineAnchorsForRender_concat [] = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected at least one LineAnchorsForRender"
lineAnchorsForRender_concat (LineAnchorsForRender
x:[LineAnchorsForRender]
xs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LineAnchorsForRender
-> LineAnchorsForRender -> LineAnchorsForRender
foldfn LineAnchorsForRender
x [LineAnchorsForRender]
xs where
  -- TODO re-enable assert when it gets fixed
  foldfn :: LineAnchorsForRender
-> LineAnchorsForRender -> LineAnchorsForRender
foldfn LineAnchorsForRender
h LineAnchorsForRender
c = --assert (lineAnchorsForRender_end h == _lineAnchorsForRender_start c) $
    LineAnchorsForRender
h { _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest LineAnchorsForRender
h forall a. Semigroup a => a -> a -> a
<> LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest LineAnchorsForRender
c }


pairs :: [a] -> [(a, a)]
pairs :: forall a. [a] -> [(a, a)]
pairs [] = []
pairs [a]
xs = forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs (forall a. [a] -> [a]
tail [a]
xs)


maybeGetAttachBox_NEW2 :: (HasOwlTree a) => a -> Maybe Attachment -> Maybe BoxWithAttachmentLocation
maybeGetAttachBox_NEW2 :: forall a.
HasOwlTree a =>
a
-> Maybe Attachment
-> Maybe (LBox, AttachmentLocation, AttachmentOffsetRatio)
maybeGetAttachBox_NEW2 a
ot Maybe Attachment
mattachment = do
  Attachment Int
rid AttachmentLocation
al AttachmentOffsetRatio
ratio <- Maybe Attachment
mattachment
  SuperOwl
sowl <- forall o. HasOwlTree o => o -> Int -> Maybe SuperOwl
hasOwlTree_findSuperOwl a
ot Int
rid
  LBox
sbox <- SElt -> Maybe LBox
getSEltBox_naive forall a b. (a -> b) -> a -> b
$ forall o. HasOwlItem o => o -> SElt
hasOwlItem_toSElt_hack SuperOwl
sowl
  return (LBox
sbox, AttachmentLocation
al, AttachmentOffsetRatio
ratio)

-- returns a list of LineAnchorsForRender, one for each segment separated by midpoints
sAutoLine_to_lineAnchorsForRenderList :: (HasOwlTree a) => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList :: forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} = [LineAnchorsForRender]
anchorss where

  -- TODO set properly
  params :: SimpleLineSolverParameters_NEW
params = SimpleLineSolverParameters_NEW {
      -- TODO maybe set this based on arrow head size (will differ for each end so you need 4x)
      _simpleLineSolverParameters_NEW_attachOffset :: Int
_simpleLineSolverParameters_NEW_attachOffset = Int
1
    }

  startlbal :: ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
startlbal = case forall a.
HasOwlTree a =>
a
-> Maybe Attachment
-> Maybe (LBox, AttachmentLocation, AttachmentOffsetRatio)
maybeGetAttachBox_NEW2 a
ot Maybe Attachment
_sAutoLine_attachStart of
    Maybe (LBox, AttachmentLocation, AttachmentOffsetRatio)
Nothing    -> ((XY -> XY -> LBox
LBox XY
_sAutoLine_start XY
1, AttachmentLocation
AL_Any, AttachmentOffsetRatio
attachment_offset_rel_default), Bool -> OffsetBorder
OffsetBorder Bool
False)
    Just (LBox, AttachmentLocation, AttachmentOffsetRatio)
bal -> ((LBox, AttachmentLocation, AttachmentOffsetRatio)
bal, Bool -> OffsetBorder
OffsetBorder Bool
True)
  endlbal :: ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
endlbal = case forall a.
HasOwlTree a =>
a
-> Maybe Attachment
-> Maybe (LBox, AttachmentLocation, AttachmentOffsetRatio)
maybeGetAttachBox_NEW2 a
ot Maybe Attachment
_sAutoLine_attachEnd of
    Maybe (LBox, AttachmentLocation, AttachmentOffsetRatio)
Nothing    -> ((XY -> XY -> LBox
LBox XY
_sAutoLine_end XY
1, AttachmentLocation
AL_Any, AttachmentOffsetRatio
attachment_offset_rel_default), Bool -> OffsetBorder
OffsetBorder Bool
False)
    Just (LBox, AttachmentLocation, AttachmentOffsetRatio)
bal -> ((LBox, AttachmentLocation, AttachmentOffsetRatio)
bal, Bool -> OffsetBorder
OffsetBorder Bool
True)
  midlbals :: [((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)]
midlbals = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SAutoLineConstraintFixed XY
xy) ->   ((XY -> XY -> LBox
LBox XY
xy XY
1, AttachmentLocation
AL_Any, AttachmentOffsetRatio
attachment_offset_rel_default), Bool -> OffsetBorder
OffsetBorder Bool
False)) [SAutoLineConstraint]
_sAutoLine_midpoints

  -- ???? TODO BUG this is a problem, you need selective offsetting for each side of the box, in particular, midpoints can't offset and the point needs to land exactly on the midpoint
  -- NOTE for some reason sticking trace statements in sSimpleLineSolver will causes regenanchors to get called infinite times :(
  anchorss :: [LineAnchorsForRender]
anchorss = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1, ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2) -> (Text, Int)
-> CartRotationReflection
-> SimpleLineSolverParameters_NEW
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
    OffsetBorder)
-> LineAnchorsForRender
sSimpleLineSolver_NEW (Text
"",Int
0) CartRotationReflection
cartRotationReflection_identity SimpleLineSolverParameters_NEW
params ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1 ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(a, a)]
pairs ((((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
startlbal forall a. a -> [a] -> [a]
: [((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)]
midlbals) forall a. Semigroup a => a -> a -> a
<> [((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
endlbal])

sSimpleLineNewRenderFnComputeCache :: (HasOwlTree a) => a -> SAutoLine -> LineAnchorsForRender
sSimpleLineNewRenderFnComputeCache :: forall a. HasOwlTree a => a -> SAutoLine -> LineAnchorsForRender
sSimpleLineNewRenderFnComputeCache a
ot SAutoLine
sline = LineAnchorsForRender
anchors where
  anchors :: LineAnchorsForRender
anchors = LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_simplify forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LineAnchorsForRender] -> LineAnchorsForRender
lineAnchorsForRender_concat forall a b. (a -> b) -> a -> b
$ forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
sline

internal_getSAutoLineLabelPosition_walk :: LineAnchorsForRender -> Int -> XY
internal_getSAutoLineLabelPosition_walk :: LineAnchorsForRender -> Int -> XY
internal_getSAutoLineLabelPosition_walk LineAnchorsForRender
lar Int
targetd = XY
r where
  walk :: [(CartDir, Int, Bool)] -> XY -> Int -> XY
walk [] XY
curbegin Int
_ = XY
curbegin
  walk (x :: (CartDir, Int, Bool)
x@(CartDir
cd,Int
d,Bool
_):[(CartDir, Int, Bool)]
rest) XY
curbegin Int
traveld = XY
r2 where
    nextbegin :: XY
nextbegin = XY
curbegin forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir, Int, Bool)
x
    r2 :: XY
r2 = if Int
traveld forall a. Num a => a -> a -> a
+ Int
d forall a. Ord a => a -> a -> Bool
>= Int
targetd
      then XY
curbegin forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir
cd, Int
targetd forall a. Num a => a -> a -> a
- Int
traveld, forall a. HasCallStack => a
undefined) -- why undefined -__- lol
      else [(CartDir, Int, Bool)] -> XY -> Int -> XY
walk [(CartDir, Int, Bool)]
rest XY
nextbegin (Int
traveld forall a. Num a => a -> a -> a
+ Int
d)
  r :: XY
r = [(CartDir, Int, Bool)] -> XY -> Int -> XY
walk (LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest LineAnchorsForRender
lar) (LineAnchorsForRender -> XY
_lineAnchorsForRender_start LineAnchorsForRender
lar) Int
0

-- TODO remove SAutoLine arg
internal_getSAutoLineLabelPosition :: LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
internal_getSAutoLineLabelPosition :: LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
internal_getSAutoLineLabelPosition LineAnchorsForRender
lar SAutoLine
_ SAutoLineLabel {Int
Text
SAutoLineLabelPosition
_sAutoLineLabel_position :: SAutoLineLabel -> SAutoLineLabelPosition
_sAutoLineLabel_index :: SAutoLineLabel -> Int
_sAutoLineLabel_text :: Text
_sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_index :: Int
_sAutoLineLabel_text :: SAutoLineLabel -> Text
..} = XY
r where
  totall :: Int
totall = LineAnchorsForRender -> Int
lineAnchorsForRender_length LineAnchorsForRender
lar
  targetd :: Int
targetd = case SAutoLineLabelPosition
_sAutoLineLabel_position of
    SAutoLineLabelPositionRelative Float
rp -> forall a. Ord a => a -> a -> a
max Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totall forall a. Num a => a -> a -> a
* Float
rp)
  r :: XY
r = LineAnchorsForRender -> Int -> XY
internal_getSAutoLineLabelPosition_walk LineAnchorsForRender
lar Int
targetd

getSAutoLineLabelPositionFromLineAnchorsForRender :: LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPositionFromLineAnchorsForRender :: LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPositionFromLineAnchorsForRender LineAnchorsForRender
lar SAutoLine
sal SAutoLineLabel
sall = LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
internal_getSAutoLineLabelPosition LineAnchorsForRender
lar SAutoLine
sal SAutoLineLabel
sall

-- the SAutoLineLabel does not have to be one of labels contained in the SAutoLine _sAutoLine_labels
-- which is useful for positioning SAutoLineLabel before adding them to SAutoLine
-- however the midpoint index in SAutoLineLabel is expected to map correctly to the SAutoLine
getSAutoLineLabelPosition :: (HasCallStack, HasOwlTree a) => a -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPosition :: forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPosition a
ot SAutoLine
sal SAutoLineLabel
sall = LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPositionFromLineAnchorsForRender LineAnchorsForRender
lar SAutoLine
sal SAutoLineLabel
sall where
  lar :: LineAnchorsForRender
lar = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
sal forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` (SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
sall)

-- get SAutoLineLabel positions in visual order (which may not be the same as logical order)
-- return includes SAutoLineLabel and its original logical index for convenience
getSortedSAutoLineLabelPositions :: (HasCallStack, HasOwlTree a) => a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions :: forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions a
ot sal :: SAutoLine
sal@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} = [(XY, Int, SAutoLineLabel)]
r where
  sortfn :: (a, SAutoLineLabel) -> (a, SAutoLineLabel) -> Ordering
sortfn (a
_,SAutoLineLabel
a) (a
_,SAutoLineLabel
b) = case forall a. Ord a => a -> a -> Ordering
compare (SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
a) (SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
b) of
    Ordering
EQ -> case SAutoLineLabel -> SAutoLineLabelPosition
_sAutoLineLabel_position SAutoLineLabel
a of
      SAutoLineLabelPositionRelative Float
x -> case SAutoLineLabel -> SAutoLineLabelPosition
_sAutoLineLabel_position SAutoLineLabel
b of
        SAutoLineLabelPositionRelative Float
y -> forall a. Ord a => a -> a -> Ordering
compare Float
x Float
y
    Ordering
x -> Ordering
x
  sortedlls :: [(Int, SAutoLineLabel)]
sortedlls = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {a} {a}.
(a, SAutoLineLabel) -> (a, SAutoLineLabel) -> Ordering
sortfn forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [(Int, a)]
L.indexed [SAutoLineLabel]
_sAutoLine_labels

  larlist :: [LineAnchorsForRender]
larlist = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
sal

  r :: [(XY, Int, SAutoLineLabel)]
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
i, SAutoLineLabel
sall) -> (LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
internal_getSAutoLineLabelPosition ([LineAnchorsForRender]
larlist forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
sall) SAutoLine
sal SAutoLineLabel
sall, Int
i, SAutoLineLabel
sall)) [(Int, SAutoLineLabel)]
sortedlls


-- takes a list of line anchors as returned by sAutoLine_to_lineAnchorsForRenderList and a position
-- returns closest orthognally projected point on the line as a tuple (projected position, index into larlist, relative distance along the LineAnchorsForRender that the point is on)
getClosestPointOnLineFromLineAnchorsForRenderList :: [LineAnchorsForRender] -> XY -> (XY, Int, Float)
getClosestPointOnLineFromLineAnchorsForRenderList :: [LineAnchorsForRender] -> XY -> (XY, Int, Float)
getClosestPointOnLineFromLineAnchorsForRenderList [LineAnchorsForRender]
larlist pos :: XY
pos@(V2 Int
posx Int
posy) = (XY, Int, Float)
r where

  foldlfn ::
    (Int, (XY, Int, Float), Int) -- (previous closest distance to line, (prev closest position, index into larlist, rel distance on segment))
    -> LineAnchorsForRender
    -> (Int, (XY, Int, Float), Int)
  foldlfn :: (Int, (XY, Int, Float), Int)
-> LineAnchorsForRender -> (Int, (XY, Int, Float), Int)
foldlfn (Int
closestd, (XY, Int, Float)
closestp, Int
curindex) LineAnchorsForRender
lar = (Int, (XY, Int, Float), Int)
r2 where


    foldlfn2 ::
      (Int, XY, Int, Maybe (Int, XY)) -- (total distance we traveled so far, current anchor position, prev closest distance to line (includes second fold results up until now), Maybe (how far we traveled to new closest point on line, new closest point))
      -> (CartDir, Int, Bool)
      -> (Int, XY, Int, Maybe (Int, XY))
    foldlfn2 :: (Int, XY, Int, Maybe (Int, XY))
-> (CartDir, Int, Bool) -> (Int, XY, Int, Maybe (Int, XY))
foldlfn2 (Int
traveld, curp :: XY
curp@(V2 Int
curx Int
cury), Int
closestd2, Maybe (Int, XY)
mnewclosestpos2) cdwd :: (CartDir, Int, Bool)
cdwd@(CartDir
cd,Int
d,Bool
_) = (Int, XY, Int, Maybe (Int, XY))
r3 where

      between :: Int -> Int -> Int -> Bool
      between :: Int -> Int -> Int -> Bool
between Int
p Int
a Int
b = (Int
p forall a. Ord a => a -> a -> Bool
>= Int
a Bool -> Bool -> Bool
&& Int
p forall a. Ord a => a -> a -> Bool
<= Int
b) Bool -> Bool -> Bool
|| (Int
p forall a. Ord a => a -> a -> Bool
<= Int
a Bool -> Bool -> Bool
&& Int
p forall a. Ord a => a -> a -> Bool
>= Int
b)

      xydistance :: XY -> XY -> Float
      xydistance :: XY -> XY -> Float
xydistance (V2 Int
ax Int
ay) (V2 Int
bx Int
by) = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (forall a. a -> a -> V2 a
V2 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ax forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bx) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ay forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
by))


      endp :: XY
endp@(V2 Int
endx Int
endy) = XY
curp forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2  (CartDir, Int, Bool)
cdwd

      dtoend :: Float
dtoend = (XY -> XY -> Float
xydistance XY
pos XY
endp)
      dtocur :: Float
dtocur = (XY -> XY -> Float
xydistance XY
pos XY
curp)

      dandpostostartorend :: (Float, XY)
dandpostostartorend = if Float
dtocur forall a. Ord a => a -> a -> Bool
< Float
dtoend
        then (Float
dtocur, XY
curp)
        else (Float
dtoend, XY
endp)

      -- project pos onto each segment
      (Float
projd, XY
projp) = if CartDir
cd forall a. Eq a => a -> a -> Bool
== CartDir
CD_Up Bool -> Bool -> Bool
|| CartDir
cd forall a. Eq a => a -> a -> Bool
== CartDir
CD_Down
        -- project horizontally
        then if Int -> Int -> Int -> Bool
between Int
posy Int
cury Int
endy
          -- if projection in bounds
          then (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs (Int
curx forall a. Num a => a -> a -> a
- Int
posx), forall a. a -> a -> V2 a
V2 Int
curx Int
posy)
          else  (Float, XY)
dandpostostartorend
        -- project vertically
        else if Int -> Int -> Int -> Bool
between Int
posx Int
curx Int
endx
          -- if projection in bounds
          then (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs (Int
cury forall a. Num a => a -> a -> a
- Int
posy), forall a. a -> a -> V2 a
V2 Int
posx Int
cury)
          else (Float, XY)
dandpostostartorend

      -- if we are closer than previous closest point
      r3 :: (Int, XY, Int, Maybe (Int, XY))
r3 = if Float
projd forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
closestd2
        -- update the new closest point
        then (Int
traveld forall a. Num a => a -> a -> a
+ Int
d, XY
endp, forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
projd, forall a. a -> Maybe a
Just (Int
traveld forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
floor (XY -> XY -> Float
xydistance XY
curp XY
projp), XY
projp))
        -- same as before, keep going
        else (Int
traveld forall a. Num a => a -> a -> a
+ Int
d, XY
endp, Int
closestd2, Maybe (Int, XY)
mnewclosestpos2)

    -- walk through each segment in lar
    (Int
totald, XY
_, Int
newclosestd, Maybe (Int, XY)
mnewclosestpos) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl (Int, XY, Int, Maybe (Int, XY))
-> (CartDir, Int, Bool) -> (Int, XY, Int, Maybe (Int, XY))
foldlfn2 (Int
0, LineAnchorsForRender -> XY
_lineAnchorsForRender_start LineAnchorsForRender
lar, Int
closestd, forall a. Maybe a
Nothing) (LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest LineAnchorsForRender
lar)

    r2 :: (Int, (XY, Int, Float), Int)
r2 = case Maybe (Int, XY)
mnewclosestpos of
      -- did not find a closer point on lar
      Maybe (Int, XY)
Nothing -> (Int
closestd, (XY, Int, Float)
closestp, Int
curindexforall a. Num a => a -> a -> a
+Int
1)
      Just (Int
newclosesttraveld, XY
newclosestp) -> (Int
newclosestd, (XY
newclosestp, Int
curindex, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newclosesttraveld forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totald), Int
curindexforall a. Num a => a -> a -> a
+Int
1)

  (Int
_,(XY, Int, Float)
r,Int
_) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl (Int, (XY, Int, Float), Int)
-> LineAnchorsForRender -> (Int, (XY, Int, Float), Int)
foldlfn (forall a. Bounded a => a
maxBound :: Int, (XY
0,Int
0,Float
0), Int
0) [LineAnchorsForRender]
larlist