-- TODO DELETE ME
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Controller.Manipulator.CartLine (
  CartLineHandler(..)
) where

import           Relude

import           Potato.Flow.Controller.Handler
import           Potato.Flow.Controller.Input
import           Potato.Flow.Controller.Manipulator.Common
import           Potato.Flow.Controller.Types
import           Potato.Flow.Math

import           Control.Exception
import           Data.Default
import qualified Text.Pretty.Simple as Pretty
import qualified Data.Text.Lazy as LT


{- examples of how CartLine works

1---2
    |
    3
drag 2 up (1 moves as well)
1---2
    |
    |
    3
drag 2 right (3 moves as well)
1------2
       |
       |
       3

1---x---2
drag x down (later anchor always moves)
1---*
    |
    *---2

examples:
1---3---2
drag 2 up
    3---2
        |
1-------*

-}

isCartesian :: XY -> XY -> Bool
isCartesian :: XY -> XY -> Bool
isCartesian (V2 Int
ax Int
ay) (V2 Int
bx Int
by) = Int
ax forall a. Eq a => a -> a -> Bool
== Int
bx Bool -> Bool -> Bool
|| Int
ay forall a. Eq a => a -> a -> Bool
== Int
by

-- | predicate holds if pt is between a and b
-- expects a b to be in the same cartesian plane
isBetween :: XY -> (XY, XY) -> Bool
isBetween :: XY -> (XY, XY) -> Bool
isBetween (V2 Int
px Int
py) (a :: XY
a@(V2 Int
ax Int
ay), b :: XY
b@(V2 Int
bx Int
by)) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (XY -> XY -> Bool
isCartesian XY
a XY
b) forall a b. (a -> b) -> a -> b
$ if Int
ax forall a. Eq a => a -> a -> Bool
== Int
bx Bool -> Bool -> Bool
&& Int
ax forall a. Eq a => a -> a -> Bool
== Int
px
  -- if in same vertical line
  then (Int
py forall a. Ord a => a -> a -> Bool
>= Int
ay Bool -> Bool -> Bool
&& Int
py forall a. Ord a => a -> a -> Bool
<= Int
by) Bool -> Bool -> Bool
|| (Int
py forall a. Ord a => a -> a -> Bool
<= Int
ay Bool -> Bool -> Bool
&& Int
py forall a. Ord a => a -> a -> Bool
>= Int
by)
  else if Int
ay forall a. Eq a => a -> a -> Bool
== Int
by Bool -> Bool -> Bool
&& Int
ay forall a. Eq a => a -> a -> Bool
== Int
py
    -- if in same horizontal line
    then (Int
px forall a. Ord a => a -> a -> Bool
>= Int
ax Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
<= Int
bx) Bool -> Bool -> Bool
|| (Int
px forall a. Ord a => a -> a -> Bool
<= Int
ax Bool -> Bool -> Bool
&& Int
px forall a. Ord a => a -> a -> Bool
>= Int
bx)
    else Bool
False

splitFind :: (a -> Bool) -> [a] -> ([a],[a])
splitFind :: forall a. (a -> Bool) -> [a] -> ([a], [a])
splitFind a -> Bool
p [a]
l = ([a], [a])
r where
  splitFind' :: [a] -> [a] -> ([a], [a])
splitFind' [a]
rprevs [] = ([a]
rprevs,[])
  splitFind' [a]
rprevs (a
x:[a]
xs) = if a -> Bool
p a
x
    -- note we built up backwards but we reverse at the very end
    then (forall a. [a] -> [a]
reverse [a]
rprevs, a
xforall a. a -> [a] -> [a]
:[a]
xs)
    else [a] -> [a] -> ([a], [a])
splitFind' (a
xforall a. a -> [a] -> [a]
:[a]
rprevs) [a]
xs
  r :: ([a], [a])
r = [a] -> [a] -> ([a], [a])
splitFind' [] [a]
l

