{-# OPTIONS_GHC -fno-warn-unused-record-wildcards #-}

{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Controller.Manipulator.Line (
  AutoLineHandler(..)
) where

import           Relude

import qualified Potato.Data.Text.Zipper                           as TZ
import           Potato.Flow.Attachments
import           Potato.Flow.BroadPhase
import           Potato.Flow.Controller.Handler
import           Potato.Flow.Controller.Input
import           Potato.Flow.Controller.Manipulator.Common
import           Potato.Flow.Controller.Manipulator.TextInputState
import           Potato.Flow.Controller.Types
import           Potato.Flow.DebugHelpers
import           Potato.Flow.Llama
import           Potato.Flow.Math
import           Potato.Flow.Methods.LineDrawer
import           Potato.Flow.Owl
import           Potato.Flow.OwlItem
import           Potato.Flow.OwlState
import           Potato.Flow.Serialization.Snake
import Potato.Flow.Methods.LlamaWorks
import Potato.Flow.Preview

import Control.Monad (msum)
import           Control.Exception
import           Data.Default
import qualified Data.List                                         as L
import qualified Data.List.Index                                   as L
import qualified Data.Sequence                                     as Seq
import qualified Data.Text                                         as T

import           Data.Maybe                                        (fromJust)


maybeGetSLine :: CanvasSelection -> Maybe (REltId, SAutoLine)
maybeGetSLine :: CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
selection = if forall a. Seq a -> Int
Seq.length (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
selection) forall a. Eq a => a -> a -> Bool
/= Int
1
  then forall a. Maybe a
Nothing
  else case SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl of
    SEltLine SAutoLine
sline -> forall a. a -> Maybe a
Just (Int
rid, SAutoLine
sline)
    SElt
_              -> forall a. Maybe a
Nothing
    where
      sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
selection
      rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl

mustGetSLine :: CanvasSelection -> (REltId, SAutoLine)
mustGetSLine :: CanvasSelection -> (Int, SAutoLine)
mustGetSLine = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine

-- TODO change return type to AvailableAttachment
-- TODO move me elsewhere
getAvailableAttachments :: Bool -> Bool -> OwlPFState -> BroadPhaseState -> LBox -> [(Attachment, XY)]
getAvailableAttachments :: Bool
-> Bool
-> OwlPFState
-> BroadPhaseState
-> LBox
-> [(Attachment, XY)]
getAvailableAttachments Bool
includeNoBorder Bool
offsetBorder OwlPFState
pfs BroadPhaseState
bps LBox
screenRegion = [(Attachment, XY)]
r where
  culled :: [Int]
culled = LBox -> BPTree -> [Int]
broadPhase_cull LBox
screenRegion (BroadPhaseState -> BPTree
_broadPhaseState_bPTree BroadPhaseState
bps)
  -- you could silently fail here by ignoring maybes but that would definitely be an indication of a bug so we fail here instead (you could do a better job about dumping debug info though)
  sowls :: [SuperOwl]
sowls = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall o. (HasOwlTree o, HasCallStack) => o -> Int -> SuperOwl
hasOwlTree_mustFindSuperOwl OwlPFState
pfs) [Int]
culled
  -- TODO sort sowls
  fmapfn :: SuperOwl -> [(Attachment, XY)]
fmapfn SuperOwl
sowl = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(AttachmentLocation
a,XY
p) -> (Int -> AttachmentLocation -> Attachment
attachment_create_default (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) AttachmentLocation
a, XY
p)) forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> OwlItem -> [(AttachmentLocation, XY)]
owlItem_availableAttachmentsAtDefaultLocation Bool
includeNoBorder Bool
offsetBorder (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl)
  r :: [(Attachment, XY)]
r = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> [(Attachment, XY)]
fmapfn [SuperOwl]
sowls

renderAttachments :: PotatoHandlerInput -> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]
renderAttachments :: PotatoHandlerInput
-> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]
renderAttachments PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} (Maybe Attachment
mstart, Maybe Attachment
mend) = [RenderHandle]
r where
  attachments :: [(Attachment, XY)]
attachments = Bool
-> Bool
-> OwlPFState
-> BroadPhaseState
-> LBox
-> [(Attachment, XY)]
getAvailableAttachments Bool
False Bool
True OwlPFState
_potatoHandlerInput_pFState BroadPhaseState
_potatoHandlerInput_broadPhase LBox
_potatoHandlerInput_screenRegion
  fmapattachmentfn :: (Attachment, XY) -> Maybe RenderHandle
fmapattachmentfn (Attachment
a,XY
p) = if Maybe Attachment -> Bool
matches Maybe Attachment
mstart Bool -> Bool -> Bool
|| Maybe Attachment -> Bool
matches Maybe Attachment
mend then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RenderHandle {
      _renderHandle_box :: LBox
_renderHandle_box = (XY -> XY -> LBox
LBox XY
p XY
1)
      , _renderHandle_char :: Maybe PChar
_renderHandle_char = forall a. a -> Maybe a
Just (Attachment -> PChar
attachmentRenderChar Attachment
a)
      , _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Attachment
    } where
      rid :: Int
rid = Attachment -> Int
_attachment_target Attachment
a
      al :: AttachmentLocation
al = Attachment -> AttachmentLocation
_attachment_location Attachment
a
      matches :: Maybe Attachment -> Bool
matches Maybe Attachment
ma = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Attachment
a' -> Attachment -> Int
_attachment_target Attachment
a' forall a. Eq a => a -> a -> Bool
== Int
rid Bool -> Bool -> Bool
&& Attachment -> AttachmentLocation
_attachment_location Attachment
a' forall a. Eq a => a -> a -> Bool
== AttachmentLocation
al) Maybe Attachment
ma forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
  r :: [RenderHandle]
r = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attachment, XY) -> Maybe RenderHandle
fmapattachmentfn [(Attachment, XY)]
attachments

-- set midpointhighlightindex index to -1 for no highlight
maybeRenderPoints :: (Bool,Bool) -> Bool -> Int -> PotatoHandlerInput -> [RenderHandle]
maybeRenderPoints :: (Bool, Bool) -> Bool -> Int -> PotatoHandlerInput -> [RenderHandle]
maybeRenderPoints (Bool
highlightstart, Bool
highlightend) Bool
offsetAttach Int
midpointhighlightindex PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} = [RenderHandle]
r where
  -- in creation cases, _potatoHandlerInput_canvasSelection might not be a line
  -- however we only render points in non creation cases (I think) so this maybe should plainly not be necessary
  mselt :: Maybe SElt
mselt = HasCallStack => CanvasSelection -> Maybe SuperOwl
selectionToMaybeFirstSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SElt
superOwl_toSElt_hack
  r1 :: [RenderHandle]
r1 = case Maybe SElt
mselt of
    Just (SEltLine SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
..}) -> [LBox -> Bool -> RenderHandle
makeRenderHandle (XY -> LBox
make_1area_lBox_from_XY XY
startHandle) Bool
True, LBox -> Bool -> RenderHandle
makeRenderHandle (XY -> LBox
make_1area_lBox_from_XY XY
endHandle) Bool
False]
      where
        startHandle :: XY
startHandle = forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start (HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetAttach OwlPFState
_potatoHandlerInput_pFState Maybe Attachment
_sAutoLine_attachStart)
        endHandle :: XY
endHandle = forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end (HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetAttach OwlPFState
_potatoHandlerInput_pFState Maybe Attachment
_sAutoLine_attachEnd)
        makeRenderHandle :: LBox -> Bool -> RenderHandle
makeRenderHandle LBox
b Bool
isstart = RenderHandle {
            _renderHandle_box :: LBox
_renderHandle_box     = LBox
b
            , _renderHandle_char :: Maybe PChar
_renderHandle_char  = if Bool
isstart then forall a. a -> Maybe a
Just PChar
'S' else forall a. a -> Maybe a
Just PChar
'E'
            , _renderHandle_color :: RenderHandleColor
_renderHandle_color = if (Bool
isstart Bool -> Bool -> Bool
&& Bool
highlightstart) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isstart Bool -> Bool -> Bool
&& Bool
highlightend) then RenderHandleColor
RHC_AttachmentHighlight else RenderHandleColor
RHC_Default
          }
    Maybe SElt
_ -> []
  r2 :: [RenderHandle]
r2 = case Maybe SElt
mselt of
    Just (SEltLine SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..}) -> forall a b. (Int -> a -> b) -> [a] -> [b]
L.imap Int -> SAutoLineConstraint -> RenderHandle
imapfn [SAutoLineConstraint]
_sAutoLine_midpoints
      where
        imapfn :: Int -> SAutoLineConstraint -> RenderHandle
imapfn Int
i SAutoLineConstraint
mp = case SAutoLineConstraint
mp of
          SAutoLineConstraintFixed XY
pos -> RenderHandle {
              _renderHandle_box :: LBox
_renderHandle_box     = XY -> LBox
make_1area_lBox_from_XY XY
pos
              , _renderHandle_char :: Maybe PChar
_renderHandle_char  = forall a. a -> Maybe a
Just PChar
'X'
              , _renderHandle_color :: RenderHandleColor
_renderHandle_color = if Int
midpointhighlightindex forall a. Eq a => a -> a -> Bool
== Int
i then RenderHandleColor
RHC_AttachmentHighlight else RenderHandleColor
RHC_Default
            }
    Maybe SElt
