{-# 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
, 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)
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 (LBox -> (Int, Int, Int, Int)) -> LBox -> (Int, Int, Int, Int)
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 (LBox -> (Int, Int, Int, Int)) -> LBox -> (Int, Int, Int, Int)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r2 Bool -> Bool -> Bool
|| Int
l2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
r1
vsep :: Bool
vsep = Int
t1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b2 Bool -> Bool -> Bool
|| Int
t2 Int -> Int -> Bool
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
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
T.length Text
t
then MPChar -> Maybe MPChar
forall a. a -> Maybe a
Just (MPChar -> Maybe MPChar) -> MPChar -> Maybe MPChar
forall a b. (a -> b) -> a -> b
$ (Char -> MPChar
forall a. a -> Maybe a
Just (Char -> MPChar) -> Char -> MPChar
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Int -> Char
Text -> Int -> Char
T.index Text
t Int
i)
else Maybe MPChar
forall a. Maybe a
Nothing
renderLine :: SuperStyle -> CartDir -> MPChar
renderLine :: SuperStyle -> CartDir -> MPChar
renderLine SuperStyle {MPChar
FillStyle
_superStyle_tl :: MPChar
_superStyle_tr :: MPChar
_superStyle_bl :: MPChar
_superStyle_br :: MPChar
_superStyle_vertical :: MPChar
_superStyle_horizontal :: MPChar
_superStyle_point :: MPChar
_superStyle_fill :: FillStyle
_superStyle_tl :: SuperStyle -> MPChar
_superStyle_tr :: SuperStyle -> MPChar
_superStyle_bl :: SuperStyle -> MPChar
_superStyle_br :: SuperStyle -> MPChar
_superStyle_vertical :: SuperStyle -> MPChar
_superStyle_horizontal :: SuperStyle -> MPChar
_superStyle_point :: SuperStyle -> MPChar
_superStyle_fill :: SuperStyle -> FillStyle
..} 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_tl :: SuperStyle -> MPChar
_superStyle_tr :: SuperStyle -> MPChar
_superStyle_bl :: SuperStyle -> MPChar
_superStyle_br :: SuperStyle -> MPChar
_superStyle_vertical :: SuperStyle -> MPChar
_superStyle_horizontal :: SuperStyle -> MPChar
_superStyle_point :: SuperStyle -> MPChar
_superStyle_fill :: SuperStyle -> FillStyle
_superStyle_tl :: MPChar
_superStyle_tr :: MPChar
_superStyle_bl :: MPChar
_superStyle_br :: MPChar
_superStyle_vertical :: MPChar
_superStyle_horizontal :: MPChar
_superStyle_point :: MPChar
_superStyle_fill :: FillStyle
..} LineStyle {Text
_lineStyle_leftArrows :: Text
_lineStyle_rightArrows :: Text
_lineStyle_upArrows :: Text
_lineStyle_downArrows :: Text
_lineStyle_leftArrows :: LineStyle -> Text
_lineStyle_rightArrows :: LineStyle -> Text
_lineStyle_upArrows :: LineStyle -> Text
_lineStyle_downArrows :: LineStyle -> Text
..} CartDir
cd Int
distancefromend = MPChar
r where
r :: MPChar
r = case CartDir
cd of
CartDir
CD_Up -> MPChar -> Maybe MPChar -> MPChar
forall a. a -> Maybe a -> a
fromMaybe MPChar
_superStyle_vertical (Maybe MPChar -> MPChar) -> Maybe MPChar -> MPChar
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe MPChar
maybeIndex Text
_lineStyle_upArrows Int
distancefromend
CartDir
CD_Down -> MPChar -> Maybe MPChar -> MPChar
forall a. a -> Maybe a -> a
fromMaybe MPChar
_superStyle_vertical (Maybe MPChar -> MPChar) -> Maybe MPChar -> MPChar
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe MPChar
maybeIndex (Text -> Text
T.reverse Text
_lineStyle_downArrows) Int
distancefromend
CartDir
CD_Left -> MPChar -> Maybe MPChar -> MPChar
forall a. a -> Maybe a -> a
fromMaybe MPChar
_superStyle_horizontal (Maybe MPChar -> MPChar) -> Maybe MPChar -> MPChar
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe MPChar
maybeIndex Text
_lineStyle_leftArrows Int
distancefromend
CartDir
CD_Right -> MPChar -> Maybe MPChar -> MPChar
forall a. a -> Maybe a -> a
fromMaybe MPChar
_superStyle_horizontal (Maybe MPChar -> MPChar) -> Maybe MPChar -> MPChar
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_tl :: SuperStyle -> MPChar
_superStyle_tr :: SuperStyle -> MPChar
_superStyle_bl :: SuperStyle -> MPChar
_superStyle_br :: SuperStyle -> MPChar
_superStyle_vertical :: SuperStyle -> MPChar
_superStyle_horizontal :: SuperStyle -> MPChar
_superStyle_point :: SuperStyle -> MPChar
_superStyle_fill :: SuperStyle -> FillStyle
_superStyle_tl :: MPChar
_superStyle_tr :: MPChar
_superStyle_bl :: MPChar
_superStyle_br :: MPChar
_superStyle_vertical :: MPChar
_superStyle_horizontal :: MPChar
_superStyle_point :: MPChar
_superStyle_fill :: FillStyle
..} 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 -> Char -> MPChar
forall a. a -> Maybe a
Just Char
'?'
lineAnchorsForRender_simplify :: LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_simplify :: LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_simplify LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
..} = LineAnchorsForRender
r where
withoutzeros :: [(CartDir, Int, Bool)]
withoutzeros = case [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest of
[] -> []
(CartDir, Int, Bool)
x:[(CartDir, Int, Bool)]
xs -> (CartDir, Int, Bool)
x(CartDir, Int, Bool)
-> [(CartDir, Int, Bool)] -> [(CartDir, Int, Bool)]
forall a. a -> [a] -> [a]
:[(CartDir, Int, Bool)] -> [(CartDir, Int, Bool)]
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
(a
_, Int
0, Bool
True):[(a, Int, Bool)]
xs -> [(a, Int, Bool)]
xs
(a, Int, Bool)
x:[(a, Int, Bool)]
xs -> (a, Int, Bool)
x(a, Int, Bool) -> [(a, Int, Bool)] -> [(a, Int, Bool)]
forall 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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
cd'
then (a
cd, b
db -> b -> b
forall a. Num a => a -> a -> a
+b
d', c
firstisstart)(a, b, c) -> [(a, b, c)] -> [(a, b, c)]
forall a. a -> [a] -> [a]
:[(a, b, c)]
xs
else (a
cd,b
d,c
firstisstart)(a, b, c) -> [(a, b, c)] -> [(a, b, c)]
forall a. a -> [a] -> [a]
:(a
cd',b
d',c
nextisstart)(a, b, c) -> [(a, b, c)] -> [(a, b, c)]
forall a. a -> [a] -> [a]
:[(a, b, c)]
xs
withoutdoubles :: [(CartDir, Int, Bool)]
withoutdoubles = ((CartDir, Int, Bool)
-> [(CartDir, Int, Bool)] -> [(CartDir, Int, Bool)])
-> [(CartDir, Int, Bool)]
-> [(CartDir, Int, Bool)]
-> [(CartDir, Int, Bool)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CartDir, Int, Bool)
-> [(CartDir, Int, Bool)] -> [(CartDir, Int, Bool)]
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_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
..} = (XY -> (CartDir, Int, Bool) -> XY)
-> XY -> [(CartDir, Int, Bool)] -> XY
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\XY
p (CartDir, Int, Bool)
cdd -> XY
p XY -> XY -> XY
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_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
..} = 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)(CartDir, b, Bool) -> [(CartDir, b, Bool)] -> [(CartDir, b, Bool)]
forall a. a -> [a] -> [a]
:[(CartDir, b, Bool)]
acc
revgo [(CartDir, b, Bool)]
_ ((CartDir
_,b
_,Bool
True):[]) = Text -> [(CartDir, b, Bool)]
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)(CartDir, b, Bool) -> [(CartDir, b, Bool)] -> [(CartDir, b, Bool)]
forall a. a -> [a] -> [a]
:[(CartDir, b, Bool)]
acc) [(CartDir, b, Bool)]
xs
revgo [(CartDir, b, Bool)]
_ ((CartDir
_,b
_,Bool
True):[(CartDir, b, Bool)]
xs) = Text -> [(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) = [(CartDir, b, Bool)]
-> [(CartDir, b, Bool)] -> [(CartDir, b, Bool)]
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)]
_ = Text -> [(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 = [(CartDir, Int, Bool)] -> [(CartDir, Int, Bool)]
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_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
..} = [XY]
r where
scanlfn :: XY -> (CartDir, Int, c) -> XY
scanlfn XY
pos (CartDir
cd,Int
d,c
_) = XY
pos XY -> XY -> XY
forall a. Num a => a -> a -> a
+ (CartDir -> XY
cartDirToUnit CartDir
cd) XY -> Int -> XY
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* Int
d
r :: [XY]
r = (XY -> (CartDir, Int, Bool) -> XY)
-> XY -> [(CartDir, Int, Bool)] -> [XY]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl XY -> (CartDir, Int, Bool) -> XY
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
}
instance TransformMe SimpleLineSolverParameters_NEW where
transformMe_rotateLeft :: SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
transformMe_rotateLeft = SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
forall a. a -> a
id
transformMe_rotateRight :: SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
transformMe_rotateRight = SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
forall a. a -> a
id
transformMe_reflectHorizontally :: SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
transformMe_reflectHorizontally = SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
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)(CartDir, Int, Bool)
-> [(CartDir, Int, Bool)] -> [(CartDir, Int, Bool)]
forall a. a -> [a] -> [a]
:((CartDir, Int) -> (CartDir, Int, Bool))
-> [(CartDir, Int)] -> [(CartDir, Int, Bool)]
forall a b. (a -> b) -> [a] -> [b]
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
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ax
dy :: Int
dy = Int
ty Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ay
r :: AttachmentLocation
r = if Int -> Int
forall a. Num a => a -> a
abs Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Num a => a -> a
abs Int
dy
then if Int
dx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then AttachmentLocation
AL_Right
else AttachmentLocation
AL_Left
else if Int
dy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then AttachmentLocation
AL_Bot
else AttachmentLocation
AL_Top
newtype OffsetBorder = OffsetBorder { OffsetBorder -> Bool
unOffsetBorder :: Bool } deriving (Int -> OffsetBorder -> ShowS
[OffsetBorder] -> ShowS
OffsetBorder -> String
(Int -> OffsetBorder -> ShowS)
-> (OffsetBorder -> String)
-> ([OffsetBorder] -> ShowS)
-> Show OffsetBorder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OffsetBorder -> ShowS
showsPrec :: Int -> OffsetBorder -> ShowS
$cshow :: OffsetBorder -> String
show :: OffsetBorder -> String
$cshowList :: [OffsetBorder] -> ShowS
showList :: [OffsetBorder] -> ShowS
Show)
instance TransformMe OffsetBorder where
transformMe_rotateLeft :: OffsetBorder -> OffsetBorder
transformMe_rotateLeft = OffsetBorder -> OffsetBorder
forall a. a -> a
id
transformMe_rotateRight :: OffsetBorder -> OffsetBorder
transformMe_rotateRight = OffsetBorder -> OffsetBorder
forall a. a -> a
id
transformMe_reflectHorizontally :: OffsetBorder -> OffsetBorder
transformMe_reflectHorizontally = OffsetBorder -> OffsetBorder
forall a. a -> a
id
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 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 -> Bool -> AttachmentLocation -> AttachmentLocation
forall a. HasCallStack => Bool -> a -> a
assert (AttachmentOffsetRatio
af1 AttachmentOffsetRatio -> AttachmentOffsetRatio -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentOffsetRatio
attachment_offset_rel_default) (AttachmentLocation -> AttachmentLocation)
-> AttachmentLocation -> AttachmentLocation
forall a b. (a -> b) -> a -> b
$ XY -> XY -> AttachmentLocation
makeAL (LBox -> XY
_lBox_tl LBox
lbx1) (XY -> AttachmentLocation) -> XY -> AttachmentLocation
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 -> Bool -> AttachmentLocation -> AttachmentLocation
forall a. HasCallStack => Bool -> a -> a
assert (AttachmentOffsetRatio
af2 AttachmentOffsetRatio -> AttachmentOffsetRatio -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentOffsetRatio
attachment_offset_rel_default) (AttachmentLocation -> AttachmentLocation)
-> AttachmentLocation -> AttachmentLocation
forall a b. (a -> b) -> a -> b
$ XY -> XY -> AttachmentLocation
makeAL (LBox -> XY
_lBox_tl LBox
lbx2) (XY -> AttachmentLocation) -> XY -> AttachmentLocation
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)
(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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ax2
lbx1isleft :: Bool
lbx1isleft = Int
ax1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ax2
lbx1isstrictlyabove :: Bool
lbx1isstrictlyabove = Int
ay1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ay2
ay1isvsepfromlbx2 :: Bool
ay1isvsepfromlbx2 = Int
ay1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y2 Bool -> Bool -> Bool
|| Int
ay1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
y2 Int -> Int -> Int
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
stepdetail :: Text
stepdetail = ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
-> Text
forall b a. (Show a, IsString b) => a -> b
show ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
-> Text
forall b a. (Show a, IsString b) => a -> b
show ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
nextmsg :: Text -> (Text, Int)
nextmsg Text
step = (Text
errormsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
step Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stepdetail, Int
depthInt -> Int -> Int
forall 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
l :: Int
l = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
l1_incInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
l2_incInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
t :: Int
t = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
t1_incInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
t2_incInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
b :: Int
b = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
b1 Int
b2
anchors :: LineAnchorsForRender
anchors = case AttachmentLocation
al1 of
AttachmentLocation
AL_Right | Int
ax1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ax2 Bool -> Bool -> Bool
&& Int
ay1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ay2 -> LineAnchorsForRender {
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_start = XY
start
, _lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
_lineAnchorsForRender_rest = []
}
AttachmentLocation
AL_Right | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
&& Bool
lbx1isstrictlyleft Bool -> Bool -> Bool
&& Bool
hsep -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 1" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where
halfway :: Int
halfway = (Int
ax2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
ax1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
lb1_to_center :: (CartDir, Int)
lb1_to_center = (CartDir
CD_Right, (Int
halfwayInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ax1))
centerverticalline :: (CartDir, Int)
centerverticalline = if Int
ay1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ay2
then (CartDir
CD_Down, Int
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay1)
else (CartDir
CD_Up, Int
ay1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay2)
center_to_lb2 :: (CartDir, Int)
center_to_lb2 = (CartDir
CD_Right, (Int
ax2Int -> Int -> Int
forall 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]
}
AttachmentLocation
AL_Right | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
vsep -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 2" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where
goup :: Bool
goup = (Int
ay1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t)Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay1)Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay2)
rightedge :: Int
rightedge = if (Bool -> Bool
not Bool
goup Bool -> Bool -> Bool
&& Int
b2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ay1) Bool -> Bool -> Bool
|| (Bool
goup Bool -> Bool -> Bool
&& Int
ay1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
t2_inc)
then Int
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
attachoffset
else (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
attachoffset) Int
r2)
lb1_to_right :: (CartDir, Int)
lb1_to_right = (CartDir
CD_Right, Int
rightedgeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ax1)
right_to_torb :: (CartDir, Int)
right_to_torb = if Bool
goup
then (CartDir
CD_Up, Int
ay1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t)
else (CartDir
CD_Down, Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay1)
leftedge :: Int
leftedge = if (Bool
goup Bool -> Bool -> Bool
&& Int
t2_inc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
t1_inc) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
goup Bool -> Bool -> Bool
&& Int
b2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
b1)
then Int
ax2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
attachoffset
else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
ax2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
attachoffset) (Int
l1_incInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
attachoffset)
torb :: (CartDir, Int)
torb = (CartDir
CD_Left, Int
rightedge Int -> Int -> Int
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
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t)
else (CartDir
CD_Up, Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay2)
left_to_lb2 :: (CartDir, Int)
left_to_lb2 = (CartDir
CD_Right, Int
ax2Int -> Int -> Int
forall 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]
}
AttachmentLocation
AL_Right | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
&& Bool
vsep -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 3" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where
halfway :: Int
halfway = if Int
b1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
t2_inc
then (Int
b1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
t2_inc) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
else (Int
b2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
t1_inc) Int -> Int -> Int
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
halfwayInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay1)
else (CartDir
CD_Up, Int
ay1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
halfway)
center :: (CartDir, Int)
center = (CartDir
CD_Left, Int
attachoffsetInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
ax1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ax2))
center_to_left :: (CartDir, Int)
center_to_left = if Bool
lbx1isstrictlyabove
then (CartDir
CD_Down, Int
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
halfway)
else (CartDir
CD_Up, Int
halfwayInt -> Int -> Int
forall 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]
}
AttachmentLocation
AL_Right | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right Bool -> Bool -> Bool
&& (Bool
ay1isvsepfromlbx2 Bool -> Bool -> Bool
|| Int
r1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r2) -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 4" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
answer where
rightedge :: Int
rightedge = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
r1 Int
r2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
attachoffset
lb1_to_right1 :: (CartDir, Int)
lb1_to_right1 = (CartDir
CD_Right, Int
rightedgeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r1)
right1_to_right2 :: (CartDir, Int)
right1_to_right2 = if Bool
lbx1isstrictlyabove
then (CartDir
CD_Down, Int
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay1)
else (CartDir
CD_Up, Int
ay1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay2)
right2_to_lb2 :: (CartDir, Int)
right2_to_lb2 = (CartDir
CD_Left, Int
rightedgeInt -> Int -> Int
forall 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]
}
AttachmentLocation
AL_Right | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right Bool -> Bool -> Bool
&& Bool
lbx1isleft Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ay1isvsepfromlbx2 -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 5b" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
answer where
goupordown :: Bool
goupordown = (Int
ay1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t)Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay1)Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay2)
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
ay1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t)
else (CartDir
CD_Down, Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay1)
torb :: (CartDir, Int)
torb = (CartDir
CD_Right, Int
r2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
r1)
torb_to_right2 :: (CartDir, Int)
torb_to_right2 = if Bool
goupordown
then (CartDir
CD_Down, Int
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t)
else (CartDir
CD_Up, Int
bInt -> Int -> Int
forall 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]
}
AttachmentLocation
AL_Right | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
ay1isvsepfromlbx2 -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 6 (reverse)" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender -> LineAnchorsForRender
lineAnchorsForRender_reverse (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
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
AttachmentLocation
AL_Top | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right Bool -> Bool -> Bool
&& Bool
lbx1isleft -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 7" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where
upd :: Int
upd = if Bool
vsep
then Int
attachoffset
else Int
ay1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
attachoffset
topline :: Int
topline = Int
ay1Int -> Int -> Int
forall 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ay2
then (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
ax2 Int
r1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
attachoffset
else Int
ax2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
attachoffset
up_to_right1 :: (CartDir, Int)
up_to_right1 = (CartDir
CD_Right, Int
rightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ax1)
right1_to_right2 :: (CartDir, Int)
right1_to_right2 = if Int
topline Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ay2
then (CartDir
CD_Down, Int
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
topline)
else (CartDir
CD_Up, Int
toplineInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ay2)
right2_to_lb2 :: (CartDir, Int)
right2_to_lb2 = (CartDir
CD_Left, Int
rightInt -> Int -> Int
forall 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]
}
AttachmentLocation
AL_Top | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
&& Bool
lbx1isleft -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 9" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender
r where
topedge :: Int
topedge = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
ay1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
attachoffset) Int
ay2
leftedge :: Int
leftedge = Int
l
halfway :: Int
halfway = (Int
ax1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ax2) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
lb1_to_up :: (CartDir, Int)
lb1_to_up = (CartDir
CD_Up, Int
ay1Int -> Int -> Int
forall 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
then ((CartDir
CD_Left, Int
ax1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
leftedge), Int
leftedge)
else ((CartDir
CD_Right, Int
halfwayInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
ax1), Int
halfway)
over_to_down :: (CartDir, Int)
over_to_down = (CartDir
CD_Down, Int
ay2Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
topedge)
down_to_lb2 :: (CartDir, Int)
down_to_lb2 = (CartDir
CD_Right, Int
ax2Int -> Int -> Int
forall 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]
}
AttachmentLocation
AL_Top | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Left Bool -> Bool -> Bool
|| AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Right -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 10 (flip)" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender -> LineAnchorsForRender
forall a. TransformMe a => a -> a
transformMe_reflectHorizontally (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
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") (CartRotationReflection -> CartRotationReflection
forall a. TransformMe a => a -> a
transformMe_reflectHorizontally CartRotationReflection
crr) (SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
forall a. TransformMe a => a -> a
transformMe_reflectHorizontally SimpleLineSolverParameters_NEW
sls) (((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)
forall a. TransformMe a => a -> a
transformMe_reflectHorizontally ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1) (((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)
forall a. TransformMe a => a -> a
transformMe_reflectHorizontally ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2)
AttachmentLocation
AL_Top | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Any -> Text -> LineAnchorsForRender
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should have been handled by earlier substitution"
AttachmentLocation
AL_Any | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Top -> Text -> LineAnchorsForRender
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should have been handled by earlier substitution"
AttachmentLocation
AL_Any | AttachmentLocation
al2 AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
AL_Any -> Text -> LineAnchorsForRender
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"should have been handled by earlier substitution"
AttachmentLocation
_ -> String -> LineAnchorsForRender -> LineAnchorsForRender
forall a. String -> a -> a
traceStep String
"case 14 (rotate)" (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender -> LineAnchorsForRender
forall a. TransformMe a => a -> a
transformMe_rotateRight (LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender -> LineAnchorsForRender
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") (CartRotationReflection -> CartRotationReflection
forall a. TransformMe a => a -> a
transformMe_rotateLeft CartRotationReflection
crr) (SimpleLineSolverParameters_NEW -> SimpleLineSolverParameters_NEW
forall a. TransformMe a => a -> a
transformMe_rotateLeft SimpleLineSolverParameters_NEW
sls) (((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)
forall a. TransformMe a => a -> a
transformMe_rotateLeft ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal1) (((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)
forall a. TransformMe a => a -> a
transformMe_rotateLeft ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
lbal2)
finaloutput :: LineAnchorsForRender
finaloutput = if Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10
then Text -> LineAnchorsForRender
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sy -> if Int
px Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sx Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
tl then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
px) else Maybe Int
forall a. Maybe a
Nothing
CartDir
CD_Right | Int
py Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sy -> if Int
px Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sx Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
tl then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
pxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sx) else Maybe Int
forall a. Maybe a
Nothing
CartDir
CD_Up | Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sx -> if Int
py Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
sy Bool -> Bool -> Bool
&& Int
py Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
syInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
tl then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
syInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
py) else Maybe Int
forall a. Maybe a
Nothing
CartDir
CD_Down | Int
px Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sx -> if Int
py Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
sy Bool -> Bool -> Bool
&& Int
py Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
syInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
tl then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
pyInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sy) else Maybe Int
forall a. Maybe a
Nothing
CartDir
_ -> Maybe Int
forall a. Maybe a
Nothing
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
sxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
tl, Int
sy, Int
tlInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
1)
CartDir
CD_Right -> (Int
sx, Int
sy, Int
tlInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
1)
CartDir
CD_Up -> (Int
sx, Int
syInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
tl, Int
1, Int
tlInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
CartDir
CD_Down -> (Int
sx, Int
sy, Int
1, Int
tlInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
lbox2 :: LBox
lbox2 = XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
y) (Int -> Int -> XY
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 XY -> XY -> XY
forall a. Num a => a -> a -> a
+ (CartDir -> XY
cartDirToUnit CartDir
tcd) XY -> Int -> XY
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 (AnchorType -> MPChar) -> AnchorType -> MPChar
forall a b. (a -> b) -> a -> b
$ CartDir -> Maybe CartDir -> AnchorType
cartDirToAnchor CartDir
tcd (((CartDir, Int, Bool) -> CartDir)
-> Maybe (CartDir, Int, Bool) -> Maybe CartDir
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CartDir, Int, Bool) -> CartDir
forall a b c. (a, b, c) -> a
fst3 Maybe (CartDir, Int, Bool)
mnext)
startorregular :: MPChar
startorregular = if Bool
isstart
then if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
tl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
then SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle
ss LineStyle
ls (CartDir -> CartDir
flipCartDir CartDir
tcd) Int
d
else if Maybe (CartDir, Int, Bool) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (CartDir, Int, Bool)
mnext
then SuperStyle -> LineStyle -> CartDir -> Int -> MPChar
renderLineEnd SuperStyle
ss LineStyle
ls CartDir
tcd (Int
tlInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
d)
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 Int -> Int -> Bool
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_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
..} = Int
r where
foldfn :: (a, a, c) -> a -> a
foldfn (a
_,a
d,c
_) a
acc = a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ a
d
r :: Int
r = ((CartDir, Int, Bool) -> Int -> Int)
-> Int -> [(CartDir, Int, Bool)] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CartDir, Int, Bool) -> Int -> Int
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_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
..} 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
[] -> Maybe (XY, MPChar)
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 -> (XY, MPChar) -> Maybe (XY, MPChar)
forall a. a -> Maybe a
Just ((XY, MPChar) -> Maybe (XY, MPChar))
-> (XY, MPChar) -> Maybe (XY, MPChar)
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 Maybe (CartDir, Int, Bool)
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 ((CartDir, Int, Bool) -> Maybe (CartDir, Int, Bool)
forall a. a -> Maybe a
Just (CartDir, Int, Bool)
y) Int
d
where
nextbegin :: XY
nextbegin = XY
curbegin XY -> XY -> XY
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 -> MPChar
forall a. Maybe a
Nothing
Just (XY
pos', MPChar
mpchar) -> Bool -> MPChar -> MPChar
forall a. HasCallStack => Bool -> a -> a
assert (XY
pos XY -> XY -> Bool
forall a. Eq a => a -> a -> Bool
== XY
pos') MPChar
mpchar
lineAnchorsForRender_findIntersectingSubsegment :: LineAnchorsForRender -> XY -> Maybe Int
lineAnchorsForRender_findIntersectingSubsegment :: LineAnchorsForRender -> XY -> Maybe Int
lineAnchorsForRender_findIntersectingSubsegment LineAnchorsForRender {[(CartDir, Int, Bool)]
XY
_lineAnchorsForRender_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
..} 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
[] -> Maybe Int
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 XY -> XY -> XY
forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir, Int, Bool)
x) [(CartDir, Int, Bool)]
xs
Just Int
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
new_i
where new_i :: Int
new_i = if Bool
s then Int
iInt -> Int -> Int
forall 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_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
..} 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 XY -> XY -> XY
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_start :: LineAnchorsForRender -> XY
_lineAnchorsForRender_rest :: LineAnchorsForRender -> [(CartDir, Int, Bool)]
_lineAnchorsForRender_start :: XY
_lineAnchorsForRender_rest :: [(CartDir, Int, Bool)]
..} 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 XY -> XY -> XY
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 = TextAlignment
-> Int -> Int -> Int -> TextZipper -> DisplayLines Int
forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
TZ.TextAlignment_Left Int
forall a. Bounded a => a
maxBound Int
0 Int
1 TextZipper
tz
offset :: (Int, Int)
offset = (- (Text -> Int
T.length Text
text) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2, Int
0)
r :: MPChar
r = Maybe MPChar -> MPChar
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe MPChar -> MPChar) -> Maybe MPChar -> MPChar
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
sSimpleLineNewRenderFn :: SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer
sSimpleLineNewRenderFn :: SAutoLine -> Maybe LineAnchorsForRender -> SEltDrawer
sSimpleLineNewRenderFn ssline :: SAutoLine
ssline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
..} 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 -> a -> SAutoLine -> LineAnchorsForRender
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 = a -> LineAnchorsForRender
forall a. HasOwlTree a => a -> LineAnchorsForRender
getAnchors a
ot
mergeMaybe :: MPChar -> MPChar -> MPChar
mergeMaybe :: MPChar -> MPChar -> MPChar
mergeMaybe MPChar
m1 MPChar
m2 = MPChar -> (Char -> MPChar) -> MPChar -> MPChar
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MPChar
m2 Char -> MPChar
forall a. a -> Maybe a
Just MPChar
m1
llabels :: [(XY, Int, SAutoLineLabel)]
llabels = a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions a
ot SAutoLine
ssline
llabelsrendered :: [MPChar]
llabelsrendered = ((XY, Int, SAutoLineLabel) -> MPChar)
-> [(XY, Int, SAutoLineLabel)] -> [MPChar]
forall a b. (a -> b) -> [a] -> [b]
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 = (MPChar -> MPChar -> MPChar) -> MPChar -> [MPChar] -> MPChar
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr MPChar -> MPChar -> MPChar
mergeMaybe MPChar
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
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 [XY] -> Maybe (NonEmpty XY)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (LineAnchorsForRender -> [XY]
lineAnchorsForRender_toPointList (a -> LineAnchorsForRender
forall a. HasOwlTree a => a -> LineAnchorsForRender
getAnchors a
ot)) of
Maybe (NonEmpty XY)
Nothing -> XY -> XY -> LBox
LBox XY
0 XY
0
Just (XY
x :| [XY]
xs) -> LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand ((LBox -> XY -> LBox) -> LBox -> [XY] -> LBox
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((XY -> LBox -> LBox) -> LBox -> XY -> LBox
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)
llabels :: [(XY, Int, SAutoLineLabel)]
llabels = a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
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 (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wover2) Int
y) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
w Int
1) where
w :: Int
w = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
wover2 :: Int
wover2 = (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
mlabelbox :: Maybe LBox
mlabelbox = ((XY, Int, SAutoLineLabel) -> Maybe LBox -> Maybe LBox)
-> Maybe LBox -> [(XY, Int, SAutoLineLabel)] -> Maybe LBox
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(XY
pos, Int
_, SAutoLineLabel
llabel) Maybe LBox
mbox -> Maybe LBox -> (LBox -> Maybe LBox) -> Maybe LBox -> Maybe LBox
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LBox -> Maybe LBox
forall a. a -> Maybe a
Just (LBox -> Maybe LBox) -> LBox -> Maybe LBox
forall a b. (a -> b) -> a -> b
$ XY -> SAutoLineLabel -> LBox
llabelbox XY
pos SAutoLineLabel
llabel) (\LBox
box -> LBox -> Maybe LBox
forall a. a -> Maybe a
Just (LBox -> Maybe LBox) -> LBox -> Maybe LBox
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) Maybe LBox
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 = a -> LBox
SEltDrawerBoxFn
boxfn
, _sEltDrawer_renderFn :: SEltDrawerRenderFn
_sEltDrawer_renderFn = a -> XY -> MPChar
SEltDrawerRenderFn
renderfn
, _sEltDrawer_maxCharWidth :: Int
_sEltDrawer_maxCharWidth = Int
1
}
lineAnchorsForRender_concat :: [LineAnchorsForRender] -> LineAnchorsForRender
lineAnchorsForRender_concat :: [LineAnchorsForRender] -> LineAnchorsForRender
lineAnchorsForRender_concat [] = Text -> LineAnchorsForRender
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"expected at least one LineAnchorsForRender"
lineAnchorsForRender_concat (LineAnchorsForRender
x:[LineAnchorsForRender]
xs) = (LineAnchorsForRender
-> LineAnchorsForRender -> LineAnchorsForRender)
-> LineAnchorsForRender
-> [LineAnchorsForRender]
-> LineAnchorsForRender
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LineAnchorsForRender
-> LineAnchorsForRender -> LineAnchorsForRender
foldfn LineAnchorsForRender
x [LineAnchorsForRender]
xs where
foldfn :: LineAnchorsForRender
-> LineAnchorsForRender -> LineAnchorsForRender
foldfn LineAnchorsForRender
h LineAnchorsForRender
c =
LineAnchorsForRender
h { _lineAnchorsForRender_rest = _lineAnchorsForRender_rest h <> _lineAnchorsForRender_rest c }
pairs :: [a] -> [(a, a)]
pairs :: forall a. [a] -> [(a, a)]
pairs [] = []
pairs [a]
xs = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs ([a] -> [a]
forall a. HasCallStack => [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 <- a -> Int -> Maybe SuperOwl
forall o. HasOwlTree o => o -> Int -> Maybe SuperOwl
hasOwlTree_findSuperOwl a
ot Int
rid
LBox
sbox <- SElt -> Maybe LBox
getSEltBox_naive (SElt -> Maybe LBox) -> SElt -> Maybe LBox
forall a b. (a -> b) -> a -> b
$ SuperOwl -> SElt
forall o. HasOwlItem o => o -> SElt
hasOwlItem_toSElt_hack SuperOwl
sowl
return (LBox
sbox, AttachmentLocation
al, AttachmentOffsetRatio
ratio)
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_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
..} = [LineAnchorsForRender]
anchorss where
params :: SimpleLineSolverParameters_NEW
params = SimpleLineSolverParameters_NEW {
_simpleLineSolverParameters_NEW_attachOffset :: Int
_simpleLineSolverParameters_NEW_attachOffset = Int
1
}
startlbal :: ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
startlbal = case a
-> Maybe Attachment
-> Maybe (LBox, AttachmentLocation, AttachmentOffsetRatio)
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 a
-> Maybe Attachment
-> Maybe (LBox, AttachmentLocation, AttachmentOffsetRatio)
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 = (SAutoLineConstraint
-> ((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder))
-> [SAutoLineConstraint]
-> [((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)]
forall a b. (a -> b) -> [a] -> [b]
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
anchorss :: [LineAnchorsForRender]
anchorss = ((((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder),
((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder))
-> LineAnchorsForRender)
-> [(((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder),
((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder))]
-> [LineAnchorsForRender]
forall a b. (a -> b) -> [a] -> [b]
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) ([(((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder),
((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder))]
-> [LineAnchorsForRender])
-> [(((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder),
((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder))]
-> [LineAnchorsForRender]
forall a b. (a -> b) -> a -> b
$ [((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)]
-> [(((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder),
((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder))]
forall a. [a] -> [(a, a)]
pairs ((((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
startlbal ((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)
-> [((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)]
-> [((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)]
forall a. a -> [a] -> [a]
: [((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)]
midlbals) [((LBox, AttachmentLocation, AttachmentOffsetRatio), OffsetBorder)]
-> [((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)]
-> [((LBox, AttachmentLocation, AttachmentOffsetRatio),
OffsetBorder)]
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 (LineAnchorsForRender -> LineAnchorsForRender)
-> ([LineAnchorsForRender] -> LineAnchorsForRender)
-> [LineAnchorsForRender]
-> LineAnchorsForRender
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LineAnchorsForRender] -> LineAnchorsForRender
lineAnchorsForRender_concat ([LineAnchorsForRender] -> LineAnchorsForRender)
-> [LineAnchorsForRender] -> LineAnchorsForRender
forall a b. (a -> b) -> a -> b
$ a -> SAutoLine -> [LineAnchorsForRender]
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 XY -> XY -> XY
forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir, Int, Bool)
x
r2 :: XY
r2 = if Int
traveld Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
targetd
then XY
curbegin XY -> XY -> XY
forall a. Num a => a -> a -> a
+ (CartDir, Int, Bool) -> XY
cartDirWithDistanceToV2 (CartDir
cd, Int
targetd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
traveld, Bool
forall a. HasCallStack => a
undefined)
else [(CartDir, Int, Bool)] -> XY -> Int -> XY
walk [(CartDir, Int, Bool)]
rest XY
nextbegin (Int
traveld Int -> Int -> Int
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
internal_getSAutoLineLabelPosition :: LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
internal_getSAutoLineLabelPosition :: LineAnchorsForRender -> SAutoLine -> SAutoLineLabel -> XY
internal_getSAutoLineLabelPosition LineAnchorsForRender
lar SAutoLine
_ SAutoLineLabel {Int
Text
SAutoLineLabelPosition
_sAutoLineLabel_text :: SAutoLineLabel -> Text
_sAutoLineLabel_index :: Int
_sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_text :: Text
_sAutoLineLabel_index :: SAutoLineLabel -> Int
_sAutoLineLabel_position :: SAutoLineLabel -> SAutoLineLabelPosition
..} = XY
r where
totall :: Int
totall = LineAnchorsForRender -> Int
lineAnchorsForRender_length LineAnchorsForRender
lar
targetd :: Int
targetd = case SAutoLineLabelPosition
_sAutoLineLabel_position of
SAutoLineLabelPositionRelative Float
rp -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Float -> Int) -> Float -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totall Float -> Float -> Float
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
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 = a -> SAutoLine -> [LineAnchorsForRender]
forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
sal [LineAnchorsForRender] -> Int -> LineAnchorsForRender
forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` (SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
sall)
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_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
..} = [(XY, Int, SAutoLineLabel)]
r where
sortfn :: (a, SAutoLineLabel) -> (a, SAutoLineLabel) -> Ordering
sortfn (a
_,SAutoLineLabel
a) (a
_,SAutoLineLabel
b) = case Int -> Int -> Ordering
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 -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x Float
y
Ordering
x -> Ordering
x
sortedlls :: [(Int, SAutoLineLabel)]
sortedlls = ((Int, SAutoLineLabel) -> (Int, SAutoLineLabel) -> Ordering)
-> [(Int, SAutoLineLabel)] -> [(Int, SAutoLineLabel)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int, SAutoLineLabel) -> (Int, SAutoLineLabel) -> Ordering
forall {a} {a}.
(a, SAutoLineLabel) -> (a, SAutoLineLabel) -> Ordering
sortfn ([(Int, SAutoLineLabel)] -> [(Int, SAutoLineLabel)])
-> [(Int, SAutoLineLabel)] -> [(Int, SAutoLineLabel)]
forall a b. (a -> b) -> a -> b
$ [SAutoLineLabel] -> [(Int, SAutoLineLabel)]
forall a. [a] -> [(Int, a)]
L.indexed [SAutoLineLabel]
_sAutoLine_labels
larlist :: [LineAnchorsForRender]
larlist = a -> SAutoLine -> [LineAnchorsForRender]
forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
sal
r :: [(XY, Int, SAutoLineLabel)]
r = ((Int, SAutoLineLabel) -> (XY, Int, SAutoLineLabel))
-> [(Int, SAutoLineLabel)] -> [(XY, Int, SAutoLineLabel)]
forall a b. (a -> b) -> [a] -> [b]
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 [LineAnchorsForRender] -> Int -> LineAnchorsForRender
forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
sall) SAutoLine
sal SAutoLineLabel
sall, Int
i, SAutoLineLabel
sall)) [(Int, SAutoLineLabel)]
sortedlls
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)
-> 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))
-> (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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
a Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
b) Bool -> Bool -> Bool
|| (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
a Bool -> Bool -> Bool
&& Int
p Int -> Int -> Bool
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) = V2 Float -> Float
forall a. Floating a => V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (Float -> Float -> V2 Float
forall a. a -> a -> V2 a
V2 (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ax Float -> Float -> Float
forall a. Num a => a -> a -> a
- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bx) (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ay Float -> Float -> Float
forall a. Num a => a -> a -> a
- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
by))
endp :: XY
endp@(V2 Int
endx Int
endy) = XY
curp XY -> XY -> XY
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 Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
dtoend
then (Float
dtocur, XY
curp)
else (Float
dtoend, XY
endp)
(Float
projd, XY
projp) = if CartDir
cd CartDir -> CartDir -> Bool
forall a. Eq a => a -> a -> Bool
== CartDir
CD_Up Bool -> Bool -> Bool
|| CartDir
cd CartDir -> CartDir -> Bool
forall a. Eq a => a -> a -> Bool
== CartDir
CD_Down
then if Int -> Int -> Int -> Bool
between Int
posy Int
cury Int
endy
then (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int
curx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
posx), Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
curx Int
posy)
else (Float, XY)
dandpostostartorend
else if Int -> Int -> Int -> Bool
between Int
posx Int
curx Int
endx
then (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs (Int
cury Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
posy), Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
posx Int
cury)
else (Float, XY)
dandpostostartorend
r3 :: (Int, XY, Int, Maybe (Int, XY))
r3 = if Float
projd Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
closestd2
then (Int
traveld Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d, XY
endp, Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
projd, (Int, XY) -> Maybe (Int, XY)
forall a. a -> Maybe a
Just (Int
traveld Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (XY -> XY -> Float
xydistance XY
curp XY
projp), XY
projp))
else (Int
traveld Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d, XY
endp, Int
closestd2, Maybe (Int, XY)
mnewclosestpos2)
(Int
totald, XY
_, Int
newclosestd, Maybe (Int, XY)
mnewclosestpos) = ((Int, XY, Int, Maybe (Int, XY))
-> (CartDir, Int, Bool) -> (Int, XY, Int, Maybe (Int, XY)))
-> (Int, XY, Int, Maybe (Int, XY))
-> [(CartDir, Int, Bool)]
-> (Int, XY, Int, Maybe (Int, XY))
forall b a. (b -> a -> b) -> b -> [a] -> b
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, Maybe (Int, XY)
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
Maybe (Int, XY)
Nothing -> (Int
closestd, (XY, Int, Float)
closestp, Int
curindexInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Just (Int
newclosesttraveld, XY
newclosestp) -> (Int
newclosestd, (XY
newclosestp, Int
curindex, Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newclosesttraveld Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totald), Int
curindexInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
(Int
_,(XY, Int, Float)
r,Int
_) = ((Int, (XY, Int, Float), Int)
-> LineAnchorsForRender -> (Int, (XY, Int, Float), Int))
-> (Int, (XY, Int, Float), Int)
-> [LineAnchorsForRender]
-> (Int, (XY, Int, Float), Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
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 (Int
forall a. Bounded a => a
maxBound :: Int, (XY
0,Int
0,Float
0), Int
0) [LineAnchorsForRender]
larlist