-- first elt of second list is currently selected anchor (no anchor selected if empty)
-- by assumption each anchor can only differ in one component from the previous one
-- anchors must not continue forward in same direction
-- not ok: 1----2----3
--     ok: 1-3--2
data AnchorZipper = AnchorZipper [XY] [XY] deriving (Int -> AnchorZipper -> ShowS
[AnchorZipper] -> ShowS
AnchorZipper -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnchorZipper] -> ShowS
$cshowList :: [AnchorZipper] -> ShowS
show :: AnchorZipper -> String
$cshow :: AnchorZipper -> String
showsPrec :: Int -> AnchorZipper -> ShowS
$cshowsPrec :: Int -> AnchorZipper -> ShowS
Show)
emptyAnchorZipper :: AnchorZipper
emptyAnchorZipper :: AnchorZipper
emptyAnchorZipper = [XY] -> [XY] -> AnchorZipper
AnchorZipper [] []

flattenAnchors :: AnchorZipper -> [XY]
flattenAnchors :: AnchorZipper -> [XY]
flattenAnchors (AnchorZipper [XY]
xs [XY]
ys) = [XY]
xs forall a. Semigroup a => a -> a -> a
<> [XY]
ys

-- | flatten AnchorZipper to a plain list
-- used only in creation step, where no anchor can be focused, asserts if this condition fails
flattenAnchorsInCreation :: AnchorZipper -> [XY]
flattenAnchorsInCreation :: AnchorZipper -> [XY]
flattenAnchorsInCreation az :: AnchorZipper
az@(AnchorZipper [XY]
xs [XY]
ys) = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (forall (t :: * -> *) a. Foldable t => t a -> Int
length [XY]
ys forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$ AnchorZipper -> [XY]
flattenAnchors AnchorZipper
az


-- | adjacentPairs [1,2,3,4] `shouldBe` [(1,2),(2,3),(3,4)]
adjacentPairs :: [a] -> [(a,a)]
adjacentPairs :: forall a. [a] -> [(a, a)]
adjacentPairs [] = []
adjacentPairs (a
x:[]) = []
adjacentPairs (a
x:a
y:[a]
es) = (a
x,a
y) forall a. a -> [a] -> [a]
: forall a. [a] -> [(a, a)]
adjacentPairs (a
yforall a. a -> [a] -> [a]
:[a]
es)


-- TODO TEST
-- | validate if AnchorZipper assumptions hold
validateAnchorZipper :: AnchorZipper -> Bool
validateAnchorZipper :: AnchorZipper -> Bool
validateAnchorZipper (AnchorZipper [XY]
xs1 [XY]
xs2) = Bool
r where

  check1 :: V2 a -> V2 a -> Bool
check1 (V2 a
ex a
ey) (V2 a
l1x a
l1y) = if a
ex forall a. Eq a => a -> a -> Bool
== a
l1x
    then a
ey forall a. Eq a => a -> a -> Bool
/= a
l1y
    else a
ey forall a. Eq a => a -> a -> Bool
== a
l1y
  check2 :: V2 a -> V2 a -> V2 a -> Bool
check2 (V2 a
ex a
ey) (V2 a
l1x a
l1y) (V2 a
l2x a
l2y) = if a
l1x forall a. Eq a => a -> a -> Bool
== a
l2x
    -- last one was vertical, expect horizontal or reversal
    then a
ey forall a. Eq a => a -> a -> Bool
== a
l1y Bool -> Bool -> Bool
|| a
l1x forall a. Num a => a -> a -> a
- a
l2x forall a. Ord a => a -> a -> Bool
> a
ex forall a. Num a => a -> a -> a
- a
l2x
    -- last one was horizontal, expect vertical or reversal
    else a
ex forall a. Eq a => a -> a -> Bool
== a
l1x Bool -> Bool -> Bool
|| a
l1y forall a. Num a => a -> a -> a
- a
l2y forall a. Ord a => a -> a -> Bool
> a
ey forall a. Num a => a -> a -> a
- a
l2y

  foldfn :: V2 a
-> (Bool, Maybe (V2 a), Maybe (V2 a))
-> (Bool, Maybe (V2 a), Maybe (V2 a))
foldfn V2 a
e (Bool
pass, Maybe (V2 a)
mlast1, Maybe (V2 a)
mlast2) = if Bool -> Bool
not Bool
pass
    then (Bool
False, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
    else case Maybe (V2 a)
mlast1 of
      Just V2 a
last1 -> case Maybe (V2 a)
mlast2 of
        Just V2 a
last2 -> (forall {a}. (Ord a, Num a) => V2 a -> V2 a -> V2 a -> Bool
check2 V2 a
e V2 a
last1 V2 a
last2 , forall a. a -> Maybe a
Just V2 a
e, forall a. a -> Maybe a
Just V2 a
last1)
        Maybe (V2 a)
Nothing -> (forall {a}. Eq a => V2 a -> V2 a -> Bool
check1 V2 a
e V2 a
last1, forall a. a -> Maybe a
Just V2 a
e, forall a. a -> Maybe a
Just V2 a
last1)
      Maybe (V2 a)
Nothing -> (Bool
True, forall a. a -> Maybe a
Just V2 a
e, forall a. Maybe a
Nothing)

  (Bool
r, Maybe XY
_, Maybe XY
_) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}.
(Ord a, Num a) =>
V2 a
-> (Bool, Maybe (V2 a), Maybe (V2 a))
-> (Bool, Maybe (V2 a), Maybe (V2 a))
foldfn (Bool
True, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing) ([XY]
xs1forall a. Semigroup a => a -> a -> a
<>[XY]
xs2)

data CartLineHandler = CartLineHandler {
    CartLineHandler -> AnchorZipper
_cartLineHandler_anchors      :: AnchorZipper
    , CartLineHandler -> Bool
_cartLineHandler_undoFirst  :: Bool
    , CartLineHandler -> Bool
_cartLineHandler_isCreation :: Bool
    , CartLineHandler -> Bool
_cartLineHandler_active     :: Bool
  } deriving (Int -> CartLineHandler -> ShowS
[CartLineHandler] -> ShowS
CartLineHandler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CartLineHandler] -> ShowS
$cshowList :: [CartLineHandler] -> ShowS
show :: CartLineHandler -> String
$cshow :: CartLineHandler -> String
showsPrec :: Int -> CartLineHandler -> ShowS
$cshowsPrec :: Int -> CartLineHandler -> ShowS
Show)

