{-# 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.OwlWorkspace
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 Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
selection) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
then Maybe (Int, SAutoLine)
forall a. Maybe a
Nothing
else case SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl of
SEltLine SAutoLine
sline -> (Int, SAutoLine) -> Maybe (Int, SAutoLine)
forall a. a -> Maybe a
Just (Int
rid, SAutoLine
sline)
SElt
_ -> Maybe (Int, SAutoLine)
forall a. Maybe a
Nothing
where
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
selection
rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
mustGetSLine :: CanvasSelection -> (REltId, SAutoLine)
mustGetSLine :: CanvasSelection -> (Int, SAutoLine)
mustGetSLine = Maybe (Int, SAutoLine) -> (Int, SAutoLine)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, SAutoLine) -> (Int, SAutoLine))
-> (CanvasSelection -> Maybe (Int, SAutoLine))
-> CanvasSelection
-> (Int, SAutoLine)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine
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)
sowls :: [SuperOwl]
sowls = (Int -> SuperOwl) -> [Int] -> [SuperOwl]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OwlPFState -> Int -> SuperOwl
forall o. (HasOwlTree o, HasCallStack) => o -> Int -> SuperOwl
hasOwlTree_mustFindSuperOwl OwlPFState
pfs) [Int]
culled
fmapfn :: SuperOwl -> [(Attachment, XY)]
fmapfn SuperOwl
sowl = ((AttachmentLocation, XY) -> (Attachment, XY))
-> [(AttachmentLocation, XY)] -> [(Attachment, XY)]
forall a b. (a -> b) -> [a] -> [b]
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)) ([(AttachmentLocation, XY)] -> [(Attachment, XY)])
-> [(AttachmentLocation, XY)] -> [(Attachment, XY)]
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 = [[(Attachment, XY)]] -> [(Attachment, XY)]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Attachment, XY)]] -> [(Attachment, XY)])
-> [[(Attachment, XY)]] -> [(Attachment, XY)]
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> [(Attachment, XY)])
-> [SuperOwl] -> [[(Attachment, XY)]]
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_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
..} (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 Maybe RenderHandle
forall a. Maybe a
Nothing else RenderHandle -> Maybe RenderHandle
forall a. a -> Maybe a
Just (RenderHandle -> Maybe RenderHandle)
-> RenderHandle -> Maybe RenderHandle
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 = PChar -> Maybe PChar
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 = (Attachment -> Bool) -> Maybe Attachment -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Attachment
a' -> Attachment -> Int
_attachment_target Attachment
a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rid Bool -> Bool -> Bool
&& Attachment -> AttachmentLocation
_attachment_location Attachment
a' AttachmentLocation -> AttachmentLocation -> Bool
forall a. Eq a => a -> a -> Bool
== AttachmentLocation
al) Maybe Attachment
ma Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
r :: [RenderHandle]
r = [Maybe RenderHandle] -> [RenderHandle]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe RenderHandle] -> [RenderHandle])
-> [Maybe RenderHandle] -> [RenderHandle]
forall a b. (a -> b) -> a -> b
$ ((Attachment, XY) -> Maybe RenderHandle)
-> [(Attachment, XY)] -> [Maybe RenderHandle]
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
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_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = [RenderHandle]
r where
mselt :: Maybe SElt
mselt = HasCallStack => CanvasSelection -> Maybe SuperOwl
CanvasSelection -> Maybe SuperOwl
selectionToMaybeFirstSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection Maybe SuperOwl -> (SuperOwl -> Maybe SElt) -> Maybe SElt
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SElt -> Maybe SElt
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (SElt -> Maybe SElt)
-> (SuperOwl -> SElt) -> SuperOwl -> Maybe SElt
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_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
..}) -> [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 = XY -> Maybe XY -> XY
forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start (HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetAttach OwlPFState
_potatoHandlerInput_pFState Maybe Attachment
_sAutoLine_attachStart)
endHandle :: XY
endHandle = XY -> Maybe XY -> XY
forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end (HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
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 PChar -> Maybe PChar
forall a. a -> Maybe a
Just PChar
'S' else PChar -> Maybe PChar
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_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
..}) -> (Int -> SAutoLineConstraint -> RenderHandle)
-> [SAutoLineConstraint] -> [RenderHandle]
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 = PChar -> Maybe PChar
forall a. a -> Maybe a
Just PChar
'X'
, _renderHandle_color :: RenderHandleColor
_renderHandle_color = if Int
midpointhighlightindex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then RenderHandleColor
RHC_AttachmentHighlight else RenderHandleColor
RHC_Default
}
Maybe SElt
_ -> []
r :: [RenderHandle]
r = [RenderHandle]
r1 [RenderHandle] -> [RenderHandle] -> [RenderHandle]
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_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} Bool
offsetByLabelHeight = [RenderHandle]
r where
(Int
_, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
labels :: [(XY, Int, SAutoLineLabel)]
labels = OwlPFState -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
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 XY -> XY -> XY
forall a. Num a => a -> a -> a
- (Int -> Int -> XY
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 = PChar -> Maybe PChar
forall a. a -> Maybe a
Just PChar
'T'
, _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Default
}
r :: [RenderHandle]
r = ((XY, Int, SAutoLineLabel) -> RenderHandle)
-> [(XY, Int, SAutoLineLabel)] -> [RenderHandle]
forall a b. (a -> b) -> [a] -> [b]
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
, AutoLineHandler -> Bool
_autoLineHandler_offsetAttach :: Bool
} deriving (Int -> AutoLineHandler -> ShowS
[AutoLineHandler] -> ShowS
AutoLineHandler -> String
(Int -> AutoLineHandler -> ShowS)
-> (AutoLineHandler -> String)
-> ([AutoLineHandler] -> ShowS)
-> Show AutoLineHandler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoLineHandler -> ShowS
showsPrec :: Int -> AutoLineHandler -> ShowS
$cshow :: AutoLineHandler -> String
show :: AutoLineHandler -> String
$cshowList :: [AutoLineHandler] -> ShowS
showList :: [AutoLineHandler] -> ShowS
Show)
instance Default AutoLineHandler where
def :: AutoLineHandler
def = AutoLineHandler {
_autoLineHandler_isCreation :: Bool
_autoLineHandler_isCreation = Bool
False
, _autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_mDownManipulator = Maybe Int
forall a. Maybe a
Nothing
, _autoLineHandler_offsetAttach :: Bool
_autoLineHandler_offsetAttach = Bool
True
}
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_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
..} Bool
offsetBorder OwlPFState
pfs (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
..})= LineManipulatorProxy
r where
start :: XY
start = XY -> Maybe XY -> XY
forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start (Maybe XY -> XY) -> Maybe XY -> XY
forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetBorder OwlPFState
pfs Maybe Attachment
_sAutoLine_attachStart
end :: XY
end = XY -> Maybe XY -> XY
forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end (Maybe XY -> XY) -> Maybe XY -> XY
forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetBorder OwlPFState
pfs Maybe Attachment
_sAutoLine_attachEnd
mmid :: Maybe Int
mmid = (SAutoLineConstraint -> Bool) -> [SAutoLineConstraint] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex (\SAutoLineConstraint
slc -> SAutoLineConstraint -> XY
sAutoLineConstraint_handlerPosition SAutoLineConstraint
slc XY -> XY -> Bool
forall a. Eq a => a -> a -> Bool
== XY
_mouseDrag_to) [SAutoLineConstraint]
_sAutoLine_midpoints
r :: LineManipulatorProxy
r = if XY
_mouseDrag_to XY -> XY -> Bool
forall a. Eq a => a -> a -> Bool
== XY
start then Bool -> LineManipulatorProxy
LMP_Endpoint Bool
True
else if XY
_mouseDrag_to XY -> XY -> Bool
forall a. Eq a => a -> a -> Bool
== XY
end then Bool -> LineManipulatorProxy
LMP_Endpoint Bool
False
else LineManipulatorProxy
-> (Int -> LineManipulatorProxy)
-> Maybe Int
-> LineManipulatorProxy
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LineManipulatorProxy
LMP_Nothing Int -> LineManipulatorProxy
LMP_Midpoint Maybe Int
mmid
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_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
..} XY
pos = Maybe Int
r where
lars :: [LineAnchorsForRender]
lars = OwlTree -> SAutoLine -> [LineAnchorsForRender]
forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList OwlTree
ot SAutoLine
sline
r :: Maybe Int
r = ((Int, LineAnchorsForRender) -> Int)
-> Maybe (Int, LineAnchorsForRender) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, LineAnchorsForRender) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, LineAnchorsForRender) -> Maybe Int)
-> Maybe (Int, LineAnchorsForRender) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Int -> LineAnchorsForRender -> Bool)
-> [LineAnchorsForRender] -> Maybe (Int, LineAnchorsForRender)
forall a. (Int -> a -> Bool) -> [a] -> Maybe (Int, a)
L.ifind (\Int
_ LineAnchorsForRender
lar -> Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
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_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
..} Bool
isstart = if Bool
isstart
then XY -> Maybe XY -> XY
forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start (Maybe XY -> XY) -> Maybe XY -> XY
forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetAttach OwlPFState
pfs (Attachment -> Maybe XY) -> Maybe Attachment -> Maybe XY
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
_sAutoLine_attachStart
else XY -> Maybe XY -> XY
forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end (Maybe XY -> XY) -> Maybe XY -> XY
forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetAttach OwlPFState
pfs (Attachment -> Maybe XY) -> Maybe Attachment -> Maybe XY
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
_sAutoLine_attachEnd
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_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
..} Int
anchorindex = XY
r where
mps :: [SAutoLineConstraint]
mps = [SAutoLineConstraint]
_sAutoLine_midpoints
endindex :: Int
endindex = [SAutoLineConstraint] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SAutoLineConstraint]
mps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
r :: XY
r = if Int
anchorindex Int -> Int -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
anchorindex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
endindex
then case [SAutoLineConstraint]
mps [SAutoLineConstraint] -> Int -> SAutoLineConstraint
forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` (Int
anchorindexInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of
SAutoLineConstraintFixed XY
xy -> XY
xy
else Text -> XY
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> XY) -> Text -> XY
forall a b. (a -> b) -> a -> b
$ Text
"out of bounds anchor index " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
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_isCreation :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_isCreation :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_offsetAttach :: Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = 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 = ((Attachment, XY) -> Attachment)
-> Maybe (Attachment, XY) -> Maybe Attachment
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attachment, XY) -> Attachment
forall a b. (a, b) -> a
fst (Maybe (Attachment, XY) -> Maybe Attachment)
-> ([(Attachment, XY)] -> Maybe (Attachment, XY))
-> [(Attachment, XY)]
-> Maybe Attachment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)
isOverAttachment XY
_mouseDrag_to ([(Attachment, XY)] -> Maybe Attachment)
-> [(Attachment, XY)] -> Maybe Attachment
forall a b. (a -> b) -> a -> b
$ [(Attachment, XY)]
attachments
in case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down | Bool
_autoLineHandler_isCreation -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler AutoLineEndPointHandler {
_autoLineEndPointHandler_isStart = False
, _autoLineEndPointHandler_undoFirst = False
, _autoLineEndPointHandler_isCreation = True
, _autoLineEndPointHandler_offsetAttach = _autoLineHandler_offsetAttach
, _autoLineEndPointHandler_attachStart = mattachend
, _autoLineEndPointHandler_attachEnd = Nothing
, _autoLineEndPointHandler_lastAttachedBox = Nothing
}
}
MouseDragState
MouseDragState_Down | KeyModifier -> [KeyModifier] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
MouseDragState
MouseDragState_Down -> Maybe PotatoHandlerOutput
r where
(Int
_, SAutoLine
sline) = Maybe (Int, SAutoLine) -> (Int, SAutoLine)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, SAutoLine) -> (Int, SAutoLine))
-> Maybe (Int, SAutoLine) -> (Int, SAutoLine)
forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
labels :: [(XY, Int, SAutoLineLabel)]
labels = OwlPFState -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
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 XY -> XY -> Bool
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 = ((XY, Int, SAutoLineLabel) -> Bool)
-> [(XY, Int, SAutoLineLabel)] -> Maybe (XY, Int, SAutoLineLabel)
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
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
(LMP_Endpoint Bool
isstart, Maybe (XY, Int, SAutoLineLabel)
_) -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler AutoLineEndPointHandler {
_autoLineEndPointHandler_isStart = isstart
, _autoLineEndPointHandler_undoFirst = False
, _autoLineEndPointHandler_isCreation = False
, _autoLineEndPointHandler_offsetAttach = _autoLineHandler_offsetAttach
, _autoLineEndPointHandler_attachStart = Nothing
, _autoLineEndPointHandler_attachEnd = Nothing
, _autoLineEndPointHandler_lastAttachedBox = Nothing
}
}
(LineManipulatorProxy
_, Just (XY
_,Int
index,SAutoLineLabel
_)) -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$
PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler AutoLineLabelMoverHandler {
_autoLineLabelMoverHandler_anchorOffset = 0
, _autoLineLabelMoverHandler_prevHandler = SomePotatoHandler slh
, _autoLineLabelMoverHandler_undoFirst = False
, _autoLineLabelMoverHandler_labelIndex = index
}
}
(LineManipulatorProxy
LMP_Nothing, Maybe (XY, Int, SAutoLineLabel)
_) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
mclickonline -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {
_autoLineHandler_mDownManipulator = mclickonline
}
}
(LineManipulatorProxy
LMP_Nothing, Maybe (XY, Int, SAutoLineLabel)
_) -> Maybe PotatoHandlerOutput
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 = AutoLineMidPointHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
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
Maybe Int
Nothing -> Maybe PotatoHandlerOutput
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 = AutoLineMidPointHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse AutoLineMidPointHandler
handler PotatoHandlerInput
phi RelMouseDrag
rmd
MouseDragState
MouseDragState_Up -> case Maybe Int
_autoLineHandler_mDownManipulator of
Maybe Int
Nothing -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def
Just Int
_ -> Maybe PotatoHandlerOutput
r where
(Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
larlist :: [LineAnchorsForRender]
larlist = OwlPFState -> SAutoLine -> [LineAnchorsForRender]
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 = SAutoLineLabel
forall a. Default a => a
def {
_sAutoLineLabel_index = mpindex
, _sAutoLineLabel_position = SAutoLineLabelPositionRelative reld
}
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler $ makeAutoLineLabelHandler_from_newLineLabel rid sal newllabel (SomePotatoHandler slh) phi rmd
}
MouseDragState
MouseDragState_Cancelled -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def
pHandleKeyboard :: AutoLineHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard AutoLineHandler
_ PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} KeyboardData
kbd = case KeyboardData
kbd of
KeyboardData
_ -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pRenderHandler :: AutoLineHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineHandler {Bool
Maybe Int
_autoLineHandler_isCreation :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_isCreation :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_offsetAttach :: Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = HandlerRenderOutput
r where
boxes :: [RenderHandle]
boxes = (Bool, Bool) -> Bool -> Int -> PotatoHandlerInput -> [RenderHandle]
maybeRenderPoints (Bool
False, Bool
False) Bool
_autoLineHandler_offsetAttach (-Int
1) PotatoHandlerInput
phi
attachmentBoxes :: [RenderHandle]
attachmentBoxes = PotatoHandlerInput
-> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]
renderAttachments PotatoHandlerInput
phi (Maybe Attachment
forall a. Maybe a
Nothing, Maybe Attachment
forall a. Maybe a
Nothing)
labels :: [RenderHandle]
labels = PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels PotatoHandlerInput
phi Bool
False
r :: HandlerRenderOutput
r = if Bool
_autoLineHandler_isCreation
then [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput [RenderHandle]
attachmentBoxes
else [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ([RenderHandle]
attachmentBoxes [RenderHandle] -> [RenderHandle] -> [RenderHandle]
forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
boxes [RenderHandle] -> [RenderHandle] -> [RenderHandle]
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_isCreation :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_isCreation :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_offsetAttach :: Bool
..} = if Bool
_autoLineHandler_isCreation
then Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Line
else Maybe Tool
forall a. Maybe a
Nothing
data AutoLineEndPointHandler = AutoLineEndPointHandler {
AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isStart :: Bool
, AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: Bool
, AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: Bool
, AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_offsetAttach :: Bool
, 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_isStart :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = 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
mnewattachend :: Maybe Attachment
mnewattachend = ((Attachment, XY) -> Attachment)
-> Maybe (Attachment, XY) -> Maybe Attachment
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attachment, XY) -> Attachment
forall a b. (a, b) -> a
fst (Maybe (Attachment, XY) -> Maybe Attachment)
-> ([(Attachment, XY)] -> Maybe (Attachment, XY))
-> [(Attachment, XY)]
-> Maybe Attachment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)
isOverAttachment XY
_mouseDrag_to ([(Attachment, XY)] -> Maybe Attachment)
-> [(Attachment, XY)] -> Maybe Attachment
forall a b. (a -> b) -> a -> b
$ [(Attachment, XY)]
attachments
mprojectattachend :: Maybe Attachment
mprojectattachend = case Maybe (Int, SAutoLine)
mridssline of
Maybe (Int, SAutoLine)
Nothing -> Maybe Attachment
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
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 -> Maybe (LBox, Attachment)
forall a. Maybe a
Nothing
Just (LBox, Attachment)
x -> (LBox, Attachment) -> Maybe (LBox, Attachment)
forall a. a -> Maybe a
Just (LBox, Attachment)
x
((Attachment, XY) -> Attachment)
-> Maybe (Attachment, XY) -> Maybe Attachment
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attachment, XY) -> Attachment
forall a b. (a, b) -> a
fst (Maybe (Attachment, XY) -> Maybe Attachment)
-> Maybe (Attachment, XY) -> Maybe Attachment
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 = [Maybe Attachment] -> Maybe Attachment
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 -> Text -> Maybe PotatoHandlerOutput
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should be handleed by AutoLineHandler"
MouseDragState
MouseDragState_Dragging -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
rid :: Int
rid = SuperOwl -> Int
_superOwl_id (SuperOwl -> Int) -> SuperOwl -> Int
forall a b. (a -> b) -> a -> b
$ HasCallStack => CanvasSelection -> SuperOwl
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 -> SAutoLine
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
nontrivialline :: Bool
nontrivialline = if Bool
_autoLineEndPointHandler_isStart
then XY -> Maybe XY
forall a. a -> Maybe a
Just XY
_mouseDrag_to Maybe XY -> Maybe XY -> Bool
forall a. Eq a => a -> a -> Bool
/= (HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
_autoLineEndPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState (Attachment -> Maybe XY) -> Maybe Attachment -> Maybe XY
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
sslineend)
else XY -> Maybe XY
forall a. a -> Maybe a
Just XY
_mouseDrag_to Maybe XY -> Maybe XY -> Bool
forall a. Eq a => a -> a -> Bool
/= (HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
_autoLineEndPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState (Attachment -> Maybe XY) -> Maybe Attachment -> Maybe XY
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 Maybe Attachment
forall a. Maybe a
Nothing
modifiedline :: SAutoLine
modifiedline = if Bool
_autoLineEndPointHandler_isStart
then SAutoLine
ssline {
_sAutoLine_start = _mouseDrag_to
, _sAutoLine_attachStart = mattachendnontrivial
}
else SAutoLine
ssline {
_sAutoLine_end = _mouseDrag_to
, _sAutoLine_attachEnd = mattachendnontrivial
}
newEltPos :: OwlSpot
newEltPos = OwlTree -> Selection -> OwlSpot
lastPositionInSelection (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
_potatoHandlerInput_pFState) Selection
_potatoHandlerInput_selection
lineToAdd :: SAutoLine
lineToAdd = SAutoLine
forall a. Default a => a
def {
_sAutoLine_start = _mouseDrag_from
, _sAutoLine_end = _mouseDrag_to
, _sAutoLine_superStyle = _potatoDefaultParameters_superStyle _potatoHandlerInput_potatoDefaultParameters
, _sAutoLine_lineStyle = _potatoDefaultParameters_lineStyle _potatoHandlerInput_potatoDefaultParameters
, _sAutoLine_lineStyleEnd =
_potatoDefaultParameters_lineStyleEnd _potatoHandlerInput_potatoDefaultParameters
, _sAutoLine_attachStart = _autoLineEndPointHandler_attachStart
, _sAutoLine_attachEnd = 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>") (OwlSubItem -> OwlItem) -> OwlSubItem -> OwlItem
forall a b. (a -> b) -> a -> b
$ SAutoLine -> OwlSubItem
OwlSubItemLine SAutoLine
lineToAdd)
else (Int, SElt) -> Llama
makeSetLlama ((Int, SElt) -> Llama) -> (Int, SElt) -> Llama
forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
modifiedline)
r :: PotatoHandlerOutput
r = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {
_autoLineEndPointHandler_undoFirst = True
, _autoLineEndPointHandler_attachStart = if _autoLineEndPointHandler_isStart then mattachendnontrivial else _autoLineEndPointHandler_attachStart
, _autoLineEndPointHandler_attachEnd = if not _autoLineEndPointHandler_isStart then mattachendnontrivial else _autoLineEndPointHandler_attachEnd
, _autoLineEndPointHandler_lastAttachedBox = case mattachendnontrivial of
Maybe Attachment
Nothing -> Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox
Just Attachment
x -> Attachment -> Maybe Attachment
forall a. a -> Maybe a
Just Attachment
x
}
, _potatoHandlerOutput_action = HOA_Preview $ Preview (previewOperation_fromUndoFirst _autoLineEndPointHandler_undoFirst) op
}
MouseDragState
MouseDragState_Up -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_action = if _autoLineEndPointHandler_undoFirst then HOA_Preview Preview_Commit else HOA_Nothing
}
MouseDragState
MouseDragState_Cancelled -> if Bool
_autoLineEndPointHandler_undoFirst then PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_action = HOA_Preview Preview_Cancel } else PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def
pHandleKeyboard :: AutoLineEndPointHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard AutoLineEndPointHandler
_ PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} KeyboardData
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pRenderHandler :: AutoLineEndPointHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineEndPointHandler {Bool
Maybe Attachment
_autoLineEndPointHandler_isStart :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = 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 [RenderHandle] -> [RenderHandle] -> [RenderHandle]
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_isStart :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_lastAttachedBox :: Maybe Attachment
..} = if Bool
_autoLineEndPointHandler_isCreation
then Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Line
else Maybe Tool
forall a. Maybe a
Nothing
adjustLineLabelPositionsAfterModifyingOrAddingMidpoint ::
(HasOwlTree a)
=> a
-> SAutoLine
-> SAutoLine
-> Maybe (Either Int Int)
-> SAutoLine
adjustLineLabelPositionsAfterModifyingOrAddingMidpoint :: forall a.
HasOwlTree a =>
a -> SAutoLine -> SAutoLine -> Maybe (Either Int Int) -> SAutoLine
adjustLineLabelPositionsAfterModifyingOrAddingMidpoint a
ot SAutoLine
old SAutoLine
new Maybe (Either Int Int)
mempindex = SAutoLine
forall {a}. a
r where
indexAdjust :: Int -> Int
indexAdjust Int
i = case Maybe (Either Int Int)
mempindex of
Maybe (Either Int Int)
Nothing -> Int
i
Just (Left Int
addmpi) -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
addmpi then Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 else Int
i
Just (Right Int
delmpi) -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
delmpi then Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 else Int
i
oldlars :: [LineAnchorsForRender]
oldlars = a -> SAutoLine -> [LineAnchorsForRender]
forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
old
newlars :: [LineAnchorsForRender]
newlars = a -> SAutoLine -> [LineAnchorsForRender]
forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
new
r :: a
r = a
forall a. HasCallStack => a
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 = Int
-> SAutoLineConstraint
-> [SAutoLineConstraint]
-> [SAutoLineConstraint]
forall a. Int -> a -> [a] -> [a]
L.insertAt Int
mpindex (XY -> SAutoLineConstraint
SAutoLineConstraintFixed XY
pos) (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
sline)
fmapfn :: SAutoLineLabel -> SAutoLineLabel
fmapfn SAutoLineLabel
ll = if SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
mpindex
then SAutoLineLabel
ll { _sAutoLineLabel_index = _sAutoLineLabel_index ll + 1}
else SAutoLineLabel
ll
newlabels :: [SAutoLineLabel]
newlabels = (SAutoLineLabel -> SAutoLineLabel)
-> [SAutoLineLabel] -> [SAutoLineLabel]
forall a b. (a -> b) -> [a] -> [b]
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 = newmidpoints
, _sAutoLine_labels = 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 = Int
-> (SAutoLineConstraint -> SAutoLineConstraint)
-> [SAutoLineConstraint]
-> [SAutoLineConstraint]
forall a. Int -> (a -> a) -> [a] -> [a]
L.modifyAt Int
mpindex (SAutoLineConstraint -> SAutoLineConstraint -> SAutoLineConstraint
forall a b. a -> b -> a
const (SAutoLineConstraint -> SAutoLineConstraint -> SAutoLineConstraint)
-> SAutoLineConstraint
-> SAutoLineConstraint
-> SAutoLineConstraint
forall a b. (a -> b) -> a -> b
$ XY -> SAutoLineConstraint
SAutoLineConstraintFixed XY
pos) (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
sline)
newlabels :: [SAutoLineLabel]
newlabels = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline
r :: SAutoLine
r = SAutoLine
sline {
_sAutoLine_midpoints = newmidpoints
, _sAutoLine_labels = newlabels
}
sAutoLine_deleteMidpoint :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteMidpoint :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteMidpoint Int
mpindex SAutoLine
sline = SAutoLine
r where
newmidpoints :: [SAutoLineConstraint]
newmidpoints = Int -> [SAutoLineConstraint] -> [SAutoLineConstraint]
forall a. Int -> [a] -> [a]
L.deleteAt Int
mpindex (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
sline)
fmapfn :: SAutoLineLabel -> SAutoLineLabel
fmapfn SAutoLineLabel
ll = if SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
mpindex
then SAutoLineLabel
ll { _sAutoLineLabel_index = _sAutoLineLabel_index ll - 1}
else SAutoLineLabel
ll
newlabels :: [SAutoLineLabel]
newlabels = (SAutoLineLabel -> SAutoLineLabel)
-> [SAutoLineLabel] -> [SAutoLineLabel]
forall a b. (a -> b) -> [a] -> [b]
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 = newmidpoints
, _sAutoLine_labels = newlabels
}
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_midPointIndex :: AutoLineMidPointHandler -> Int
_autoLineMidPointHandler_isMidpointCreation :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_undoFirst :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_offsetAttach :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_offsetAttach :: Bool
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down -> Bool -> Maybe PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not Bool
_autoLineMidPointHandler_isMidpointCreation) (Maybe PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> Maybe PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ AutoLineMidPointHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineMidPointHandler
slh
MouseDragState
MouseDragState_Dragging -> Maybe PotatoHandlerOutput
r where
(Int
rid, SAutoLine
sline) = Maybe (Int, SAutoLine) -> (Int, SAutoLine)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Int, SAutoLine) -> (Int, SAutoLine))
-> Maybe (Int, SAutoLine) -> (Int, SAutoLine)
forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
firstlm :: LineManipulatorProxy
firstlm = SAutoLine
-> Bool -> OwlPFState -> RelMouseDrag -> LineManipulatorProxy
findFirstLineManipulator_NEW SAutoLine
sline Bool
_autoLineMidPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState RelMouseDrag
rmd
mpindex :: Int
mpindex = Int
_autoLineMidPointHandler_midPointIndex
ladjacentpos :: XY
ladjacentpos = HasCallStack => Bool -> OwlPFState -> SAutoLine -> Int -> XY
Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition Bool
_autoLineMidPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState SAutoLine
sline Int
mpindex
radjacentpos :: XY
radjacentpos = HasCallStack => Bool -> OwlPFState -> SAutoLine -> Int -> XY
Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition Bool
_autoLineMidPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState SAutoLine
sline (Int
mpindexInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
isoveradjacent :: Bool
isoveradjacent = XY
_mouseDrag_to XY -> XY -> Bool
forall a. Eq a => a -> a -> Bool
== XY
ladjacentpos Bool -> Bool -> Bool
|| XY
_mouseDrag_to XY -> XY -> Bool
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
LineManipulatorProxy
_ | Bool
_autoLineMidPointHandler_isMidpointCreation -> (Bool
False,) (Llama -> (Bool, Llama)) -> Llama -> (Bool, Llama)
forall a b. (a -> b) -> a -> b
$ (Int, SElt) -> Llama
makeSetLlama ((Int, SElt) -> Llama) -> (Int, SElt) -> Llama
forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline)
LineManipulatorProxy
_ | Bool
isoveradjacent -> (Bool
True,) (Llama -> (Bool, Llama)) -> Llama -> (Bool, Llama)
forall a b. (a -> b) -> a -> b
$ (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newslinedelete)
LineManipulatorProxy
_ -> (Bool
False,) (Llama -> (Bool, Llama)) -> Llama -> (Bool, Llama)
forall a b. (a -> b) -> a -> b
$ (Int, SElt) -> Llama
makeSetLlama ((Int, SElt) -> Llama) -> (Int, SElt) -> Llama
forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline)
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {
_autoLineMidPointHandler_isMidpointCreation = diddelete && not _autoLineMidPointHandler_isMidpointCreation
, _autoLineMidPointHandler_undoFirst = True
}
, _potatoHandlerOutput_action = HOA_Preview $ Preview (previewOperation_fromUndoFirst _autoLineMidPointHandler_undoFirst) event
}
MouseDragState
MouseDragState_Up -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_action = if _autoLineMidPointHandler_undoFirst then HOA_Preview Preview_Commit else HOA_Nothing
}
MouseDragState
MouseDragState_Cancelled -> if Bool
_autoLineMidPointHandler_undoFirst then PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_action = HOA_Preview Preview_Cancel } else PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def
pRenderHandler :: AutoLineMidPointHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineMidPointHandler {Bool
Int
_autoLineMidPointHandler_midPointIndex :: AutoLineMidPointHandler -> Int
_autoLineMidPointHandler_isMidpointCreation :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_undoFirst :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_offsetAttach :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_offsetAttach :: Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = 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
r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput [RenderHandle]
boxes
pIsHandlerActive :: AutoLineMidPointHandler -> HandlerActiveState
pIsHandlerActive AutoLineMidPointHandler
_ = HandlerActiveState
HAS_Active_Mouse
data AutoLineLabelMoverHandler = AutoLineLabelMoverHandler {
AutoLineLabelMoverHandler -> XY
_autoLineLabelMoverHandler_anchorOffset :: XY
, AutoLineLabelMoverHandler -> SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
, AutoLineLabelMoverHandler -> Bool
_autoLineLabelMoverHandler_undoFirst :: Bool
, AutoLineLabelMoverHandler -> Int
_autoLineLabelMoverHandler_labelIndex :: Int
}
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_anchorOffset :: AutoLineLabelMoverHandler -> XY
_autoLineLabelMoverHandler_prevHandler :: AutoLineLabelMoverHandler -> SomePotatoHandler
_autoLineLabelMoverHandler_undoFirst :: AutoLineLabelMoverHandler -> Bool
_autoLineLabelMoverHandler_labelIndex :: AutoLineLabelMoverHandler -> Int
_autoLineLabelMoverHandler_anchorOffset :: XY
_autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
_autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_labelIndex :: Int
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = let
(Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
llabel :: SAutoLineLabel
llabel = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal [SAutoLineLabel] -> Int -> SAutoLineLabel
forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
_autoLineLabelMoverHandler_labelIndex
larlist :: [LineAnchorsForRender]
larlist = OwlPFState -> SAutoLine -> [LineAnchorsForRender]
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 = index
, _sAutoLineLabel_position = SAutoLineLabelPositionRelative reld
}
in case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ AutoLineLabelMoverHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineLabelMoverHandler
slh
MouseDragState
MouseDragState_Dragging -> Maybe PotatoHandlerOutput
r where
newsal :: SAutoLine
newsal = SAutoLine
sal {
_sAutoLine_labels = L.setAt _autoLineLabelMoverHandler_labelIndex newl (_sAutoLine_labels sal)
}
op :: Llama
op = (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsal)
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {
_autoLineLabelMoverHandler_undoFirst = True
}
, _potatoHandlerOutput_action = HOA_Preview $ Preview (previewOperation_fromUndoFirst _autoLineLabelMoverHandler_undoFirst) op
}
MouseDragState
MouseDragState_Up -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = if not _autoLineLabelMoverHandler_undoFirst
then Just $ SomePotatoHandler $
makeAutoLineLabelHandler_from_labelIndex _autoLineLabelMoverHandler_labelIndex _autoLineLabelMoverHandler_prevHandler phi rmd
else Just (_autoLineLabelMoverHandler_prevHandler)
, _potatoHandlerOutput_action = if _autoLineLabelMoverHandler_undoFirst then HOA_Preview Preview_Commit else HOA_Nothing
}
MouseDragState
MouseDragState_Cancelled -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just (_autoLineLabelMoverHandler_prevHandler)
, _potatoHandlerOutput_action = if _autoLineLabelMoverHandler_undoFirst then HOA_Preview Preview_Cancel else HOA_Nothing
}
pRenderHandler :: AutoLineLabelMoverHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineLabelMoverHandler {Bool
Int
XY
SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: AutoLineLabelMoverHandler -> XY
_autoLineLabelMoverHandler_prevHandler :: AutoLineLabelMoverHandler -> SomePotatoHandler
_autoLineLabelMoverHandler_undoFirst :: AutoLineLabelMoverHandler -> Bool
_autoLineLabelMoverHandler_labelIndex :: AutoLineLabelMoverHandler -> Int
_autoLineLabelMoverHandler_anchorOffset :: XY
_autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
_autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_labelIndex :: Int
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = 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 = Int -> [SAutoLineLabel] -> [SAutoLineLabel]
forall a. Int -> [a] -> [a]
L.deleteAt Int
labelindex (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline)
r :: SAutoLine
r = SAutoLine
sline {
_sAutoLine_labels = newlabels
}
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
, 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 (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int
y) (Int -> Int -> XY
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_active :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_state :: AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_prevHandler :: AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_undoFirst :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_labelIndex :: AutoLineLabelHandler -> Int
_autoLineLabelHandler_lineLabel :: AutoLineLabelHandler -> SAutoLineLabel
_autoLineLabelHandler_creation :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_creation :: Bool
..} = AutoLineLabelHandler
r where
(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
else SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal [SAutoLineLabel] -> Int -> SAutoLineLabel
forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
_autoLineLabelHandler_labelIndex
newtext :: Text
newtext = SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
pos :: XY
pos = a -> SAutoLine -> SAutoLineLabel -> XY
forall a.
(HasCallStack, HasOwlTree a) =>
a -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPosition a
ot SAutoLine
sal SAutoLineLabel
llabel
width :: Int
width = Int
forall a. Bounded a => a
maxBound :: Int
box :: LBox
box = XY -> SAutoLineLabel -> LBox
getSAutoLineLabelBox XY
pos SAutoLineLabel
llabel
r :: AutoLineLabelHandler
r = AutoLineLabelHandler
slh {
_autoLineLabelHandler_state = _autoLineLabelHandler_state {
_textInputState_original = if reset then Just newtext else _textInputState_original _autoLineLabelHandler_state
, _textInputState_displayLines = TZ.displayLinesWithAlignment TZ.TextAlignment_Left width () () (_textInputState_zipper _autoLineLabelHandler_state)
, _textInputState_box = box
}
, _autoLineLabelHandler_undoFirst = if reset
then False
else _autoLineLabelHandler_undoFirst
, _autoLineLabelHandler_lineLabel = llabel
}
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_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} RelMouseDrag
rmd = TextInputState
r where
ogtext :: Text
ogtext = SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
pos :: XY
pos = OwlPFState -> SAutoLine -> SAutoLineLabel -> XY
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 = Int
forall a. Bounded a => a
maxBound :: Int
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 = Text -> Maybe Text
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 = TextAlignment -> Int -> () -> () -> TextZipper -> 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_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} RelMouseDrag
rmd = TextInputState
r where
llabel :: SAutoLineLabel
llabel = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal [SAutoLineLabel] -> Int -> SAutoLineLabel
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_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} 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 [SAutoLineLabel] -> Int -> SAutoLineLabel
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 (TextInputState -> TextInputState)
-> TextInputState -> TextInputState
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
}
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_active :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_state :: AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_prevHandler :: AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_undoFirst :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_labelIndex :: AutoLineLabelHandler -> Int
_autoLineLabelHandler_lineLabel :: AutoLineLabelHandler -> SAutoLineLabel
_autoLineLabelHandler_creation :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_creation :: Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) 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 PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {
_autoLineLabelHandler_active = isdown
, _autoLineLabelHandler_state = newState
}
}
else SomePotatoHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
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_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = let
slh :: AutoLineLabelHandler
slh = OwlPFState
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
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
MouseDragState
MouseDragState_Down -> AutoLineLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler AutoLineLabelHandler
slh PotatoHandlerInput
phi RelMouseDrag
rmd Bool
True
MouseDragState
MouseDragState_Dragging -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ AutoLineLabelHandler -> PotatoHandlerOutput
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 PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {
_autoLineLabelHandler_active = False
}
}
MouseDragState
MouseDragState_Cancelled -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ AutoLineLabelHandler -> PotatoHandlerOutput
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_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} (KeyboardData KeyboardKey
k [KeyModifier]
_) = let
slh :: AutoLineLabelHandler
slh = OwlPFState
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
forall a.
HasOwlTree a =>
a
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
updateAutoLineLabelHandlerState OwlPFState
_potatoHandlerInput_pFState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection AutoLineLabelHandler
slh'
(Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
in case KeyboardKey
k of
KeyboardKey
_ | KeyboardKey
k KeyboardKey -> KeyboardKey -> Bool
forall a. Eq a => a -> a -> Bool
== KeyboardKey
KeyboardKey_Esc Bool -> Bool -> Bool
|| KeyboardKey
k KeyboardKey -> KeyboardKey -> Bool
forall a. Eq a => a -> a -> Bool
== KeyboardKey
KeyboardKey_Return -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_nextHandler = Just (_autoLineLabelHandler_prevHandler slh) }
KeyboardKey
_ -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
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))
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 = newtext
}
newsal_creation :: SAutoLine
newsal_creation = SAutoLine
sal {
_sAutoLine_labels = newlabel : _sAutoLine_labels sal
}
newsal_update :: SAutoLine
newsal_update = SAutoLine
sal {
_sAutoLine_labels = L.setAt (_autoLineLabelHandler_labelIndex slh) newlabel (_sAutoLine_labels sal)
}
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
then Preview -> HandlerOutputAction
HOA_Preview Preview
Preview_Cancel
else Preview -> HandlerOutputAction
HOA_Preview (Preview -> HandlerOutputAction) -> Preview -> HandlerOutputAction
forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview (Bool -> PreviewOperation
previewOperation_fromUndoFirst (AutoLineLabelHandler -> Bool
_autoLineLabelHandler_undoFirst AutoLineLabelHandler
slh)) (Llama -> Preview) -> Llama -> Preview
forall a b. (a -> b) -> a -> b
$ (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsal)
r :: PotatoHandlerOutput
r = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler slh {
_autoLineLabelHandler_state = newtais
, _autoLineLabelHandler_undoFirst = case action of
HandlerOutputAction
HOA_Nothing -> AutoLineLabelHandler -> Bool
_autoLineLabelHandler_undoFirst AutoLineLabelHandler
slh
HOA_Preview Preview
Preview_Cancel -> Bool
False
HandlerOutputAction
_ -> Bool
True
}
, _potatoHandlerOutput_action = action
}
pRefreshHandler :: AutoLineLabelHandler
-> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler AutoLineLabelHandler
slh PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = if Seq SuperOwl -> Bool
forall a. Seq a -> Bool
Seq.null (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
then Maybe SomePotatoHandler
forall a. Maybe a
Nothing
else if Int
rid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (TextInputState -> Int
_textInputState_rid (TextInputState -> Int) -> TextInputState -> Int
forall a b. (a -> b) -> a -> b
$ AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_state AutoLineLabelHandler
slh)
then Maybe SomePotatoHandler
forall a. Maybe a
Nothing
else case SElt
selt of
SEltLine SAutoLine
_ -> Maybe SomePotatoHandler
forall a. Maybe a
Nothing
SElt
_ -> Maybe SomePotatoHandler
forall a. Maybe a
Nothing
where
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
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_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = HandlerRenderOutput
r where
slh :: AutoLineLabelHandler
slh = OwlPFState
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
forall a.
HasOwlTree a =>
a
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
updateAutoLineLabelHandlerState OwlPFState
_potatoHandlerInput_pFState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection AutoLineLabelHandler
slh'
btis :: TextInputState
btis = AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_state AutoLineLabelHandler
slh
r :: HandlerRenderOutput
r = TextInputState -> HandlerRenderOutput
makeTextHandlerRenderOutput TextInputState
btis
pIsHandlerActive :: AutoLineLabelHandler -> HandlerActiveState
pIsHandlerActive AutoLineLabelHandler
slh = if AutoLineLabelHandler -> Bool
_autoLineLabelHandler_active AutoLineLabelHandler
slh then HandlerActiveState
HAS_Active_Mouse else HandlerActiveState
HAS_Active_Keyboard