_ -> []
  r :: [RenderHandle]
r = [RenderHandle]
r1 forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
r2

renderLabels :: PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels :: PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} Bool
offsetByLabelHeight = [RenderHandle]
r where
  (Int
_, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
  labels :: [(XY, Int, SAutoLineLabel)]
labels = forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions OwlPFState
_potatoHandlerInput_pFState SAutoLine
sal
  fmapfn :: (XY, Int, SAutoLineLabel) -> RenderHandle
fmapfn (XY
pos,Int
_,SAutoLineLabel
_) = RenderHandle {
      _renderHandle_box :: LBox
_renderHandle_box     = if Bool
offsetByLabelHeight
        then XY -> LBox
make_1area_lBox_from_XY (XY
pos forall a. Num a => a -> a -> a
- (forall a. a -> a -> V2 a
V2 Int
0 Int
1))
        else XY -> LBox
make_1area_lBox_from_XY XY
pos
      , _renderHandle_char :: Maybe PChar
_renderHandle_char  = forall a. a -> Maybe a
Just PChar
'T'
      , _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Default
    }
  r :: [RenderHandle]
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XY, Int, SAutoLineLabel) -> RenderHandle
fmapfn [(XY, Int, SAutoLineLabel)]
labels


data AutoLineHandler = AutoLineHandler {
    AutoLineHandler -> Bool
_autoLineHandler_isCreation         :: Bool
    , AutoLineHandler -> Maybe Int
_autoLineHandler_mDownManipulator :: Maybe Int
    -- TODO who sets this?
    , AutoLineHandler -> Bool
_autoLineHandler_offsetAttach     :: Bool
  } deriving (Int -> AutoLineHandler -> ShowS
[AutoLineHandler] -> ShowS
AutoLineHandler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoLineHandler] -> ShowS
$cshowList :: [AutoLineHandler] -> ShowS
show :: AutoLineHandler -> String
$cshow :: AutoLineHandler -> String
showsPrec :: Int -> AutoLineHandler -> ShowS
$cshowsPrec :: Int -> AutoLineHandler -> ShowS
Show)

instance Default AutoLineHandler where
  def :: AutoLineHandler
def = AutoLineHandler {
      _autoLineHandler_isCreation :: Bool
_autoLineHandler_isCreation = Bool
False
      , _autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_mDownManipulator = forall a. Maybe a
Nothing
      , _autoLineHandler_offsetAttach :: Bool
_autoLineHandler_offsetAttach = Bool
True
    }

-- TODO instead of `LMP_Midpoint Int` consider using zipper
data LineManipulatorProxy = LMP_Endpoint Bool | LMP_Midpoint Int | LMP_Nothing

sAutoLineConstraint_handlerPosition :: SAutoLineConstraint -> XY
sAutoLineConstraint_handlerPosition :: SAutoLineConstraint -> XY
sAutoLineConstraint_handlerPosition SAutoLineConstraint
slc = case SAutoLineConstraint
slc of
  SAutoLineConstraintFixed XY
xy -> XY
xy

findFirstLineManipulator_NEW :: SAutoLine -> Bool -> OwlPFState -> RelMouseDrag-> LineManipulatorProxy
findFirstLineManipulator_NEW :: SAutoLine
-> Bool -> OwlPFState -> RelMouseDrag -> LineManipulatorProxy
findFirstLineManipulator_NEW SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} Bool
offsetBorder OwlPFState
pfs (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
..})= LineManipulatorProxy
r where
  start :: XY
start = forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetBorder OwlPFState
pfs Maybe Attachment
_sAutoLine_attachStart
  end :: XY
end = forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetBorder OwlPFState
pfs Maybe Attachment
_sAutoLine_attachEnd
  mmid :: Maybe Int
mmid = forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex (\SAutoLineConstraint
slc -> SAutoLineConstraint -> XY
sAutoLineConstraint_handlerPosition SAutoLineConstraint
slc forall a. Eq a => a -> a -> Bool
== XY
_mouseDrag_to) [SAutoLineConstraint]
_sAutoLine_midpoints
  r :: LineManipulatorProxy
r = if XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
== XY
start then Bool -> LineManipulatorProxy
LMP_Endpoint Bool
True
    else if XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
== XY
end then Bool -> LineManipulatorProxy
LMP_Endpoint Bool
False
      else forall b a. b -> (a -> b) -> Maybe a -> b
maybe LineManipulatorProxy
LMP_Nothing Int -> LineManipulatorProxy
LMP_Midpoint Maybe Int
mmid

-- TODO use cache
-- |
-- IMPORTANT MIDPOINT INDEXING DETAILS
-- midpoint indexing for N midpoints looks like
-- S ... 0 ... 1 ... N ... E
-- a midpoint index of (-1) is the segment between S and 0
--
-- e.g.
-- S ...(x)... 0 ... 1 ...
-- returns -1
-- favors right side
--
-- e.g.
-- S ... (x) ... 1
-- returns 0
--
-- to convert to _autoLineMidPointHandler_midPointIndex index you need to MINUS 1
whichSubSegmentDidClick :: OwlTree -> SAutoLine -> XY -> Maybe Int
whichSubSegmentDidClick :: OwlTree -> SAutoLine -> XY -> Maybe Int
whichSubSegmentDidClick OwlTree
ot sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} XY
pos = Maybe Int
r where
  lars :: [LineAnchorsForRender]
lars = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList OwlTree
ot SAutoLine
sline
  r :: Maybe Int
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (Int -> a -> Bool) -> [a] -> Maybe (Int, a)
L.ifind (\Int
_ LineAnchorsForRender
lar -> forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender -> XY -> Maybe Int
lineAnchorsForRender_findIntersectingSubsegment LineAnchorsForRender
lar XY
pos) [LineAnchorsForRender]
lars



getEndpointPosition ::  Bool -> OwlPFState -> SAutoLine -> Bool -> XY
getEndpointPosition :: Bool -> OwlPFState -> SAutoLine -> Bool -> XY
getEndpointPosition Bool
offsetAttach OwlPFState
pfs SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} Bool
isstart = if Bool
isstart
  then forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetAttach OwlPFState
pfs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
_sAutoLine_attachStart
  else forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetAttach OwlPFState
pfs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
_sAutoLine_attachEnd



-- |
-- see indexing information in 'whichSubSegmentDidClick'
getAnchorPosition :: (HasCallStack) => Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition :: HasCallStack => Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition Bool
offsetAttach OwlPFState
pfs sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} Int
anchorindex = XY
r where
  mps :: [SAutoLineConstraint]
mps = [SAutoLineConstraint]
_sAutoLine_midpoints
  endindex :: Int
endindex = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SAutoLineConstraint]
mps forall a. Num a => a -> a -> a
+ Int
1
  r :: XY
r = if Int
anchorindex forall a. Eq a => a -> a -> Bool
== Int
0
    then Bool -> OwlPFState -> SAutoLine -> Bool -> XY
getEndpointPosition Bool
offsetAttach OwlPFState
pfs SAutoLine
sline Bool
True
    else if Int
anchorindex forall a. Eq a => a -> a -> Bool
== Int
endindex
      then Bool -> OwlPFState -> SAutoLine -> Bool -> XY
getEndpointPosition Bool
offsetAttach OwlPFState
pfs SAutoLine
sline Bool
False
      else if Int
anchorindex forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
anchorindex forall a. Ord a => a -> a -> Bool
< Int
endindex
        then case [SAutoLineConstraint]