instance Default CartLineHandler where
  def :: CartLineHandler
def = CartLineHandler {
      _cartLineHandler_anchors :: AnchorZipper
_cartLineHandler_anchors = AnchorZipper
emptyAnchorZipper
      , _cartLineHandler_undoFirst :: Bool
_cartLineHandler_undoFirst = Bool
False
      , _cartLineHandler_isCreation :: Bool
_cartLineHandler_isCreation = Bool
False
      , _cartLineHandler_active :: Bool
_cartLineHandler_active = Bool
False
    }


-- | get the last 2 elements of e1:e2:es
-- DELETE
last2 :: XY -> XY -> [XY] -> (XY, XY)
last2 :: XY -> XY -> [XY] -> (XY, XY)
last2 XY
e1 XY
e2 [XY]
es = (XY, XY)
r where
  l1 :: XY
l1 = forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last (XY
e1forall a. a -> [a] -> NonEmpty a
:|XY
e2forall a. a -> [a] -> [a]
:[XY]
es)
  l2 :: XY
l2 = case (forall a. [a] -> [a]
reverse [XY]
es) of
    [] -> XY
e1
    XY
x:[XY]
xs -> case [XY]
xs of
      [] -> XY
e2
      [XY]
_ -> XY
x
  r :: (XY, XY)
r = (XY
l1, XY
l2)

-- helper method for creating new anchor at the end of a sequence of anchors (when creating new lines)
-- both input and output anchor list is REVERSED
elbowFromEnd :: XY -> [XY] -> [XY]
elbowFromEnd :: XY -> [XY] -> [XY]
elbowFromEnd XY
pos [] = [XY
pos]
elbowFromEnd XY
pos (XY
e:[]) = [XY]
r where
  V2 Int
e1x Int
e1y = XY
e
  V2 Int
dx Int
dy = XY
pos forall a. Num a => a -> a -> a
- XY
e
  r :: [XY]
r = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ if Int
dx forall a. Ord a => a -> a -> Bool
> Int
dy
    then [XY
e, forall a. a -> a -> V2 a
V2 (Int
e1xforall a. Num a => a -> a -> a
+Int
dx) Int
e1y] forall a. Semigroup a => a -> a -> a
<> if Int
dy forall a. Eq a => a -> a -> Bool
== Int
0 then [] else [forall a. a -> a -> V2 a
V2 (Int
e1xforall a. Num a => a -> a -> a
+Int
dx) (Int
e1y forall a. Num a => a -> a -> a
+ Int
dy)]
    else [XY
e, forall a. a -> a -> V2 a
V2 Int
e1x (Int
e1y forall a. Num a => a -> a -> a
+ Int
dy)] forall a. Semigroup a => a -> a -> a
<> if Int
dx forall a. Eq a => a -> a -> Bool
== Int
0 then [] else [forall a. a -> a -> V2 a
V2 (Int
e1xforall a. Num a => a -> a -> a
+Int
dx) (Int
e1y forall a. Num a => a -> a -> a
+ Int
dy)]
elbowFromEnd XY
pos ls :: [XY]
ls@(XY
e1:(XY
e2:[XY]
es)) = [XY]
r where
  V2 Int
e1x Int
e1y = XY
e1
  V2 Int
e2x Int
e2y = XY
e2
  V2 Int
dx Int
dy = XY
pos forall a. Num a => a -> a -> a
- XY
e1
  r :: [XY]
r = if Int
dx forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
dy forall a. Eq a => a -> a -> Bool
== Int
0
    then [XY]
ls
    else if Int
e1x forall a. Eq a => a -> a -> Bool
== Int
e2x
      -- if last was vertical
      then if Int
dx forall a. Eq a => a -> a -> Bool
== Int
0
        -- if there was no horizontal change, update the last point
        then XY
posforall a. a -> [a] -> [a]
:XY
e2forall a. a -> [a] -> [a]
:[XY]
es
        --last was vertical, go horizontal first
        else (if Int
dy forall a. Eq a => a -> a -> Bool
== Int
0 then [] else [forall a. a -> a -> V2 a
V2 (Int
e1xforall a. Num a => a -> a -> a
+Int
dx) (Int
e1y forall a. Num a => a -> a -> a
+ Int
dy)]) forall a. Semigroup a => a -> a -> a
<> (forall a. a -> a -> V2 a
V2 (Int
e1xforall a. Num a => a -> a -> a
+Int
dx) Int
e1y forall a. a -> [a] -> [a]
: [XY]
ls)
      -- last was horizontal
      else if Int
dy forall a. Eq a => a -> a -> Bool
== Int
0
        -- if there was no vertical change, update the last point
        then XY
posforall a. a -> [a] -> [a]
:XY
e2forall a. a -> [a] -> [a]
:[XY]
es
        --last was horizontal, go vertical first
        else (if Int
dx forall a. Eq a => a -> a -> Bool
== Int
0 then [] else [forall a. a -> a -> V2 a
V2 (Int
e1xforall a. Num a => a -> a -> a
+Int
dx) (Int
e1y forall a. Num a => a -> a -> a
+ Int
dy)]) forall a. Semigroup a => a -> a -> a
<> (forall a. a -> a -> V2 a
V2 Int
e1x (Int
e1y forall a. Num a => a -> a -> a
+ Int
dy) forall a. a -> [a] -> [a]
: [XY]
ls)


smartAutoPathDown :: XY -> [XY] -> [XY]
smartAutoPathDown :: XY -> [XY] -> [XY]
smartAutoPathDown XY
pos [XY]
es = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ XY -> [XY] -> [XY]
elbowFromEnd XY
pos (forall a. [a] -> [a]
reverse [XY]
es)




instance PotatoHandler CartLineHandler where
  pHandlerName :: CartLineHandler -> Text
pHandlerName CartLineHandler
_ = Text
handlerName_cartesianLine
  pHandlerDebugShow :: CartLineHandler -> Text
pHandlerDebugShow CartLineHandler
clh = Text -> Text
LT.toStrict forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
Pretty.pShowNoColor CartLineHandler
clh
  pHandleMouse :: CartLineHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse clh :: CartLineHandler