mps forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` (Int
anchorindexforall a. Num a => a -> a -> a
-Int
1) of
          SAutoLineConstraintFixed XY
xy -> XY
xy
        else forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"out of bounds anchor index " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
anchorindex



instance PotatoHandler AutoLineHandler where
  pHandlerName :: AutoLineHandler -> Text
pHandlerName AutoLineHandler
_ = Text
handlerName_simpleLine
  pHandleMouse :: AutoLineHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse slh :: AutoLineHandler
slh@AutoLineHandler {Bool
Maybe Int
_autoLineHandler_offsetAttach :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_isCreation :: Bool
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_isCreation :: AutoLineHandler -> Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let
    attachments :: [(Attachment, XY)]
attachments = Bool
-> Bool
-> OwlPFState
-> BroadPhaseState
-> LBox
-> [(Attachment, XY)]
getAvailableAttachments Bool
False Bool
True OwlPFState
_potatoHandlerInput_pFState BroadPhaseState
_potatoHandlerInput_broadPhase LBox
_potatoHandlerInput_screenRegion
    mattachend :: Maybe Attachment
mattachend = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)
isOverAttachment XY
_mouseDrag_to forall a b. (a -> b) -> a -> b
$ [(Attachment, XY)]
attachments

    in case MouseDragState
_mouseDrag_state of

      MouseDragState
MouseDragState_Down | Bool
_autoLineHandler_isCreation -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
          _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineEndPointHandler {
              _autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_isStart      = Bool
False
              , _autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_undoFirst  = Bool
False
              , _autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_isCreation = Bool
True
              , _autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_offsetAttach = Bool
_autoLineHandler_offsetAttach
              , _autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachStart = Maybe Attachment
mattachend
              , _autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachEnd = forall a. Maybe a
Nothing
              , _autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox = forall a. Maybe a
Nothing
            }
        }
      -- 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
      MouseDragState
MouseDragState_Down -> Maybe PotatoHandlerOutput
r where
        (Int
_, SAutoLine
sline) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection


        labels :: [(XY, Int, SAutoLineLabel)]
labels = forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions OwlPFState
_potatoHandlerInput_pFState SAutoLine
sline

        findlabelfn :: (XY, Int, SAutoLineLabel) -> Bool
findlabelfn (XY
pos, Int
_, SAutoLineLabel
llabel) = XY
pos forall a. Eq a => a -> a -> Bool
== XY
_mouseDrag_to Bool -> Bool -> Bool
|| LBox -> XY -> Bool
does_lBox_contains_XY (XY -> SAutoLineLabel -> LBox
getSAutoLineLabelBox XY
pos SAutoLineLabel
llabel) XY
_mouseDrag_to
        mfirstlabel :: Maybe (XY, Int, SAutoLineLabel)
mfirstlabel = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (XY, Int, SAutoLineLabel) -> Bool
findlabelfn [(XY, Int, SAutoLineLabel)]
labels
        firstlm :: LineManipulatorProxy
firstlm = SAutoLine
-> Bool -> OwlPFState -> RelMouseDrag -> LineManipulatorProxy
findFirstLineManipulator_NEW SAutoLine
sline Bool
_autoLineHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState RelMouseDrag
rmd

        -- TODO update cache someday
        mclickonline :: Maybe Int
mclickonline = OwlTree -> SAutoLine -> XY -> Maybe Int
whichSubSegmentDidClick (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
_potatoHandlerInput_pFState) SAutoLine
sline XY
_mouseDrag_to

        r :: Maybe PotatoHandlerOutput
r = case (LineManipulatorProxy
firstlm, Maybe (XY, Int, SAutoLineLabel)
mfirstlabel) of

          -- if clicked on endpoint
          (LMP_Endpoint Bool
isstart, Maybe (XY, Int, SAutoLineLabel)
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
              _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineEndPointHandler {
                  _autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_isStart      = Bool
isstart
                  , _autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_undoFirst  = Bool
False
                  , _autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_isCreation = Bool
False
                  , _autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_offsetAttach = Bool
_autoLineHandler_offsetAttach
                  , _autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachStart = forall a. Maybe a
Nothing
                  , _autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachEnd = forall a. Maybe a
Nothing
                  , _autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox = forall a. Maybe a
Nothing
                }
            }

          -- click on line label or label anchor
          -- TODO right now clicking on line itself also allows you to move it (as oppose to just the anchor) is this what we want?
          (LineManipulatorProxy
_, Just (XY
_,Int
index,SAutoLineLabel
_)) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            forall a. Default a => a
def {
                _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelMoverHandler {
                  _autoLineLabelMoverHandler_anchorOffset :: XY
_autoLineLabelMoverHandler_anchorOffset  = XY
0
                  , _autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler = forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineHandler
slh
                  , _autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_undoFirst   = Bool
False
                  , _autoLineLabelMoverHandler_labelIndex :: Int
_autoLineLabelMoverHandler_labelIndex  = Int
index
                }
              }

          -- if clicked on line but not on a handler, track the position
          (LineManipulatorProxy
LMP_Nothing, Maybe (XY, Int, SAutoLineLabel)
_) | forall a. Maybe a -> Bool
isJust Maybe Int
mclickonline -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
              _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineHandler
slh {
                  _autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_mDownManipulator = Maybe Int
mclickonline
                }
            }

          -- did not click on manipulator, no capture
          (LineManipulatorProxy
LMP_Nothing, Maybe (XY, Int, SAutoLineLabel)
_) -> forall a. Maybe a
Nothing

          (LMP_Midpoint Int
i, Maybe (XY, Int, SAutoLineLabel)
_) -> Maybe PotatoHandlerOutput
rslt where
            handler :: AutoLineMidPointHandler
handler = AutoLineMidPointHandler {
                _autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_midPointIndex = Int
i
                , _autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_isMidpointCreation = Bool
False
                , _autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_undoFirst  = Bool
False
                , _autoLineMidPointHandler_offsetAttach :: Bool
_autoLineMidPointHandler_offsetAttach = Bool
_autoLineHandler_offsetAttach
              }
            rslt :: Maybe PotatoHandlerOutput
rslt = forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse AutoLineMidPointHandler
handler PotatoHandlerInput
phi RelMouseDrag
rmd

      MouseDragState
MouseDragState_Dragging -> case Maybe Int
_autoLineHandler_mDownManipulator of
        -- TODO BUG how does this happen? This shouldn't happen as we must capture all dragging operations (I'm pretty sure you already fixed this by implementing the undo on cancel)
        -- this can happen if we cancel in the middle of a drag operation (say), it will recreate an AutoLineHandler from the selection
        Maybe Int
Nothing -> forall a. Maybe a
Nothing
        Just Int
i -> Maybe PotatoHandlerOutput
r where
          handler :: AutoLineMidPointHandler
handler = AutoLineMidPointHandler {
              _autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_midPointIndex = Int
i
              , _autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_isMidpointCreation = Bool
True
              , _autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_undoFirst  = Bool
False
              , _autoLineMidPointHandler_offsetAttach :: Bool
_autoLineMidPointHandler_offsetAttach = Bool
_autoLineHandler_offsetAttach
            }
          r :: Maybe PotatoHandlerOutput
r = forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse AutoLineMidPointHandler
handler PotatoHandlerInput
phi RelMouseDrag
rmd

      -- TODO if down and up on line manipulator (text portion and not the anchor portion)


      -- if we click down and directly up in the same spot on the line, create a line label there and pass on input to AutoLineLabelHandler
      MouseDragState
MouseDragState_Up -> case Maybe Int
_autoLineHandler_mDownManipulator of
        Maybe Int
Nothing -> forall a. a -> Maybe a
Just forall a. Default a => a
def
        Just Int
_ -> Maybe PotatoHandlerOutput
r where
          (Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
          -- PERF cache someday...
          larlist :: [LineAnchorsForRender]
larlist = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList OwlPFState
_potatoHandlerInput_pFState SAutoLine
sal
          (XY
_, Int
mpindex, Float
reld) = [LineAnchorsForRender] -> XY -> (XY, Int, Float)
getClosestPointOnLineFromLineAnchorsForRenderList [LineAnchorsForRender]
larlist XY
_mouseDrag_to
          newllabel :: SAutoLineLabel
newllabel = forall a. Default a => a
def {
              _sAutoLineLabel_index :: Int
_sAutoLineLabel_index = Int
mpindex
              , _sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_position = Float -> SAutoLineLabelPosition
SAutoLineLabelPositionRelative Float
reld
            }
          r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a. Default a => a
def {
              _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ Int
-> SAutoLine
-> SAutoLineLabel
-> SomePotatoHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> AutoLineLabelHandler
makeAutoLineLabelHandler_from_newLineLabel Int
rid SAutoLine
sal SAutoLineLabel
newllabel (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineHandler
slh) PotatoHandlerInput
phi RelMouseDrag
rmd
            }
      -- TODO is this correct??
      MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a. Default a => a
def
  pHandleKeyboard :: AutoLineHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard AutoLineHandler
_ PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
    KeyboardData
_                              -> forall a. Maybe a
Nothing
  pRenderHandler :: AutoLineHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineHandler {Bool
Maybe Int
_autoLineHandler_offsetAttach :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_isCreation :: Bool
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_isCreation :: AutoLineHandler -> Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
    boxes :: [RenderHandle]
boxes = (Bool, Bool) -> Bool -> Int -> PotatoHandlerInput -> [RenderHandle]
maybeRenderPoints (Bool
False, Bool
False) Bool
_autoLineHandler_offsetAttach (-Int
1) PotatoHandlerInput
phi
    -- TODO render attach endpoints from currently selected line (useful in the future when attach points aren't always in the middle)
      -- TODO don't render attachmentBoxes while dragging
    attachmentBoxes :: [RenderHandle]
attachmentBoxes = PotatoHandlerInput
-> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]
renderAttachments PotatoHandlerInput
phi (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)

    labels :: [RenderHandle]
labels = PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels PotatoHandlerInput
phi Bool
False

    r :: HandlerRenderOutput
r = if Bool
_autoLineHandler_isCreation
      -- creation handlers are rendered by AutoLineEndPointHandler once dragging starts
      then [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput [RenderHandle]
attachmentBoxes
      else [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ([RenderHandle]
attachmentBoxes forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
boxes forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
labels)

  pIsHandlerActive :: AutoLineHandler -> HandlerActiveState
pIsHandlerActive AutoLineHandler
_ = HandlerActiveState
HAS_Inactive
  pHandlerTool :: AutoLineHandler -> Maybe Tool
pHandlerTool AutoLineHandler {Bool
Maybe Int
_autoLineHandler_offsetAttach :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_isCreation :: Bool
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_isCreation :: AutoLineHandler -> Bool
..} = if Bool
_autoLineHandler_isCreation
    then forall a. a -> Maybe a
Just Tool
Tool_Line
    else forall a. Maybe a
Nothing


-- handles dragging endpoints (which can be attached) and creating new lines
data AutoLineEndPointHandler = AutoLineEndPointHandler {
  AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isStart        :: Bool -- either we are manipulating start, or we are manipulating end
  , AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst    :: Bool
  , AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation   :: Bool
  , AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_offsetAttach :: Bool -- who sets this?
  -- where the current modified line is attached to (_autoLineEndPointHandler_attachStart will differ from actual line in the case when we start creating a line on mouse down)
  , AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachStart  :: Maybe Attachment
  , AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachEnd    :: Maybe Attachment
  , AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
}




instance PotatoHandler AutoLineEndPointHandler where
  pHandlerName :: AutoLineEndPointHandler -> Text
pHandlerName AutoLineEndPointHandler
_ = Text
handlerName_simpleLine_endPoint
  pHandleMouse :: AutoLineEndPointHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse slh :: AutoLineEndPointHandler
slh@AutoLineEndPointHandler {Bool
Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
_autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_lastAttachedBox :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isStart :: AutoLineEndPointHandler -> Bool
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let
      mridssline :: Maybe (Int, SAutoLine)
mridssline = CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
      attachments :: [(Attachment, XY)]
attachments = Bool
-> Bool
-> OwlPFState
-> BroadPhaseState
-> LBox
-> [(Attachment, XY)]
getAvailableAttachments Bool
False Bool
True OwlPFState
_potatoHandlerInput_pFState BroadPhaseState
_potatoHandlerInput_broadPhase LBox
_potatoHandlerInput_screenRegion

      -- TODO change this so it tracks box we were attached to at the beggining for the duration of the AutoLineEndPointHandler drag  such that you can detach and reattach
      -- if we attached to some box we weren't already attached to
      mnewattachend :: Maybe Attachment
mnewattachend = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)
isOverAttachment XY
_mouseDrag_to forall a b. (a -> b) -> a -> b
$ [(Attachment, XY)]
attachments

      -- if we attached to the box we were already attached to
      mprojectattachend :: Maybe Attachment
mprojectattachend = case Maybe (Int, SAutoLine)
mridssline of
        Maybe (Int, SAutoLine)
Nothing -> forall a. Maybe a
Nothing
        Just (Int
_, SAutoLine
ssline) -> Maybe Attachment
r_2 where
          mattachedboxend :: Maybe (LBox, Attachment)
mattachedboxend = do
            Attachment
aend <- if Bool
_autoLineEndPointHandler_isStart then SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
ssline else SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
ssline
            LBox
box <- Bool -> OwlPFState -> Attachment -> Maybe LBox
maybeGetAttachmentBox Bool
_autoLineEndPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState Attachment
aend
            return (LBox
box, Attachment
aend)
          r_2 :: Maybe Attachment
r_2 = do
            (LBox
box, Attachment
aend) <- case Maybe (LBox, Attachment)
mattachedboxend of
              -- if we didn't attach to the box we already attached to, see if we can attach to the last box we were attached to (w)
              Maybe (LBox, Attachment)
Nothing -> case Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox of
                Just Attachment
x -> do
                  LBox
box <- Bool -> OwlPFState -> Attachment -> Maybe LBox
maybeGetAttachmentBox Bool
_autoLineEndPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState Attachment
x
                  return (LBox
box, Attachment
x)
                Maybe Attachment
Nothing -> forall a. Maybe a
Nothing
              Just (LBox, Attachment)
x -> forall a. a -> Maybe a
Just (LBox, Attachment)
x
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ AttachmentLocation -> XY -> Int -> LBox -> Maybe (Attachment, XY)
projectAttachment (Attachment -> AttachmentLocation
_attachment_location Attachment
aend) XY
_mouseDrag_to (Attachment -> Int
_attachment_target Attachment
aend) LBox
box


      mattachend :: Maybe Attachment
mattachend = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe Attachment
mprojectattachend, Maybe Attachment
mnewattachend]

    in case MouseDragState
_mouseDrag_state of
      MouseDragState
MouseDragState_Down -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should be handleed by AutoLineHandler"
      MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
        rid :: Int
rid = SuperOwl -> Int
_superOwl_id forall a b. (a -> b) -> a -> b
$ HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection

        ssline :: SAutoLine
ssline = case Maybe (Int, SAutoLine)
mridssline of
          Just (Int
_,SAutoLine
x) -> SAutoLine
x
          Maybe (Int, SAutoLine)
Nothing    -> forall a. Default a => a
def

        sslinestart :: Maybe Attachment
sslinestart = SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
ssline
        sslineend :: Maybe Attachment
sslineend = SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
ssline

        -- only attach on non trivial changes so we don't attach to our starting point
        nontrivialline :: Bool
nontrivialline = if Bool
_autoLineEndPointHandler_isStart
          then forall a. a -> Maybe a
Just XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
/= (HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
_autoLineEndPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
sslineend)
          else forall a. a -> Maybe a
Just XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
/= (HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
_autoLineEndPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
sslinestart)
        mattachendnontrivial :: Maybe Attachment
mattachendnontrivial = if Bool
nontrivialline
          then Maybe Attachment
mattachend
          else forall a. Maybe a
Nothing

        -- for modifying an existing elt
        modifiedline :: SAutoLine
modifiedline = if Bool
_autoLineEndPointHandler_isStart
          then SAutoLine
ssline {
              _sAutoLine_start :: XY
_sAutoLine_start       = XY
_mouseDrag_to
              , _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = Maybe Attachment
mattachendnontrivial
            }
          else SAutoLine
ssline {
              _sAutoLine_end :: XY
_sAutoLine_end       = XY
_mouseDrag_to
              , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = Maybe Attachment
mattachendnontrivial
            }

        -- for creating new elt
        newEltPos :: OwlSpot
newEltPos = OwlTree -> Selection -> OwlSpot
lastPositionInSelection (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
_potatoHandlerInput_pFState) Selection
_potatoHandlerInput_selection
        lineToAdd :: SAutoLine
lineToAdd = forall a. Default a => a
def {
            _sAutoLine_start :: XY
_sAutoLine_start = XY
_mouseDrag_from
            , _sAutoLine_end :: XY
_sAutoLine_end = XY
_mouseDrag_to
            , _sAutoLine_superStyle :: SuperStyle
_sAutoLine_superStyle = PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_superStyle PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters
            , _sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyle = PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyle PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters
            , _sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyleEnd =
            PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyleEnd PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters
            , _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = Maybe Attachment
_autoLineEndPointHandler_attachStart
            , _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = Maybe Attachment
mattachendnontrivial
          }

        op :: Llama
op = if Bool
_autoLineEndPointHandler_isCreation
          then OwlPFState -> OwlSpot -> OwlItem -> Llama
makeAddEltLlama OwlPFState
_potatoHandlerInput_pFState OwlSpot
newEltPos (OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
"<line>") forall a b. (a -> b) -> a -> b
$ SAutoLine -> OwlSubItem
OwlSubItemLine SAutoLine
lineToAdd)
          else (Int, SElt) -> Llama
makeSetLlama forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
modifiedline)

        r :: PotatoHandlerOutput
r = forall a. Default a => a
def {
            _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineEndPointHandler
slh {
                _autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_undoFirst = Bool
True
                , _autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachStart = if Bool
_autoLineEndPointHandler_isStart then Maybe Attachment
mattachendnontrivial else Maybe Attachment
_autoLineEndPointHandler_attachStart
                , _autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachEnd = if Bool -> Bool
not Bool
_autoLineEndPointHandler_isStart then Maybe Attachment
mattachendnontrivial else Maybe Attachment
_autoLineEndPointHandler_attachEnd
                , _autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox = case Maybe Attachment
mattachendnontrivial of
                  Maybe Attachment
Nothing -> Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox
                  Just Attachment
x -> forall a. a -> Maybe a
Just Attachment
x
              }
            , _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = Preview -> HandlerOutputAction
HOA_Preview forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview (Bool -> PreviewOperation
previewOperation_fromUndoFirst Bool
_autoLineEndPointHandler_undoFirst) Llama
op
          }
      -- no need to return AutoLineHandler, it will be recreated from selection by goat
      MouseDragState
MouseDragState_Up -> forall a. a -> Maybe a
Just forall a. Default a => a
def {
          _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = if Bool
_autoLineEndPointHandler_undoFirst then Preview -> HandlerOutputAction
HOA_Preview Preview
Preview_Commit else HandlerOutputAction
HOA_Nothing
        }
      MouseDragState
MouseDragState_Cancelled -> if Bool
_autoLineEndPointHandler_undoFirst then forall a. a -> Maybe a
Just forall a. Default a => a
def { _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = Preview -> HandlerOutputAction
HOA_Preview Preview
Preview_Cancel } else forall a. a -> Maybe a
Just forall a. Default a => a
def

  pHandleKeyboard :: AutoLineEndPointHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard AutoLineEndPointHandler
_ PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
_ = forall a. Maybe a
Nothing
  pRenderHandler :: AutoLineEndPointHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineEndPointHandler {Bool
Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
_autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_lastAttachedBox :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isStart :: AutoLineEndPointHandler -> Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
    boxes :: [RenderHandle]
boxes = (Bool, Bool) -> Bool -> Int -> PotatoHandlerInput -> [RenderHandle]
maybeRenderPoints (Bool
_autoLineEndPointHandler_isStart, Bool -> Bool
not Bool
_autoLineEndPointHandler_isStart) Bool
_autoLineEndPointHandler_offsetAttach (-Int
1) PotatoHandlerInput
phi
    attachmentBoxes :: [RenderHandle]
attachmentBoxes = PotatoHandlerInput
-> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]
renderAttachments PotatoHandlerInput
phi (Maybe Attachment
_autoLineEndPointHandler_attachStart, Maybe Attachment
_autoLineEndPointHandler_attachEnd)
    r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ([RenderHandle]
attachmentBoxes forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
boxes)
  pIsHandlerActive :: AutoLineEndPointHandler -> HandlerActiveState
pIsHandlerActive AutoLineEndPointHandler
_ = HandlerActiveState
HAS_Active_Mouse
  pHandlerTool :: AutoLineEndPointHandler -> Maybe Tool
pHandlerTool AutoLineEndPointHandler {Bool
Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
_autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_lastAttachedBox :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isStart :: AutoLineEndPointHandler -> Bool
..} = if Bool
_autoLineEndPointHandler_isCreation
    then forall a. a -> Maybe a
Just Tool
Tool_Line
    else forall a. Maybe a
Nothing


-- TODO finish
{-
adjustLineLabelPositionsAfterModifyingOrAddingMidpoint ::
  (HasOwlTree a)
  => a
  -> SAutoLine --  ^ the previous line
  -> SAutoLine -- ^ the new line
  -> Maybe (Either Int Int) -- ^ Nothing is modify case, Just Left is creat, Just Right is delete
  -> SAutoLine
adjustLineLabelPositionsAfterModifyingOrAddingMidpoint ot old new mempindex = r where

  -- TODO need more than just this, need to copmute position too
  indexAdjust i = case mempindex of
    Nothing             -> i
    -- advance indices after addmpi since we are adding a midpoint
    Just (Left addmpi)  -> if i > addmpi then i+1 else i
    -- go bacak indices before delmpi since we are deleting a midpoint
    Just (Right delmpi) -> if i >= delmpi then i-1 else i


  oldlars = sAutoLine_to_lineAnchorsForRenderList ot old
  newlars = sAutoLine_to_lineAnchorsForRenderList ot new

  -- TODO
  -- compute previous LAR distances
  -- compute new LAR distances (after adjusting for midpoint index)
  -- adjust distance by the change in ratio

  r = undefined
-}



sAutoLine_addMidpoint :: Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_addMidpoint :: Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_addMidpoint Int
mpindex XY
pos SAutoLine
sline = SAutoLine
r where
  newmidpoints :: [SAutoLineConstraint]
newmidpoints =  forall a. Int -> a -> [a] -> [a]
L.insertAt Int
mpindex (XY -> SAutoLineConstraint
SAutoLineConstraintFixed XY
pos) (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
sline)


  -- TODO update line label position


  fmapfn :: SAutoLineLabel -> SAutoLineLabel
fmapfn SAutoLineLabel
ll = if SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll forall a. Ord a => a -> a -> Bool
> Int
mpindex
    then SAutoLineLabel
ll { _sAutoLineLabel_index :: Int
_sAutoLineLabel_index = SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll forall a. Num a => a -> a -> a
+ Int
1}
    else SAutoLineLabel
ll
  newlabels :: [SAutoLineLabel]
newlabels = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SAutoLineLabel -> SAutoLineLabel
fmapfn (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline)

  r :: SAutoLine
r = SAutoLine
sline {
      _sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = [SAutoLineConstraint]
newmidpoints
      , _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = [SAutoLineLabel]
newlabels
    }

sAutoLine_modifyMidpoint :: Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_modifyMidpoint :: Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_modifyMidpoint Int
mpindex XY
pos SAutoLine
sline = SAutoLine
r where
  newmidpoints :: [SAutoLineConstraint]
newmidpoints =  forall a. Int -> (a -> a) -> [a] -> [a]
L.modifyAt Int
mpindex (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ XY -> SAutoLineConstraint
SAutoLineConstraintFixed XY
pos) (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
sline)
  -- TODO update line label position
  --fmapfn = undefined
  --newlabels = fmap fmapfn (_sAutoLine_labels sline)
  newlabels :: [SAutoLineLabel]
newlabels = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline

  r :: SAutoLine
r = SAutoLine
sline {
      _sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = [SAutoLineConstraint]
newmidpoints
      , _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = [SAutoLineLabel]
newlabels
    }


sAutoLine_deleteMidpoint :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteMidpoint :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteMidpoint Int
mpindex SAutoLine
sline = SAutoLine
r where
  newmidpoints :: [SAutoLineConstraint]
newmidpoints =  forall a. Int -> [a] -> [a]
L.deleteAt Int
mpindex (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
sline)
  -- TODO update line label position
  fmapfn :: SAutoLineLabel -> SAutoLineLabel
fmapfn SAutoLineLabel
ll = if SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll forall a. Ord a => a -> a -> Bool
>= Int
mpindex
    then SAutoLineLabel
ll { _sAutoLineLabel_index :: Int
_sAutoLineLabel_index = SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll forall a. Num a => a -> a -> a
- Int
1}
    else SAutoLineLabel
ll
  newlabels :: [SAutoLineLabel]
newlabels = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SAutoLineLabel -> SAutoLineLabel
fmapfn (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline)

  r :: SAutoLine
r = SAutoLine
sline {
      _sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = [SAutoLineConstraint]
newmidpoints
      , _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = [SAutoLineLabel]
newlabels
    }

-- handles dragging and creating new midpoints
data AutoLineMidPointHandler = AutoLineMidPointHandler{
  AutoLineMidPointHandler -> Int
_autoLineMidPointHandler_midPointIndex        :: Int
  , AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_isMidpointCreation :: Bool
  , AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_undoFirst          :: Bool
  , AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_offsetAttach       :: Bool
}

instance PotatoHandler AutoLineMidPointHandler where
  pHandlerName :: AutoLineMidPointHandler -> Text
pHandlerName AutoLineMidPointHandler
_ = Text
handlerName_simpleLine_midPoint
  pHandleMouse :: AutoLineMidPointHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse slh :: AutoLineMidPointHandler
slh@AutoLineMidPointHandler {Bool
Int
_autoLineMidPointHandler_offsetAttach :: Bool
_autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_offsetAttach :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_undoFirst :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_isMidpointCreation :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_midPointIndex :: AutoLineMidPointHandler -> Int
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = case MouseDragState
_mouseDrag_state of
    -- this only happens in the click on existing midpoint case (creation case is handled by dragging)
    -- nothing to do here
    MouseDragState
MouseDragState_Down -> forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not Bool
_autoLineMidPointHandler_isMidpointCreation) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineMidPointHandler
slh
    MouseDragState
MouseDragState_Dragging -> Maybe PotatoHandlerOutput
r where
      (Int
rid, SAutoLine
sline) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection

      -- TODO overlap adjacent issue, findFirstLineManipulator_NEW will midpoint instead of endpoint
      firstlm :: LineManipulatorProxy
firstlm = SAutoLine
-> Bool -> OwlPFState -> RelMouseDrag -> LineManipulatorProxy
findFirstLineManipulator_NEW SAutoLine
sline Bool
_autoLineMidPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState RelMouseDrag
rmd

      -- index into _sAutoLine_midpoints
      -- in the '_autoLineMidPointHandler_isMidpointCreation' case, the midpoint index is AFTER the midpoint gets created
      -- `_autoLineMidPointHandler_midPointIndex == N` means we have `N-1 ... (x) ... N`
      -- so the new indexing is `N-1 ... N (x) ... N+1`
      mpindex :: Int
mpindex = Int
_autoLineMidPointHandler_midPointIndex

      -- TODO not working
      -- NOTE indexing of getAnchorPosition is offset from index into _autoLineMidPointHandler_midPointIndex
      ladjacentpos :: XY
ladjacentpos = HasCallStack => Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition Bool
_autoLineMidPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState SAutoLine
sline Int
mpindex
      -- NOTE that this might be out of bounds in creation cases, but it won't get evaluated
      radjacentpos :: XY
radjacentpos = HasCallStack => Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition Bool
_autoLineMidPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState SAutoLine
sline (Int
mpindexforall a. Num a => a -> a -> a
+Int
2)
      isoveradjacent :: Bool
isoveradjacent = XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
== XY
ladjacentpos Bool -> Bool -> Bool
|| XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
== XY
radjacentpos

      newsline :: SAutoLine
newsline = if Bool
_autoLineMidPointHandler_isMidpointCreation
        then Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_addMidpoint Int
mpindex XY
_mouseDrag_to SAutoLine
sline
        else Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_modifyMidpoint Int
mpindex XY
_mouseDrag_to SAutoLine
sline

      newslinedelete :: SAutoLine
newslinedelete = Int -> SAutoLine -> SAutoLine
sAutoLine_deleteMidpoint Int
mpindex SAutoLine
sline


      (Bool
diddelete, Llama
event) = case LineManipulatorProxy
firstlm of
        -- create the new midpoint if none existed
        LineManipulatorProxy
_ | Bool
_autoLineMidPointHandler_isMidpointCreation -> (Bool
False,) forall a b. (a -> b) -> a -> b
$ (Int, SElt) -> Llama
makeSetLlama forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline)

        -- if overlapping existing ADJACENT endpoint do nothing (or undo if undo first)
        LineManipulatorProxy
_ | Bool
isoveradjacent -> (Bool
True,) forall a b. (a -> b) -> a -> b
$ (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newslinedelete)

        -- normal case, update the midpoint position
        LineManipulatorProxy
_ -> (Bool
False,) forall a b. (a -> b) -> a -> b
$ (Int, SElt) -> Llama
makeSetLlama forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline)

      r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
          _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineMidPointHandler
slh {
              -- go back to creation case IF we deleted a midpoint AND we weren't already in creation case (this can happen if you have two mid/endpoints right next to each other and you drag from one to the other)
              _autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_isMidpointCreation = Bool
diddelete Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
_autoLineMidPointHandler_isMidpointCreation
              , _autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_undoFirst  = Bool
True
            }
          , _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = Preview -> HandlerOutputAction
HOA_Preview forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview (Bool -> PreviewOperation
previewOperation_fromUndoFirst Bool
_autoLineMidPointHandler_undoFirst) Llama
event
        }
    -- no need to return AutoLineHandler, it will be recreated from selection by goat
    MouseDragState
MouseDragState_Up -> forall a. a -> Maybe a
Just forall a. Default a => a
def {
        _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = if Bool
_autoLineMidPointHandler_undoFirst then Preview -> HandlerOutputAction
HOA_Preview Preview
Preview_Commit else HandlerOutputAction
HOA_Nothing
      }
    MouseDragState
MouseDragState_Cancelled -> if Bool
_autoLineMidPointHandler_undoFirst then forall a. a -> Maybe a
Just forall a. Default a => a
def { _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = Preview -> HandlerOutputAction
HOA_Preview Preview
Preview_Cancel } else forall a. a -> Maybe a
Just forall a. Default a => a
def
  pRenderHandler :: AutoLineMidPointHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineMidPointHandler {Bool
Int
_autoLineMidPointHandler_offsetAttach :: Bool
_autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_offsetAttach :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_undoFirst :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_isMidpointCreation :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_midPointIndex :: AutoLineMidPointHandler -> Int
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
    boxes :: [RenderHandle]
boxes = (Bool, Bool) -> Bool -> Int -> PotatoHandlerInput -> [RenderHandle]
maybeRenderPoints (Bool
False, Bool
False) Bool
_autoLineMidPointHandler_offsetAttach Int
_autoLineMidPointHandler_midPointIndex PotatoHandlerInput
phi
    -- TODO render mouse position as there may not actually be a midpoint there
    r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput [RenderHandle]
boxes
  pIsHandlerActive :: AutoLineMidPointHandler -> HandlerActiveState
pIsHandlerActive AutoLineMidPointHandler
_ =  HandlerActiveState
HAS_Active_Mouse

-- handles creating and moving text labels
data AutoLineLabelMoverHandler = AutoLineLabelMoverHandler {
    AutoLineLabelMoverHandler -> XY
_autoLineLabelMoverHandler_anchorOffset  :: XY
    , AutoLineLabelMoverHandler -> SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
    , AutoLineLabelMoverHandler -> Bool
_autoLineLabelMoverHandler_undoFirst   :: Bool
    , AutoLineLabelMoverHandler -> Int
_autoLineLabelMoverHandler_labelIndex  :: Int
  }

-- TODO add support for moving line that does not exist yet
instance PotatoHandler AutoLineLabelMoverHandler where
  pHandlerName :: AutoLineLabelMoverHandler -> Text
pHandlerName AutoLineLabelMoverHandler
_ = Text
handlerName_simpleLine_textLabelMover
  pHandleMouse :: AutoLineLabelMoverHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse slh :: AutoLineLabelMoverHandler
slh@AutoLineLabelMoverHandler {Bool
Int
XY
SomePotatoHandler
_autoLineLabelMoverHandler_labelIndex :: Int
_autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: XY
_autoLineLabelMoverHandler_labelIndex :: AutoLineLabelMoverHandler -> Int
_autoLineLabelMoverHandler_undoFirst :: AutoLineLabelMoverHandler -> Bool
_autoLineLabelMoverHandler_prevHandler :: AutoLineLabelMoverHandler -> SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: AutoLineLabelMoverHandler -> XY
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let

      -- TODO move to helper
      (Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
      llabel :: SAutoLineLabel
llabel = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
_autoLineLabelMoverHandler_labelIndex
      -- PERF cache someday...
      larlist :: [LineAnchorsForRender]
larlist = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList OwlPFState
_potatoHandlerInput_pFState SAutoLine
sal
      (XY
_, Int
index, Float
reld) = [LineAnchorsForRender] -> XY -> (XY, Int, Float)
getClosestPointOnLineFromLineAnchorsForRenderList [LineAnchorsForRender]
larlist XY
_mouseDrag_to
      newl :: SAutoLineLabel
newl = SAutoLineLabel
llabel {
          _sAutoLineLabel_index :: Int
_sAutoLineLabel_index = Int
index
          , _sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_position = Float -> SAutoLineLabelPosition
SAutoLineLabelPositionRelative Float
reld
        }

    in case MouseDragState
_mouseDrag_state of

      MouseDragState
MouseDragState_Down -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineLabelMoverHandler
slh

      MouseDragState
MouseDragState_Dragging -> Maybe PotatoHandlerOutput
r where
        newsal :: SAutoLine
newsal = SAutoLine
sal {
            _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = forall a. Int -> a -> [a] -> [a]
L.setAt Int
_autoLineLabelMoverHandler_labelIndex SAutoLineLabel
newl (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal)
          }
        op :: Llama
op = (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsal)
        r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a. Default a => a
def {
            _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelMoverHandler
slh {
                _autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_undoFirst = Bool
True
              }
            , _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = Preview -> HandlerOutputAction
HOA_Preview forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview (Bool -> PreviewOperation
previewOperation_fromUndoFirst Bool
_autoLineLabelMoverHandler_undoFirst) Llama
op
          }

      MouseDragState
MouseDragState_Up -> forall a. a -> Maybe a
Just forall a. Default a => a
def {
          -- go back to AutoLineLabelHandler on completion
          _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = if Bool -> Bool
not Bool
_autoLineLabelMoverHandler_undoFirst
            -- if _autoLineLabelMoverHandler_undoFirst is false, this means we didn't drag at all, in which case go to label edit handler
            then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$
              Int
-> SomePotatoHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> AutoLineLabelHandler
makeAutoLineLabelHandler_from_labelIndex Int
_autoLineLabelMoverHandler_labelIndex SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler PotatoHandlerInput
phi RelMouseDrag
rmd
            -- TODO consider also going into edit handler after dragging an endpoint, but for now, just go back to the previous handler (which will be AutoLineHandler)
            else forall a. a -> Maybe a
Just (SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler)

          , _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = if Bool
_autoLineLabelMoverHandler_undoFirst then Preview -> HandlerOutputAction
HOA_Preview Preview
Preview_Commit else HandlerOutputAction
HOA_Nothing
        }

      MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a. Default a => a
def {
          -- go back to previous handler on cancel (could be AutoLineHandler or AutoLineLabelHandler)
          _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just (SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler)
          , _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = if Bool
_autoLineLabelMoverHandler_undoFirst then Preview -> HandlerOutputAction
HOA_Preview Preview
Preview_Cancel else HandlerOutputAction
HOA_Nothing
        }


  pRenderHandler :: AutoLineLabelMoverHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineLabelMoverHandler {Bool
Int
XY
SomePotatoHandler
_autoLineLabelMoverHandler_labelIndex :: Int
_autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: XY
_autoLineLabelMoverHandler_labelIndex :: AutoLineLabelMoverHandler -> Int
_autoLineLabelMoverHandler_undoFirst :: AutoLineLabelMoverHandler -> Bool
_autoLineLabelMoverHandler_prevHandler :: AutoLineLabelMoverHandler -> SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: AutoLineLabelMoverHandler -> XY
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
    labels :: [RenderHandle]
labels = PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels PotatoHandlerInput
phi Bool
False
    r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput [RenderHandle]
labels

  pIsHandlerActive :: AutoLineLabelMoverHandler -> HandlerActiveState
pIsHandlerActive AutoLineLabelMoverHandler
_ = HandlerActiveState
HAS_Active_Mouse



sAutoLine_deleteLabel :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteLabel :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteLabel Int
labelindex SAutoLine
sline = SAutoLine
r where
  newlabels :: [SAutoLineLabel]
newlabels =  forall a. Int -> [a] -> [a]
L.deleteAt Int
labelindex (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline)
  r :: SAutoLine
r = SAutoLine
sline {
      _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = [SAutoLineLabel]
newlabels
    }

-- handles modifying text labels
data AutoLineLabelHandler = AutoLineLabelHandler {
    AutoLineLabelHandler -> Bool
_autoLineLabelHandler_active        :: Bool
    , AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_state       :: TextInputState
    , AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_prevHandler :: SomePotatoHandler
    , AutoLineLabelHandler -> Bool
_autoLineLabelHandler_undoFirst   :: Bool

    , AutoLineLabelHandler -> Int
_autoLineLabelHandler_labelIndex  :: Int
    , AutoLineLabelHandler -> SAutoLineLabel
_autoLineLabelHandler_lineLabel   :: SAutoLineLabel

    -- this is needed to determine if erasing the last character in the label deletes the line label or undos the last operation
    , AutoLineLabelHandler -> Bool
_autoLineLabelHandler_creation    :: Bool
  }


getSAutoLineLabelBox :: XY -> SAutoLineLabel -> LBox
getSAutoLineLabelBox :: XY -> SAutoLineLabel -> LBox
getSAutoLineLabelBox (V2 Int
x Int
y) SAutoLineLabel
llabel = LBox
r where
  w :: Int
w = Text -> Int
T.length (SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel)
  r :: LBox
r = XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 (Int
x forall a. Num a => a -> a -> a
- Int
w forall a. Integral a => a -> a -> a
`div` Int
2) Int
y) (forall a. a -> a -> V2 a
V2 Int
w Int
1)

updateAutoLineLabelHandlerState :: (HasOwlTree a) => a -> Bool -> CanvasSelection -> AutoLineLabelHandler -> AutoLineLabelHandler
updateAutoLineLabelHandlerState :: forall a.
HasOwlTree a =>
a
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
updateAutoLineLabelHandlerState a
ot Bool
reset CanvasSelection
selection slh :: AutoLineLabelHandler
slh@AutoLineLabelHandler {Bool
Int
SAutoLineLabel
SomePotatoHandler
TextInputState
_autoLineLabelHandler_creation :: Bool
_autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_creation :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_lineLabel :: AutoLineLabelHandler -> SAutoLineLabel
_autoLineLabelHandler_labelIndex :: AutoLineLabelHandler -> Int
_autoLineLabelHandler_undoFirst :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_prevHandler :: AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_state :: AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_active :: AutoLineLabelHandler -> Bool
..} = AutoLineLabelHandler
r where

  -- TODO move to helper
  (Int
_, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
selection
  llabel :: SAutoLineLabel
llabel = if Text -> Bool
T.null (TextZipper -> Text
TZ.value (TextInputState -> TextZipper
_textInputState_zipper TextInputState
_autoLineLabelHandler_state))
    then SAutoLineLabel
_autoLineLabelHandler_lineLabel
    -- if we are not creating a new label pull the SAutoLineLabel again because it might have changed
    else SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
_autoLineLabelHandler_labelIndex
  newtext :: Text
newtext = SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
  pos :: XY
pos = forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPosition a
ot SAutoLine
sal SAutoLineLabel
llabel


  width :: Int
width = forall a. Bounded a => a
maxBound :: Int -- line label text always overflows
  box :: LBox
box = XY -> SAutoLineLabel -> LBox
getSAutoLineLabelBox XY
pos SAutoLineLabel
llabel


  r :: AutoLineLabelHandler
r = AutoLineLabelHandler
slh {
    _autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state = TextInputState
_autoLineLabelHandler_state {
          _textInputState_original :: Maybe Text
_textInputState_original = if Bool
reset then forall a. a -> Maybe a
Just Text
newtext else TextInputState -> Maybe Text
_textInputState_original TextInputState
_autoLineLabelHandler_state
          , _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
TZ.TextAlignment_Left Int
width () () (TextInputState -> TextZipper
_textInputState_zipper TextInputState
_autoLineLabelHandler_state)
          , _textInputState_box :: LBox
_textInputState_box = LBox
box
      }
    , _autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_undoFirst = if Bool
reset
      then Bool
False
      else Bool
_autoLineLabelHandler_undoFirst

    -- the previously stored label may have been modified so update it with the new one
    , _autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_lineLabel = SAutoLineLabel
llabel
  }

-- | make a TextInputState from a SAutoLineLabel on the SAutoLine
-- the SAutoLineLabel does not need to exist in the SAutoLine
makeAutoLineLabelInputState_from_lineLabel :: REltId -> SAutoLine -> SAutoLineLabel -> PotatoHandlerInput -> RelMouseDrag -> TextInputState
makeAutoLineLabelInputState_from_lineLabel :: Int
-> SAutoLine
-> SAutoLineLabel
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_lineLabel Int
rid SAutoLine
sal SAutoLineLabel
llabel PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} RelMouseDrag
rmd = TextInputState
r where
  ogtext :: Text
ogtext = SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
  pos :: XY
pos = forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPosition OwlPFState
_potatoHandlerInput_pFState SAutoLine
sal SAutoLineLabel
llabel
  box :: LBox
box = XY -> SAutoLineLabel -> LBox
getSAutoLineLabelBox XY
pos SAutoLineLabel
llabel

  width :: Int
width = forall a. Bounded a => a
maxBound :: Int -- line label text always overflows
  ogtz :: TextZipper
ogtz = Text -> TextZipper
TZ.fromText Text
ogtext
  tis :: TextInputState
tis = TextInputState {
      _textInputState_rid :: Int
_textInputState_rid = Int
rid
      , _textInputState_original :: Maybe Text
_textInputState_original   = forall a. a -> Maybe a
Just Text
ogtext
      , _textInputState_zipper :: TextZipper
_textInputState_zipper   = TextZipper
ogtz
      , _textInputState_box :: LBox
_textInputState_box = LBox
box
      , _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
TZ.TextAlignment_Left Int
width () () TextZipper
ogtz
    }
  r :: TextInputState
r = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
tis RelMouseDrag
rmd

makeAutoLineLabelInputState_from_labelIndex :: REltId -> SAutoLine -> Int -> PotatoHandlerInput -> RelMouseDrag -> TextInputState
makeAutoLineLabelInputState_from_labelIndex :: Int
-> SAutoLine
-> Int
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_labelIndex Int
rid SAutoLine
sal Int
labelindex phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} RelMouseDrag
rmd = TextInputState
r where
  llabel :: SAutoLineLabel
llabel = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
labelindex
  r :: TextInputState
r = Int
-> SAutoLine
-> SAutoLineLabel
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_lineLabel Int
rid SAutoLine
sal SAutoLineLabel
llabel PotatoHandlerInput
phi RelMouseDrag
rmd

makeAutoLineLabelHandler_from_newLineLabel :: REltId -> SAutoLine -> SAutoLineLabel -> SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> AutoLineLabelHandler
makeAutoLineLabelHandler_from_newLineLabel :: Int
-> SAutoLine
-> SAutoLineLabel
-> SomePotatoHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> AutoLineLabelHandler
makeAutoLineLabelHandler_from_newLineLabel Int
rid SAutoLine
sal SAutoLineLabel
llabel SomePotatoHandler
prev PotatoHandlerInput
phi RelMouseDrag
rmd = AutoLineLabelHandler {
    _autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_active = Bool
False
    , _autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state = (Int
-> SAutoLine
-> SAutoLineLabel
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_lineLabel Int
rid SAutoLine
sal SAutoLineLabel
llabel PotatoHandlerInput
phi RelMouseDrag
rmd)
    , _autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_prevHandler = SomePotatoHandler
prev
    , _autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_undoFirst = Bool
False
    , _autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_labelIndex = Int
0
    , _autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_lineLabel = SAutoLineLabel
llabel
    , _autoLineLabelHandler_creation :: Bool
_autoLineLabelHandler_creation = Bool
True
  }


makeAutoLineLabelHandler_from_labelIndex :: Int -> SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> AutoLineLabelHandler
makeAutoLineLabelHandler_from_labelIndex :: Int
-> SomePotatoHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> AutoLineLabelHandler
makeAutoLineLabelHandler_from_labelIndex Int
labelindex SomePotatoHandler
prev phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} RelMouseDrag
rmd = AutoLineLabelHandler
r where
  (Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
  llabel :: SAutoLineLabel
llabel = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
labelindex
  r :: AutoLineLabelHandler
r = AutoLineLabelHandler {
      _autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_active = Bool
False
      , _autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state = TextInputState -> TextInputState
moveToEol forall a b. (a -> b) -> a -> b
$ Int
-> SAutoLine
-> Int
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_labelIndex Int
rid SAutoLine
sal Int
labelindex PotatoHandlerInput
phi RelMouseDrag
rmd
      , _autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_prevHandler = SomePotatoHandler
prev
      , _autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_undoFirst = Bool
False
      , _autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_labelIndex = Int
labelindex
      , _autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_lineLabel = SAutoLineLabel
llabel
      , _autoLineLabelHandler_creation :: Bool
_autoLineLabelHandler_creation = Bool
False
    }




-- TODO get rid of LBox arg, not used anymore
-- | just a helper for pHandleMouse
handleMouseDownOrFirstUpForAutoLineLabelHandler :: AutoLineLabelHandler -> PotatoHandlerInput -> RelMouseDrag -> Bool -> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler :: AutoLineLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler slh :: AutoLineLabelHandler
slh@AutoLineLabelHandler {Bool
Int
SAutoLineLabel
SomePotatoHandler
TextInputState
_autoLineLabelHandler_creation :: Bool
_autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_creation :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_lineLabel :: AutoLineLabelHandler -> SAutoLineLabel
_autoLineLabelHandler_labelIndex :: AutoLineLabelHandler -> Int
_autoLineLabelHandler_undoFirst :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_prevHandler :: AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_state :: AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_active :: AutoLineLabelHandler -> Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) Bool
isdown = Maybe PotatoHandlerOutput
r where
  clickInside :: Bool
clickInside = LBox -> XY -> Bool
does_lBox_contains_XY (TextInputState -> LBox
_textInputState_box TextInputState
_autoLineLabelHandler_state) XY
_mouseDrag_to
  newState :: TextInputState
newState = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
_autoLineLabelHandler_state RelMouseDrag
rmd
  r :: Maybe PotatoHandlerOutput
r = if Bool
clickInside
    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
        _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelHandler
slh {
            _autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_active = Bool
isdown
            , _autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state = TextInputState
newState
          }
      }
    -- pass the input on to the base handler (so that you can interact with BoxHandler mouse manipulators too)
    else forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse SomePotatoHandler
_autoLineLabelHandler_prevHandler PotatoHandlerInput
phi RelMouseDrag
rmd

instance PotatoHandler AutoLineLabelHandler where
  pHandlerName :: AutoLineLabelHandler -> Text
pHandlerName AutoLineLabelHandler
_ = Text
handlerName_simpleLine_textLabel
  pHandleMouse :: AutoLineLabelHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse AutoLineLabelHandler
slh' phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let
      slh :: AutoLineLabelHandler
slh = forall a.
HasOwlTree a =>
a
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
updateAutoLineLabelHandlerState OwlPFState
_potatoHandlerInput_pFState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection AutoLineLabelHandler
slh'
    in case MouseDragState
_mouseDrag_state of
      -- TODO if click on drag anchor modifier thingy
      --    in this case, don't forget to reset creation and undofirst states
      MouseDragState
MouseDragState_Down -> AutoLineLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler AutoLineLabelHandler
slh PotatoHandlerInput
phi RelMouseDrag
rmd Bool
True
            -- TODO if click on handler, go into mover handler
            {- Just $ SomePotatoHandler AutoLineLabelMoverHandler {
                _autoLineLabelMoverHandler_prevHandler = SomePotatoHandler slh
                , _autoLineLabelMoverHandler_anchorOffset = 0
                , _autoLineLabelMoverHandler_undoFirst = True
                , _autoLineLabelMoverHandler_labelIndex = 0
              } -}

      -- TODO drag select text someday
      MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineLabelHandler
slh
      MouseDragState
MouseDragState_Up -> if Bool -> Bool
not (AutoLineLabelHandler -> Bool
_autoLineLabelHandler_active AutoLineLabelHandler
slh)
        then AutoLineLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler AutoLineLabelHandler
slh PotatoHandlerInput
phi RelMouseDrag
rmd Bool
False
        else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
            _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelHandler
slh {
                _autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_active = Bool
False
              }
          }
      MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineLabelHandler
slh

  pHandleKeyboard :: AutoLineLabelHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard AutoLineLabelHandler
slh' PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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 KeyboardKey
k [KeyModifier]
_) = let
      -- this regenerates displayLines unecessarily but who cares
      slh :: AutoLineLabelHandler
slh = forall a.
HasOwlTree a =>
a
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
updateAutoLineLabelHandlerState OwlPFState
_potatoHandlerInput_pFState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection AutoLineLabelHandler
slh'
      -- TODO cache this in slh
      (Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
    in case KeyboardKey
k of
      -- Escape or Return
      KeyboardKey
_ | KeyboardKey
k forall a. Eq a => a -> a -> Bool
== KeyboardKey
KeyboardKey_Esc Bool -> Bool -> Bool
|| KeyboardKey
k forall a. Eq a => a -> a -> Bool
== KeyboardKey
KeyboardKey_Return -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just (AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_prevHandler AutoLineLabelHandler
slh) }

      -- TODO should only capture stuff caught by inputSingleLineZipper
      --  make sure pRefreshHandler clears the handler or sets it back to creation case in the event that an undo operation clears the handler
      KeyboardKey
_ -> forall a. a -> Maybe a
Just PotatoHandlerOutput
r where

        -- TODO decide what to do with mods

        oldtais :: TextInputState
oldtais = AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_state AutoLineLabelHandler
slh
        oldtextnull :: Bool
oldtextnull = Text -> Bool
T.null (TextZipper -> Text
TZ.value (TextInputState -> TextZipper
_textInputState_zipper TextInputState
oldtais))

        -- if text was created, create the line label, you shouldn't need to but double check that there was no text before
        doescreate :: Bool
doescreate = Bool
oldtextnull
        (Bool
changed, TextInputState
newtais) = TextInputState -> KeyboardKey -> (Bool, TextInputState)
inputSingleLineZipper TextInputState
oldtais KeyboardKey
k
        newtext :: Text
newtext = TextZipper -> Text
TZ.value (TextInputState -> TextZipper
_textInputState_zipper TextInputState
newtais)
        oldlabel :: SAutoLineLabel
oldlabel = AutoLineLabelHandler -> SAutoLineLabel
_autoLineLabelHandler_lineLabel AutoLineLabelHandler
slh
        newlabel :: SAutoLineLabel
newlabel = SAutoLineLabel
oldlabel {
            _sAutoLineLabel_text :: Text
_sAutoLineLabel_text = Text
newtext
          }


        newsal_creation :: SAutoLine
newsal_creation = SAutoLine
sal {
            _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = SAutoLineLabel
newlabel forall a. a -> [a] -> [a]
: SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal
          }

        newsal_update :: SAutoLine
newsal_update = SAutoLine
sal {
            _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = forall a. Int -> a -> [a] -> [a]
L.setAt (AutoLineLabelHandler -> Int
_autoLineLabelHandler_labelIndex AutoLineLabelHandler
slh) SAutoLineLabel
newlabel (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal)
          }

        -- if all text was removed, delete the line label, you shouldn't need to but double check that there was actually a label to delete
        doesdelete :: Bool
doesdelete = Text -> Bool
T.null Text
newtext Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
oldtextnull
        newsal_delete :: SAutoLine
newsal_delete = Int -> SAutoLine -> SAutoLine
sAutoLine_deleteLabel (AutoLineLabelHandler -> Int
_autoLineLabelHandler_labelIndex AutoLineLabelHandler
slh) SAutoLine
sal

        newsal :: SAutoLine
newsal = if Bool
doesdelete
          then SAutoLine
newsal_delete
          else if Bool
doescreate
            then SAutoLine
newsal_creation
            else SAutoLine
newsal_update

        action :: HandlerOutputAction
action = if Bool -> Bool
not Bool
changed
          then HandlerOutputAction
HOA_Nothing
          else if Bool
doesdelete Bool -> Bool -> Bool
&& AutoLineLabelHandler -> Bool
_autoLineLabelHandler_creation AutoLineLabelHandler
slh
            -- if we deleted a newly created line just undo the last operation
            then Preview -> HandlerOutputAction
HOA_Preview Preview
Preview_Cancel
            else Preview -> HandlerOutputAction
HOA_Preview forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview (Bool -> PreviewOperation
previewOperation_fromUndoFirst (AutoLineLabelHandler -> Bool
_autoLineLabelHandler_undoFirst AutoLineLabelHandler
slh)) forall a b. (a -> b) -> a -> b
$ (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsal)


        r :: PotatoHandlerOutput
r = forall a. Default a => a
def {
            _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelHandler
slh {
                _autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state  = TextInputState
newtais
                , _autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_undoFirst = case HandlerOutputAction
action of
                  HandlerOutputAction
HOA_Nothing      -> AutoLineLabelHandler -> Bool
_autoLineLabelHandler_undoFirst AutoLineLabelHandler
slh
                  HOA_Preview Preview
Preview_Cancel -> Bool
False
                  HandlerOutputAction
_            -> Bool
True
              }
            , _potatoHandlerOutput_action :: HandlerOutputAction
_potatoHandlerOutput_action = HandlerOutputAction
action
          }

  pRefreshHandler :: AutoLineLabelHandler
-> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler AutoLineLabelHandler
slh PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
..} =  if forall a. Seq a -> Bool
Seq.null (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
    then forall a. Maybe a
Nothing -- selection was deleted or something
    else if Int
rid forall a. Eq a => a -> a -> Bool
/= (TextInputState -> Int
_textInputState_rid forall a b. (a -> b) -> a -> b
$ AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_state AutoLineLabelHandler
slh)
      then forall a. Maybe a
Nothing -- selection was change to something else
      else case SElt
selt of
        -- TODO proper regeneration of AutoLineLabelHandler (this is only needed when you support remote events)
        SEltLine SAutoLine
_ -> forall a. Maybe a
Nothing
        SElt
_          -> forall a. Maybe a
Nothing
      where
        sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
        rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
        selt :: SElt
selt = SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl

  pRenderHandler :: AutoLineLabelHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineLabelHandler
slh' PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
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
    slh :: AutoLineLabelHandler
slh = forall a.
HasOwlTree a =>
a
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
updateAutoLineLabelHandlerState OwlPFState
_potatoHandlerInput_pFState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection AutoLineLabelHandler
slh'

    -- consider rendering endpoints?

    -- TODO render label mover anchor with offset 1

    -- render the text cursor
    btis :: TextInputState
btis = AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_state AutoLineLabelHandler
slh
    r :: HandlerRenderOutput
r = TextInputState -> HandlerRenderOutput
makeTextHandlerRenderOutput TextInputState
btis

  -- TODO set properly
  pIsHandlerActive :: AutoLineLabelHandler -> HandlerActiveState
pIsHandlerActive AutoLineLabelHandler
slh = if AutoLineLabelHandler -> Bool
_autoLineLabelHandler_active AutoLineLabelHandler
slh then HandlerActiveState
HAS_Active_Mouse else HandlerActiveState
HAS_Active_Keyboard