clh@CartLineHandler {Bool
AnchorZipper
_cartLineHandler_active :: Bool
_cartLineHandler_isCreation :: Bool
_cartLineHandler_undoFirst :: Bool
_cartLineHandler_anchors :: AnchorZipper
_cartLineHandler_active :: CartLineHandler -> Bool
_cartLineHandler_isCreation :: CartLineHandler -> Bool
_cartLineHandler_undoFirst :: CartLineHandler -> Bool
_cartLineHandler_anchors :: CartLineHandler -> AnchorZipper
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
..}) = let

    -- restrict mouse
    dragDelta :: XY
dragDelta = XY
_mouseDrag_to forall a. Num a => a -> a -> a
- XY
_mouseDrag_from
    shiftClick :: Bool
shiftClick = forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers
    mousexy :: XY
mousexy = XY
_mouseDrag_from forall a. Num a => a -> a -> a
+ if Bool
shiftClick
      then XY -> XY
restrict4 XY
dragDelta
      else XY
dragDelta

    anchors :: [XY]
anchors = AnchorZipper -> [XY]
flattenAnchors AnchorZipper
_cartLineHandler_anchors

    in case MouseDragState
_mouseDrag_state of
      -- if shift is held down, ignore inputs, this allows us to shift + click to deselect
      -- TODO consider moving this into GoatWidget since it's needed by many manipulators
      MouseDragState
MouseDragState_Down | forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers -> forall a. Maybe a
Nothing

      -- TODO creation should be a separate handler
      -- creation case
      MouseDragState
MouseDragState_Down | Bool
_cartLineHandler_isCreation -> case AnchorZipper
_cartLineHandler_anchors of
        AnchorZipper [XY]
_ (XY
x:[XY]
xs) -> forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"this should never happen"
        AnchorZipper [] [] -> Maybe PotatoHandlerOutput
r where
          -- TODO track the fact we clicked, if we drag, pass on to SimpleLine? (but what happens if we drag back to start??)
          r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly forall a b. (a -> b) -> a -> b
$ CartLineHandler
clh {
              _cartLineHandler_active :: Bool
_cartLineHandler_active = Bool
True
              , _cartLineHandler_anchors :: AnchorZipper
_cartLineHandler_anchors = [XY] -> [XY] -> AnchorZipper
AnchorZipper [XY
mousexy] []
            }
        AnchorZipper (XY
x:[XY]
xs) [] -> if forall (f :: * -> *) a. IsNonEmpty f a a "last" => f a -> a
last (XY
x forall a. a -> [a] -> NonEmpty a
:| [XY]
xs) forall a. Eq a => a -> a -> Bool
== XY
mousexy
          -- if we click on the last dot, we're done, exit creation mode
          then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly forall a b. (a -> b) -> a -> b
$ CartLineHandler
clh {
              _cartLineHandler_isCreation :: Bool
_cartLineHandler_isCreation = Bool
True
              , _cartLineHandler_active :: Bool
_cartLineHandler_active = Bool
False -- is it bad that we're still dragging but this is set to False?
            }
          -- otherwise, smartly path dot to destination (always make 90 degree bend from current if possible)
          else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly forall a b. (a -> b) -> a -> b
$ CartLineHandler
clh {
              _cartLineHandler_anchors :: AnchorZipper
_cartLineHandler_anchors = [XY] -> [XY] -> AnchorZipper
AnchorZipper
                (XY -> [XY] -> [XY]
smartAutoPathDown XY
mousexy (AnchorZipper -> [XY]
flattenAnchorsInCreation AnchorZipper
_cartLineHandler_anchors))
                []
            }
      -- TODO someday allow dragging dots on in creation case (to adjust position)
      MouseDragState
MouseDragState_Dragging | Bool
_cartLineHandler_isCreation -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly CartLineHandler
clh
      MouseDragState
MouseDragState_Up | Bool
_cartLineHandler_isCreation ->  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly CartLineHandler
clh {
          -- disable creation mode on release (no reason besides it being convenient code wise)
          _cartLineHandler_isCreation :: Bool
_cartLineHandler_isCreation = Bool
_cartLineHandler_active
        }

      -- modify existing line case
      MouseDragState
MouseDragState_Down -> Maybe PotatoHandlerOutput
r where
        -- first go through and find dots we may have clicked on
        ([XY]
dotfs,[XY]
dotbs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
splitFind (forall a. Eq a => a -> a -> Bool
== XY
mousexy) [XY]
anchors
        -- then go through and find any lines we may have clicked on
        ([(XY, XY)]
linefs, [(XY, XY)]
linebs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
splitFind (XY -> (XY, XY) -> Bool
isBetween XY
mousexy) (forall a. [a] -> [(a, a)]
adjacentPairs [XY]
anchors)

        r :: Maybe PotatoHandlerOutput
r = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XY]
dotbs
          -- we did not click on any dots
          then if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(XY, XY)]
linebs
            -- we found nothing, input not captured
            then forall a. Maybe a
Nothing
            -- we clicked on a line
            else forall a. (?callStack::CallStack) => a
undefined -- TODO
          -- we clicked on a dot
          else forall a. (?callStack::CallStack) => a
undefined -- TODO

      -- TODO
      MouseDragState
MouseDragState_Dragging -> forall {a}. a
r where
        r :: a
r = forall a. (?callStack::CallStack) => a
undefined
      MouseDragState
MouseDragState_Up -> forall {a}. a
r where
        -- on release cases, topology may change (some anchors removed), unclear how to map topology (probably need meta data to track)
        -- if release is on a dummy dot, (in between two other dots)
        -- TODO
        r :: a
r = forall a. (?callStack::CallStack) => a
undefined

      MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a. Default a => a
def

  pHandleKeyboard :: CartLineHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard CartLineHandler
clh PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} KeyboardData
kbd = case KeyboardData
kbd of
    -- TODO keyboard movement based on last selected manipulator I guess
    KeyboardData
_                              -> forall a. Maybe a
Nothing

  pRenderHandler :: CartLineHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler clh :: CartLineHandler
clh@CartLineHandler {Bool
AnchorZipper
_cartLineHandler_active :: Bool
_cartLineHandler_isCreation :: Bool
_cartLineHandler_undoFirst :: Bool
_cartLineHandler_anchors :: AnchorZipper
_cartLineHandler_active :: CartLineHandler -> Bool
_cartLineHandler_isCreation :: CartLineHandler -> Bool
_cartLineHandler_undoFirst :: CartLineHandler -> Bool
_cartLineHandler_anchors :: CartLineHandler -> AnchorZipper
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = HandlerRenderOutput
r where
    toBoxHandle :: Bool -> XY -> RenderHandle
toBoxHandle Bool
isactive XY
xy = RenderHandle {
        _renderHandle_box :: LBox
_renderHandle_box = XY -> XY -> LBox
LBox XY
xy XY
1
        , _renderHandle_char :: Maybe PChar
_renderHandle_char = if Bool
isactive then forall a. a -> Maybe a
Just PChar
'+' else forall a. a -> Maybe a
Just PChar
'X'
        , _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Default
      }
    AnchorZipper [XY]
fronts' [XY]
backs' = AnchorZipper
_cartLineHandler_anchors
    fronts :: [RenderHandle]
fronts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> XY -> RenderHandle
toBoxHandle Bool
False) [XY]
fronts'
    backs :: [RenderHandle]
backs = case [XY]
backs' of
      [] -> []
      XY
x:[XY]
xs -> Bool -> XY -> RenderHandle
toBoxHandle Bool
True XY
x forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> XY -> RenderHandle
toBoxHandle Bool
False) [XY]
fronts'
    r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ([RenderHandle]
fronts forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
backs)
  pIsHandlerActive :: CartLineHandler -> Bool
pIsHandlerActive = CartLineHandler -> Bool
_cartLineHandler_active

  pHandlerTool :: CartLineHandler -> Maybe Tool
pHandlerTool CartLineHandler {Bool
AnchorZipper
_cartLineHandler_active :: Bool
_cartLineHandler_isCreation :: Bool
_cartLineHandler_undoFirst :: Bool
_cartLineHandler_anchors :: AnchorZipper
_cartLineHandler_active :: CartLineHandler -> Bool
_cartLineHandler_isCreation :: CartLineHandler -> Bool
_cartLineHandler_undoFirst :: CartLineHandler -> Bool
_cartLineHandler_anchors :: CartLineHandler -> AnchorZipper
..} = if Bool
_cartLineHandler_isCreation
    then forall a. a -> Maybe a
Just Tool
Tool_CartLine
    else forall a. Maybe a
Nothing