{-# 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.SElts
import Control.Monad (msum)
import Control.Exception
import Data.Default
import qualified Data.List as L
import qualified Data.List.Index as L
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import Data.Maybe (fromJust)
maybeGetSLine :: CanvasSelection -> Maybe (REltId, SAutoLine)
maybeGetSLine :: CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
selection = if forall a. Seq a -> Int
Seq.length (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
selection) forall a. Eq a => a -> a -> Bool
/= Int
1
then forall a. Maybe a
Nothing
else case SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl of
SEltLine SAutoLine
sline -> forall a. a -> Maybe a
Just (Int
rid, SAutoLine
sline)
SElt
_ -> forall a. Maybe a
Nothing
where
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
selection
rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
mustGetSLine :: CanvasSelection -> (REltId, SAutoLine)
mustGetSLine :: CanvasSelection -> (Int, SAutoLine)
mustGetSLine = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall o. (HasOwlTree o, HasCallStack) => o -> Int -> SuperOwl
hasOwlTree_mustFindSuperOwl OwlPFState
pfs) [Int]
culled
fmapfn :: SuperOwl -> [(Attachment, XY)]
fmapfn SuperOwl
sowl = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(AttachmentLocation
a,XY
p) -> (Int -> AttachmentLocation -> Attachment
attachment_create_default (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) AttachmentLocation
a, XY
p)) forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> OwlItem -> [(AttachmentLocation, XY)]
owlItem_availableAttachmentsAtDefaultLocation Bool
includeNoBorder Bool
offsetBorder (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl)
r :: [(Attachment, XY)]
r = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> [(Attachment, XY)]
fmapfn [SuperOwl]
sowls
renderAttachments :: PotatoHandlerInput -> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]
renderAttachments :: PotatoHandlerInput
-> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]
renderAttachments PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
..} (Maybe Attachment
mstart, Maybe Attachment
mend) = [RenderHandle]
r where
attachments :: [(Attachment, XY)]
attachments = Bool
-> Bool
-> OwlPFState
-> BroadPhaseState
-> LBox
-> [(Attachment, XY)]
getAvailableAttachments Bool
False Bool
True OwlPFState
_potatoHandlerInput_pFState BroadPhaseState
_potatoHandlerInput_broadPhase LBox
_potatoHandlerInput_screenRegion
fmapattachmentfn :: (Attachment, XY) -> Maybe RenderHandle
fmapattachmentfn (Attachment
a,XY
p) = if Maybe Attachment -> Bool
matches Maybe Attachment
mstart Bool -> Bool -> Bool
|| Maybe Attachment -> Bool
matches Maybe Attachment
mend then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ RenderHandle {
_renderHandle_box :: LBox
_renderHandle_box = (XY -> XY -> LBox
LBox XY
p XY
1)
, _renderHandle_char :: Maybe PChar
_renderHandle_char = forall a. a -> Maybe a
Just (Attachment -> PChar
attachmentRenderChar Attachment
a)
, _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Attachment
} where
rid :: Int
rid = Attachment -> Int
_attachment_target Attachment
a
al :: AttachmentLocation
al = Attachment -> AttachmentLocation
_attachment_location Attachment
a
matches :: Maybe Attachment -> Bool
matches Maybe Attachment
ma = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Attachment
a' -> Attachment -> Int
_attachment_target Attachment
a' forall a. Eq a => a -> a -> Bool
== Int
rid Bool -> Bool -> Bool
&& Attachment -> AttachmentLocation
_attachment_location Attachment
a' forall a. Eq a => a -> a -> Bool
== AttachmentLocation
al) Maybe Attachment
ma forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
r :: [RenderHandle]
r = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attachment, XY) -> Maybe RenderHandle
fmapattachmentfn [(Attachment, XY)]
attachments
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
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = [RenderHandle]
r where
mselt :: Maybe SElt
mselt = HasCallStack => CanvasSelection -> Maybe SuperOwl
selectionToMaybeFirstSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SElt
superOwl_toSElt_hack
r1 :: [RenderHandle]
r1 = case Maybe SElt
mselt of
Just (SEltLine SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
..}) -> [LBox -> Bool -> RenderHandle
makeRenderHandle (XY -> LBox
make_1area_lBox_from_XY XY
startHandle) Bool
True, LBox -> Bool -> RenderHandle
makeRenderHandle (XY -> LBox
make_1area_lBox_from_XY XY
endHandle) Bool
False]
where
startHandle :: XY
startHandle = forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start (HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetAttach OwlPFState
_potatoHandlerInput_pFState Maybe Attachment
_sAutoLine_attachStart)
endHandle :: XY
endHandle = forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end (HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetAttach OwlPFState
_potatoHandlerInput_pFState Maybe Attachment
_sAutoLine_attachEnd)
makeRenderHandle :: LBox -> Bool -> RenderHandle
makeRenderHandle LBox
b Bool
isstart = RenderHandle {
_renderHandle_box :: LBox
_renderHandle_box = LBox
b
, _renderHandle_char :: Maybe PChar
_renderHandle_char = if Bool
isstart then forall a. a -> Maybe a
Just PChar
'S' else forall a. a -> Maybe a
Just PChar
'E'
, _renderHandle_color :: RenderHandleColor
_renderHandle_color = if (Bool
isstart Bool -> Bool -> Bool
&& Bool
highlightstart) Bool -> Bool -> Bool
|| (Bool -> Bool
not Bool
isstart Bool -> Bool -> Bool
&& Bool
highlightend) then RenderHandleColor
RHC_AttachmentHighlight else RenderHandleColor
RHC_Default
}
Maybe SElt
_ -> []
r2 :: [RenderHandle]
r2 = case Maybe SElt
mselt of
Just (SEltLine SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..}) -> forall a b. (Int -> a -> b) -> [a] -> [b]
L.imap Int -> SAutoLineConstraint -> RenderHandle
imapfn [SAutoLineConstraint]
_sAutoLine_midpoints
where
imapfn :: Int -> SAutoLineConstraint -> RenderHandle
imapfn Int
i SAutoLineConstraint
mp = case SAutoLineConstraint
mp of
SAutoLineConstraintFixed XY
pos -> RenderHandle {
_renderHandle_box :: LBox
_renderHandle_box = XY -> LBox
make_1area_lBox_from_XY XY
pos
, _renderHandle_char :: Maybe PChar
_renderHandle_char = forall a. a -> Maybe a
Just PChar
'X'
, _renderHandle_color :: RenderHandleColor
_renderHandle_color = if Int
midpointhighlightindex forall a. Eq a => a -> a -> Bool
== Int
i then RenderHandleColor
RHC_AttachmentHighlight else RenderHandleColor
RHC_Default
}
Maybe SElt
_ -> []
r :: [RenderHandle]
r = [RenderHandle]
r1 forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
r2
renderLabels :: PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels :: PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} Bool
offsetByLabelHeight = [RenderHandle]
r where
(Int
_, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
labels :: [(XY, Int, SAutoLineLabel)]
labels = forall a.
HasOwlTree a =>
a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions OwlPFState
_potatoHandlerInput_pFState SAutoLine
sal
fmapfn :: (XY, Int, SAutoLineLabel) -> RenderHandle
fmapfn (XY
pos,Int
_,SAutoLineLabel
_) = RenderHandle {
_renderHandle_box :: LBox
_renderHandle_box = if Bool
offsetByLabelHeight
then XY -> LBox
make_1area_lBox_from_XY (XY
pos forall a. Num a => a -> a -> a
- (forall a. a -> a -> V2 a
V2 Int
0 Int
1))
else XY -> LBox
make_1area_lBox_from_XY XY
pos
, _renderHandle_char :: Maybe PChar
_renderHandle_char = forall a. a -> Maybe a
Just PChar
'T'
, _renderHandle_color :: RenderHandleColor
_renderHandle_color = RenderHandleColor
RHC_Default
}
r :: [RenderHandle]
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XY, Int, SAutoLineLabel) -> RenderHandle
fmapfn [(XY, Int, SAutoLineLabel)]
labels
data AutoLineHandler = AutoLineHandler {
AutoLineHandler -> Bool
_autoLineHandler_isCreation :: Bool
, AutoLineHandler -> Maybe Int
_autoLineHandler_mDownManipulator :: Maybe Int
, AutoLineHandler -> Bool
_autoLineHandler_offsetAttach :: Bool
} deriving (Int -> AutoLineHandler -> ShowS
[AutoLineHandler] -> ShowS
AutoLineHandler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutoLineHandler] -> ShowS
$cshowList :: [AutoLineHandler] -> ShowS
show :: AutoLineHandler -> String
$cshow :: AutoLineHandler -> String
showsPrec :: Int -> AutoLineHandler -> ShowS
$cshowsPrec :: Int -> AutoLineHandler -> ShowS
Show)
instance Default AutoLineHandler where
def :: AutoLineHandler
def = AutoLineHandler {
_autoLineHandler_isCreation :: Bool
_autoLineHandler_isCreation = Bool
False
, _autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_mDownManipulator = forall a. Maybe a
Nothing
, _autoLineHandler_offsetAttach :: Bool
_autoLineHandler_offsetAttach = Bool
True
}
data LineManipulatorProxy = LMP_Endpoint Bool | LMP_Midpoint Int | LMP_Nothing
sAutoLineConstraint_handlerPosition :: SAutoLineConstraint -> XY
sAutoLineConstraint_handlerPosition :: SAutoLineConstraint -> XY
sAutoLineConstraint_handlerPosition SAutoLineConstraint
slc = case SAutoLineConstraint
slc of
SAutoLineConstraintFixed XY
xy -> XY
xy
findFirstLineManipulator_NEW :: SAutoLine -> Bool -> OwlPFState -> RelMouseDrag-> LineManipulatorProxy
findFirstLineManipulator_NEW :: SAutoLine
-> Bool -> OwlPFState -> RelMouseDrag -> LineManipulatorProxy
findFirstLineManipulator_NEW SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} Bool
offsetBorder OwlPFState
pfs (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
..})= LineManipulatorProxy
r where
start :: XY
start = forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetBorder OwlPFState
pfs Maybe Attachment
_sAutoLine_attachStart
end :: XY
end = forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetBorder OwlPFState
pfs Maybe Attachment
_sAutoLine_attachEnd
mmid :: Maybe Int
mmid = forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex (\SAutoLineConstraint
slc -> SAutoLineConstraint -> XY
sAutoLineConstraint_handlerPosition SAutoLineConstraint
slc forall a. Eq a => a -> a -> Bool
== XY
_mouseDrag_to) [SAutoLineConstraint]
_sAutoLine_midpoints
r :: LineManipulatorProxy
r = if XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
== XY
start then Bool -> LineManipulatorProxy
LMP_Endpoint Bool
True
else if XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
== XY
end then Bool -> LineManipulatorProxy
LMP_Endpoint Bool
False
else forall b a. b -> (a -> b) -> Maybe a -> b
maybe LineManipulatorProxy
LMP_Nothing Int -> LineManipulatorProxy
LMP_Midpoint Maybe Int
mmid
whichSubSegmentDidClick :: OwlTree -> SAutoLine -> XY -> Maybe Int
whichSubSegmentDidClick :: OwlTree -> SAutoLine -> XY -> Maybe Int
whichSubSegmentDidClick OwlTree
ot sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} XY
pos = Maybe Int
r where
lars :: [LineAnchorsForRender]
lars = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList OwlTree
ot SAutoLine
sline
r :: Maybe Int
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (Int -> a -> Bool) -> [a] -> Maybe (Int, a)
L.ifind (\Int
_ LineAnchorsForRender
lar -> forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ LineAnchorsForRender -> XY -> Maybe Int
lineAnchorsForRender_findIntersectingSubsegment LineAnchorsForRender
lar XY
pos) [LineAnchorsForRender]
lars
getEndpointPosition :: Bool -> OwlPFState -> SAutoLine -> Bool -> XY
getEndpointPosition :: Bool -> OwlPFState -> SAutoLine -> Bool -> XY
getEndpointPosition Bool
offsetAttach OwlPFState
pfs SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} Bool
isstart = if Bool
isstart
then forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_start forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetAttach OwlPFState
pfs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
_sAutoLine_attachStart
else forall a. a -> Maybe a -> a
fromMaybe XY
_sAutoLine_end forall a b. (a -> b) -> a -> b
$ HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetAttach OwlPFState
pfs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
_sAutoLine_attachEnd
getAnchorPosition :: Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition :: Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition Bool
offsetAttach OwlPFState
pfs sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_end :: XY
_sAutoLine_start :: XY
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_start :: SAutoLine -> XY
..} Int
anchorindex = XY
r where
mps :: [SAutoLineConstraint]
mps = [SAutoLineConstraint]
_sAutoLine_midpoints
endindex :: Int
endindex = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SAutoLineConstraint]
mps forall a. Num a => a -> a -> a
+ Int
1
r :: XY
r = if Int
anchorindex forall a. Eq a => a -> a -> Bool
== Int
0
then Bool -> OwlPFState -> SAutoLine -> Bool -> XY
getEndpointPosition Bool
offsetAttach OwlPFState
pfs SAutoLine
sline Bool
True
else if Int
anchorindex forall a. Eq a => a -> a -> Bool
== Int
endindex
then Bool -> OwlPFState -> SAutoLine -> Bool -> XY
getEndpointPosition Bool
offsetAttach OwlPFState
pfs SAutoLine
sline Bool
False
else if Int
anchorindex forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
anchorindex forall a. Ord a => a -> a -> Bool
< Int
endindex
then case [SAutoLineConstraint]
mps forall a. [a] -> Int -> a
L.!! (Int
anchorindexforall a. Num a => a -> a -> a
-Int
1) of
SAutoLineConstraintFixed XY
xy -> XY
xy
else forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"out of bounds anchor index " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
anchorindex
instance PotatoHandler AutoLineHandler where
pHandlerName :: AutoLineHandler -> Text
pHandlerName AutoLineHandler
_ = Text
handlerName_simpleLine
pHandleMouse :: AutoLineHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse slh :: AutoLineHandler
slh@AutoLineHandler {Bool
Maybe Int
_autoLineHandler_offsetAttach :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_isCreation :: Bool
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_isCreation :: AutoLineHandler -> Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let
attachments :: [(Attachment, XY)]
attachments = Bool
-> Bool
-> OwlPFState
-> BroadPhaseState
-> LBox
-> [(Attachment, XY)]
getAvailableAttachments Bool
False Bool
True OwlPFState
_potatoHandlerInput_pFState BroadPhaseState
_potatoHandlerInput_broadPhase LBox
_potatoHandlerInput_screenRegion
mattachend :: Maybe Attachment
mattachend = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)
isOverAttachment XY
_mouseDrag_to forall a b. (a -> b) -> a -> b
$ [(Attachment, XY)]
attachments
in case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down | Bool
_autoLineHandler_isCreation -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineEndPointHandler {
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_isStart = Bool
False
, _autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_undoFirst = Bool
False
, _autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_isCreation = Bool
True
, _autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_offsetAttach = Bool
_autoLineHandler_offsetAttach
, _autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachStart = Maybe Attachment
mattachend
, _autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachEnd = forall a. Maybe a
Nothing
}
}
MouseDragState
MouseDragState_Down | forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers -> forall a. Maybe a
Nothing
MouseDragState
MouseDragState_Down -> Maybe PotatoHandlerOutput
r where
(Int
_, SAutoLine
sline) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
labels :: [(XY, Int, SAutoLineLabel)]
labels = forall a.
HasOwlTree a =>
a -> SAutoLine -> [(XY, Int, SAutoLineLabel)]
getSortedSAutoLineLabelPositions OwlPFState
_potatoHandlerInput_pFState SAutoLine
sline
findlabelfn :: (XY, Int, SAutoLineLabel) -> Bool
findlabelfn (XY
pos, Int
_, SAutoLineLabel
llabel) = XY
pos forall a. Eq a => a -> a -> Bool
== XY
_mouseDrag_to Bool -> Bool -> Bool
|| LBox -> XY -> Bool
does_lBox_contains_XY (XY -> SAutoLineLabel -> LBox
getSAutoLineLabelBox XY
pos SAutoLineLabel
llabel) XY
_mouseDrag_to
mfirstlabel :: Maybe (XY, Int, SAutoLineLabel)
mfirstlabel = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (XY, Int, SAutoLineLabel) -> Bool
findlabelfn [(XY, Int, SAutoLineLabel)]
labels
firstlm :: LineManipulatorProxy
firstlm = SAutoLine
-> Bool -> OwlPFState -> RelMouseDrag -> LineManipulatorProxy
findFirstLineManipulator_NEW SAutoLine
sline Bool
_autoLineHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState RelMouseDrag
rmd
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)
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineEndPointHandler {
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_isStart = Bool
isstart
, _autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_undoFirst = Bool
False
, _autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_isCreation = Bool
False
, _autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_offsetAttach = Bool
_autoLineHandler_offsetAttach
, _autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachStart = forall a. Maybe a
Nothing
, _autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachEnd = forall a. Maybe a
Nothing
}
}
(LineManipulatorProxy
_, Just (XY
_,Int
index,SAutoLineLabel
_)) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelMoverHandler {
_autoLineLabelMoverHandler_anchorOffset :: XY
_autoLineLabelMoverHandler_anchorOffset = XY
0
, _autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler = forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineHandler
slh
, _autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_undoFirst = Bool
False
, _autoLineLabelMoverHandler_labelIndex :: Int
_autoLineLabelMoverHandler_labelIndex = Int
index
}
}
(LineManipulatorProxy
LMP_Nothing, Maybe (XY, Int, SAutoLineLabel)
_) | forall a. Maybe a -> Bool
isJust Maybe Int
mclickonline -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineHandler
slh {
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_mDownManipulator = Maybe Int
mclickonline
}
}
(LineManipulatorProxy
LMP_Nothing, Maybe (XY, Int, SAutoLineLabel)
_) -> forall a. Maybe a
Nothing
(LMP_Midpoint Int
i, Maybe (XY, Int, SAutoLineLabel)
_) -> Maybe PotatoHandlerOutput
rslt where
handler :: AutoLineMidPointHandler
handler = AutoLineMidPointHandler {
_autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_midPointIndex = Int
i
, _autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_isMidpointCreation = Bool
False
, _autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_undoFirst = Bool
False
, _autoLineMidPointHandler_offsetAttach :: Bool
_autoLineMidPointHandler_offsetAttach = Bool
_autoLineHandler_offsetAttach
}
rslt :: Maybe PotatoHandlerOutput
rslt = forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse AutoLineMidPointHandler
handler PotatoHandlerInput
phi RelMouseDrag
rmd
MouseDragState
MouseDragState_Dragging -> case Maybe Int
_autoLineHandler_mDownManipulator of
Maybe Int
Nothing -> forall a. Maybe a
Nothing
Just Int
i -> Maybe PotatoHandlerOutput
r where
handler :: AutoLineMidPointHandler
handler = AutoLineMidPointHandler {
_autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_midPointIndex = Int
i
, _autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_isMidpointCreation = Bool
True
, _autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_undoFirst = Bool
False
, _autoLineMidPointHandler_offsetAttach :: Bool
_autoLineMidPointHandler_offsetAttach = Bool
_autoLineHandler_offsetAttach
}
r :: Maybe PotatoHandlerOutput
r = forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse AutoLineMidPointHandler
handler PotatoHandlerInput
phi RelMouseDrag
rmd
MouseDragState
MouseDragState_Up -> case Maybe Int
_autoLineHandler_mDownManipulator of
Maybe Int
Nothing -> forall a. a -> Maybe a
Just forall a. Default a => a
def
Just Int
_ -> Maybe PotatoHandlerOutput
r where
(Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
larlist :: [LineAnchorsForRender]
larlist = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList OwlPFState
_potatoHandlerInput_pFState SAutoLine
sal
(XY
_, Int
mpindex, Float
reld) = [LineAnchorsForRender] -> XY -> (XY, Int, Float)
getClosestPointOnLineFromLineAnchorsForRenderList [LineAnchorsForRender]
larlist XY
_mouseDrag_to
newllabel :: SAutoLineLabel
newllabel = forall a. Default a => a
def {
_sAutoLineLabel_index :: Int
_sAutoLineLabel_index = Int
mpindex
, _sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_position = Float -> SAutoLineLabelPosition
SAutoLineLabelPositionRelative Float
reld
}
r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$ Int
-> SAutoLine
-> SAutoLineLabel
-> SomePotatoHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> AutoLineLabelHandler
makeAutoLineLabelHandler_from_newLineLabel Int
rid SAutoLine
sal SAutoLineLabel
newllabel (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineHandler
slh) PotatoHandlerInput
phi RelMouseDrag
rmd
}
MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a. Default a => a
def
pHandleKeyboard :: AutoLineHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard AutoLineHandler
_ PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} KeyboardData
kbd = case KeyboardData
kbd of
KeyboardData
_ -> forall a. Maybe a
Nothing
pRenderHandler :: AutoLineHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineHandler {Bool
Maybe Int
_autoLineHandler_offsetAttach :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_isCreation :: Bool
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_isCreation :: AutoLineHandler -> Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = HandlerRenderOutput
r where
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 (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
labels :: [RenderHandle]
labels = PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels PotatoHandlerInput
phi Bool
False
r :: HandlerRenderOutput
r = if Bool
_autoLineHandler_isCreation
then [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput [RenderHandle]
attachmentBoxes
else [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ([RenderHandle]
attachmentBoxes forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
boxes forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
labels)
pIsHandlerActive :: AutoLineHandler -> Bool
pIsHandlerActive AutoLineHandler
_ = Bool
False
pHandlerTool :: AutoLineHandler -> Maybe Tool
pHandlerTool AutoLineHandler {Bool
Maybe Int
_autoLineHandler_offsetAttach :: Bool
_autoLineHandler_mDownManipulator :: Maybe Int
_autoLineHandler_isCreation :: Bool
_autoLineHandler_offsetAttach :: AutoLineHandler -> Bool
_autoLineHandler_mDownManipulator :: AutoLineHandler -> Maybe Int
_autoLineHandler_isCreation :: AutoLineHandler -> Bool
..} = if Bool
_autoLineHandler_isCreation
then forall a. a -> Maybe a
Just Tool
Tool_Line
else forall a. Maybe a
Nothing
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
}
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_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isStart :: AutoLineEndPointHandler -> Bool
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let
mridssline :: Maybe (Int, SAutoLine)
mridssline = CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
attachments :: [(Attachment, XY)]
attachments = Bool
-> Bool
-> OwlPFState
-> BroadPhaseState
-> LBox
-> [(Attachment, XY)]
getAvailableAttachments Bool
False Bool
True OwlPFState
_potatoHandlerInput_pFState BroadPhaseState
_potatoHandlerInput_broadPhase LBox
_potatoHandlerInput_screenRegion
mnewattachend :: Maybe Attachment
mnewattachend = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. XY -> [(Attachment, XY)] -> Maybe (Attachment, XY)
isOverAttachment XY
_mouseDrag_to forall a b. (a -> b) -> a -> b
$ [(Attachment, XY)]
attachments
mprojectattachend :: Maybe Attachment
mprojectattachend = case Maybe (Int, SAutoLine)
mridssline of
Maybe (Int, SAutoLine)
Nothing -> forall a. Maybe a
Nothing
Just (Int
_, SAutoLine
ssline) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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
AttachmentLocation -> XY -> Int -> LBox -> Maybe (Attachment, XY)
projectAttachment (Attachment -> AttachmentLocation
_attachment_location Attachment
aend) XY
_mouseDrag_to (Attachment -> Int
_attachment_target Attachment
aend) LBox
box
mattachend :: Maybe Attachment
mattachend = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe Attachment
mprojectattachend, Maybe Attachment
mnewattachend]
in case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should be handleed by AutoLineHandler"
MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
rid :: Int
rid = SuperOwl -> Int
_superOwl_id forall a b. (a -> b) -> a -> b
$ HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
ssline :: SAutoLine
ssline = case Maybe (Int, SAutoLine)
mridssline of
Just (Int
_,SAutoLine
x) -> SAutoLine
x
Maybe (Int, SAutoLine)
Nothing -> forall a. Default a => a
def
sslinestart :: Maybe Attachment
sslinestart = SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
ssline
sslineend :: Maybe Attachment
sslineend = SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
ssline
nontrivialline :: Bool
nontrivialline = if Bool
_autoLineEndPointHandler_isStart
then forall a. a -> Maybe a
Just XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
/= (HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
_autoLineEndPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
sslineend)
else forall a. a -> Maybe a
Just XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
/= (HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
_autoLineEndPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
sslinestart)
mattachendnontrivial :: Maybe Attachment
mattachendnontrivial = if Bool
nontrivialline
then Maybe Attachment
mattachend
else forall a. Maybe a
Nothing
modifiedline :: SAutoLine
modifiedline = if Bool
_autoLineEndPointHandler_isStart
then SAutoLine
ssline {
_sAutoLine_start :: XY
_sAutoLine_start = XY
_mouseDrag_to
, _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = Maybe Attachment
mattachendnontrivial
}
else SAutoLine
ssline {
_sAutoLine_end :: XY
_sAutoLine_end = XY
_mouseDrag_to
, _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = Maybe Attachment
mattachendnontrivial
}
llama :: Llama
llama = (Int, SElt) -> Llama
makeSetLlama forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
modifiedline)
newEltPos :: OwlSpot
newEltPos = OwlTree -> Selection -> OwlSpot
lastPositionInSelection (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
_potatoHandlerInput_pFState) Selection
_potatoHandlerInput_selection
lineToAdd :: SAutoLine
lineToAdd = forall a. Default a => a
def {
_sAutoLine_start :: XY
_sAutoLine_start = XY
_mouseDrag_from
, _sAutoLine_end :: XY
_sAutoLine_end = XY
_mouseDrag_to
, _sAutoLine_superStyle :: SuperStyle
_sAutoLine_superStyle = PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_superStyle PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters
, _sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyle = PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyle PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters
, _sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_lineStyleEnd =
PotatoDefaultParameters -> LineStyle
_potatoDefaultParameters_lineStyleEnd PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters
, _sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachStart = Maybe Attachment
_autoLineEndPointHandler_attachStart
, _sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_attachEnd = Maybe Attachment
mattachendnontrivial
}
op :: WSEvent
op = if Bool
_autoLineEndPointHandler_isCreation
then (Bool, OwlSpot, OwlItem) -> WSEvent
WSEAddElt (Bool
_autoLineEndPointHandler_undoFirst, OwlSpot
newEltPos, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
"<line>") forall a b. (a -> b) -> a -> b
$ SAutoLine -> OwlSubItem
OwlSubItemLine SAutoLine
lineToAdd)
else (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
_autoLineEndPointHandler_undoFirst, Llama
llama)
r :: PotatoHandlerOutput
r = forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineEndPointHandler
slh {
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_undoFirst = Bool
True
, _autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_attachStart = if Bool
_autoLineEndPointHandler_isStart then Maybe Attachment
mattachendnontrivial else Maybe Attachment
_autoLineEndPointHandler_attachStart
, _autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachEnd = if Bool -> Bool
not Bool
_autoLineEndPointHandler_isStart then Maybe Attachment
mattachendnontrivial else Maybe Attachment
_autoLineEndPointHandler_attachEnd
}
, _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = forall a. a -> Maybe a
Just WSEvent
op
}
MouseDragState
MouseDragState_Up -> forall a. a -> Maybe a
Just forall a. Default a => a
def
MouseDragState
MouseDragState_Cancelled -> if Bool
_autoLineEndPointHandler_undoFirst then forall a. a -> Maybe a
Just forall a. Default a => a
def { _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = forall a. a -> Maybe a
Just WSEvent
WSEUndo } else forall a. a -> Maybe a
Just forall a. Default a => a
def
pHandleKeyboard :: AutoLineEndPointHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard AutoLineEndPointHandler
_ PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} KeyboardData
_ = forall a. Maybe a
Nothing
pRenderHandler :: AutoLineEndPointHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineEndPointHandler {Bool
Maybe Attachment
_autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isStart :: AutoLineEndPointHandler -> Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = HandlerRenderOutput
r where
boxes :: [RenderHandle]
boxes = (Bool, Bool) -> Bool -> Int -> PotatoHandlerInput -> [RenderHandle]
maybeRenderPoints (Bool
_autoLineEndPointHandler_isStart, Bool -> Bool
not Bool
_autoLineEndPointHandler_isStart) Bool
_autoLineEndPointHandler_offsetAttach (-Int
1) PotatoHandlerInput
phi
attachmentBoxes :: [RenderHandle]
attachmentBoxes = PotatoHandlerInput
-> (Maybe Attachment, Maybe Attachment) -> [RenderHandle]
renderAttachments PotatoHandlerInput
phi (Maybe Attachment
_autoLineEndPointHandler_attachStart, Maybe Attachment
_autoLineEndPointHandler_attachEnd)
r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ([RenderHandle]
attachmentBoxes forall a. Semigroup a => a -> a -> a
<> [RenderHandle]
boxes)
pIsHandlerActive :: AutoLineEndPointHandler -> Bool
pIsHandlerActive AutoLineEndPointHandler
_ = Bool
True
pHandlerTool :: AutoLineEndPointHandler -> Maybe Tool
pHandlerTool AutoLineEndPointHandler {Bool
Maybe Attachment
_autoLineEndPointHandler_attachEnd :: Maybe Attachment
_autoLineEndPointHandler_attachStart :: Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: Bool
_autoLineEndPointHandler_isCreation :: Bool
_autoLineEndPointHandler_undoFirst :: Bool
_autoLineEndPointHandler_isStart :: Bool
_autoLineEndPointHandler_attachEnd :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_attachStart :: AutoLineEndPointHandler -> Maybe Attachment
_autoLineEndPointHandler_offsetAttach :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isCreation :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_undoFirst :: AutoLineEndPointHandler -> Bool
_autoLineEndPointHandler_isStart :: AutoLineEndPointHandler -> Bool
..} = if Bool
_autoLineEndPointHandler_isCreation
then forall a. a -> Maybe a
Just Tool
Tool_Line
else forall a. Maybe a
Nothing
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 = 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 forall a. Ord a => a -> a -> Bool
> Int
addmpi then Int
iforall a. Num a => a -> a -> a
+Int
1 else Int
i
Just (Right Int
delmpi) -> if Int
i forall a. Ord a => a -> a -> Bool
>= Int
delmpi then Int
iforall a. Num a => a -> a -> a
-Int
1 else Int
i
oldlars :: [LineAnchorsForRender]
oldlars = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
old
newlars :: [LineAnchorsForRender]
newlars = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList a
ot SAutoLine
new
r :: a
r = 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 = 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 forall a. Ord a => a -> a -> Bool
> Int
mpindex
then SAutoLineLabel
ll { _sAutoLineLabel_index :: Int
_sAutoLineLabel_index = SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll forall a. Num a => a -> a -> a
+ Int
1}
else SAutoLineLabel
ll
newlabels :: [SAutoLineLabel]
newlabels = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SAutoLineLabel -> SAutoLineLabel
fmapfn (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline)
r :: SAutoLine
r = SAutoLine
sline {
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = [SAutoLineConstraint]
newmidpoints
, _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = [SAutoLineLabel]
newlabels
}
sAutoLine_modifyMidpoint :: Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_modifyMidpoint :: Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_modifyMidpoint Int
mpindex XY
pos SAutoLine
sline = SAutoLine
r where
newmidpoints :: [SAutoLineConstraint]
newmidpoints = forall a. Int -> (a -> a) -> [a] -> [a]
L.modifyAt Int
mpindex (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ XY -> SAutoLineConstraint
SAutoLineConstraintFixed XY
pos) (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
sline)
newlabels :: [SAutoLineLabel]
newlabels = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline
r :: SAutoLine
r = SAutoLine
sline {
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = [SAutoLineConstraint]
newmidpoints
, _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = [SAutoLineLabel]
newlabels
}
sAutoLine_deleteMidpoint :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteMidpoint :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteMidpoint Int
mpindex SAutoLine
sline = SAutoLine
r where
newmidpoints :: [SAutoLineConstraint]
newmidpoints = forall a. Int -> [a] -> [a]
L.deleteAt Int
mpindex (SAutoLine -> [SAutoLineConstraint]
_sAutoLine_midpoints SAutoLine
sline)
fmapfn :: SAutoLineLabel -> SAutoLineLabel
fmapfn SAutoLineLabel
ll = if SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll forall a. Ord a => a -> a -> Bool
>= Int
mpindex
then SAutoLineLabel
ll { _sAutoLineLabel_index :: Int
_sAutoLineLabel_index = SAutoLineLabel -> Int
_sAutoLineLabel_index SAutoLineLabel
ll forall a. Num a => a -> a -> a
- Int
1}
else SAutoLineLabel
ll
newlabels :: [SAutoLineLabel]
newlabels = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SAutoLineLabel -> SAutoLineLabel
fmapfn (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline)
r :: SAutoLine
r = SAutoLine
sline {
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_midpoints = [SAutoLineConstraint]
newmidpoints
, _sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = [SAutoLineLabel]
newlabels
}
data AutoLineMidPointHandler = AutoLineMidPointHandler{
AutoLineMidPointHandler -> Int
_autoLineMidPointHandler_midPointIndex :: Int
, AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_isMidpointCreation :: Bool
, AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_undoFirst :: Bool
, AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_offsetAttach :: Bool
}
instance PotatoHandler AutoLineMidPointHandler where
pHandlerName :: AutoLineMidPointHandler -> Text
pHandlerName AutoLineMidPointHandler
_ = Text
handlerName_simpleLine_midPoint
pHandleMouse :: AutoLineMidPointHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse slh :: AutoLineMidPointHandler
slh@AutoLineMidPointHandler {Bool
Int
_autoLineMidPointHandler_offsetAttach :: Bool
_autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_offsetAttach :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_undoFirst :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_isMidpointCreation :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_midPointIndex :: AutoLineMidPointHandler -> Int
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down -> forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not Bool
_autoLineMidPointHandler_isMidpointCreation) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineMidPointHandler
slh
MouseDragState
MouseDragState_Dragging -> Maybe PotatoHandlerOutput
r where
(Int
rid, SAutoLine
sline) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Maybe (Int, SAutoLine)
maybeGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
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 = Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition Bool
_autoLineMidPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState SAutoLine
sline Int
mpindex
radjacentpos :: XY
radjacentpos = Bool -> OwlPFState -> SAutoLine -> Int -> XY
getAnchorPosition Bool
_autoLineMidPointHandler_offsetAttach OwlPFState
_potatoHandlerInput_pFState SAutoLine
sline (Int
mpindexforall a. Num a => a -> a -> a
+Int
2)
isoveradjacent :: Bool
isoveradjacent = XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
== XY
ladjacentpos Bool -> Bool -> Bool
|| XY
_mouseDrag_to forall a. Eq a => a -> a -> Bool
== XY
radjacentpos
newsline :: SAutoLine
newsline = if Bool
_autoLineMidPointHandler_isMidpointCreation
then Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_addMidpoint Int
mpindex XY
_mouseDrag_to SAutoLine
sline
else Int -> XY -> SAutoLine -> SAutoLine
sAutoLine_modifyMidpoint Int
mpindex XY
_mouseDrag_to SAutoLine
sline
newslinedelete :: SAutoLine
newslinedelete = Int -> SAutoLine -> SAutoLine
sAutoLine_deleteMidpoint Int
mpindex SAutoLine
sline
(Bool
diddelete, WSEvent
event) = case LineManipulatorProxy
firstlm of
LineManipulatorProxy
_ | Bool
_autoLineMidPointHandler_isMidpointCreation -> (Bool
False,) forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
_autoLineMidPointHandler_undoFirst, (Int, SElt) -> Llama
makeSetLlama forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline))
LineManipulatorProxy
_ | Bool
isoveradjacent -> (Bool
True,) forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
_autoLineMidPointHandler_undoFirst, (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newslinedelete))
LineManipulatorProxy
_ -> (Bool
False,) forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
_autoLineMidPointHandler_undoFirst, (Int, SElt) -> Llama
makeSetLlama forall a b. (a -> b) -> a -> b
$ (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsline))
r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineMidPointHandler
slh {
_autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_isMidpointCreation = Bool
diddelete Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
_autoLineMidPointHandler_isMidpointCreation
, _autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_undoFirst = Bool
True
}
, _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = forall a. a -> Maybe a
Just WSEvent
event
}
MouseDragState
MouseDragState_Up -> forall a. a -> Maybe a
Just forall a. Default a => a
def
MouseDragState
MouseDragState_Cancelled -> if Bool
_autoLineMidPointHandler_undoFirst then forall a. a -> Maybe a
Just forall a. Default a => a
def { _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = forall a. a -> Maybe a
Just WSEvent
WSEUndo } else forall a. a -> Maybe a
Just forall a. Default a => a
def
pRenderHandler :: AutoLineMidPointHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineMidPointHandler {Bool
Int
_autoLineMidPointHandler_offsetAttach :: Bool
_autoLineMidPointHandler_undoFirst :: Bool
_autoLineMidPointHandler_isMidpointCreation :: Bool
_autoLineMidPointHandler_midPointIndex :: Int
_autoLineMidPointHandler_offsetAttach :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_undoFirst :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_isMidpointCreation :: AutoLineMidPointHandler -> Bool
_autoLineMidPointHandler_midPointIndex :: AutoLineMidPointHandler -> Int
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = HandlerRenderOutput
r where
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 -> Bool
pIsHandlerActive AutoLineMidPointHandler
_ = Bool
True
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_labelIndex :: Int
_autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: XY
_autoLineLabelMoverHandler_labelIndex :: AutoLineLabelMoverHandler -> Int
_autoLineLabelMoverHandler_undoFirst :: AutoLineLabelMoverHandler -> Bool
_autoLineLabelMoverHandler_prevHandler :: AutoLineLabelMoverHandler -> SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: AutoLineLabelMoverHandler -> XY
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let
(Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
llabel :: SAutoLineLabel
llabel = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
_autoLineLabelMoverHandler_labelIndex
larlist :: [LineAnchorsForRender]
larlist = forall a. HasOwlTree a => a -> SAutoLine -> [LineAnchorsForRender]
sAutoLine_to_lineAnchorsForRenderList OwlPFState
_potatoHandlerInput_pFState SAutoLine
sal
(XY
_, Int
index, Float
reld) = [LineAnchorsForRender] -> XY -> (XY, Int, Float)
getClosestPointOnLineFromLineAnchorsForRenderList [LineAnchorsForRender]
larlist XY
_mouseDrag_to
newl :: SAutoLineLabel
newl = SAutoLineLabel
llabel {
_sAutoLineLabel_index :: Int
_sAutoLineLabel_index = Int
index
, _sAutoLineLabel_position :: SAutoLineLabelPosition
_sAutoLineLabel_position = Float -> SAutoLineLabelPosition
SAutoLineLabelPositionRelative Float
reld
}
in case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineLabelMoverHandler
slh
MouseDragState
MouseDragState_Dragging -> Maybe PotatoHandlerOutput
r where
newsal :: SAutoLine
newsal = SAutoLine
sal {
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = forall a. Int -> a -> [a] -> [a]
L.setAt Int
_autoLineLabelMoverHandler_labelIndex SAutoLineLabel
newl (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal)
}
op :: WSEvent
op = (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
_autoLineLabelMoverHandler_undoFirst, (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsal))
r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelMoverHandler
slh {
_autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_undoFirst = Bool
True
}
, _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = forall a. a -> Maybe a
Just WSEvent
op
}
MouseDragState
MouseDragState_Up -> forall a. a -> Maybe a
Just forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = if Bool -> Bool
not Bool
_autoLineLabelMoverHandler_undoFirst
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler forall a b. (a -> b) -> a -> b
$
Int
-> SomePotatoHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> AutoLineLabelHandler
makeAutoLineLabelHandler_from_labelIndex Int
_autoLineLabelMoverHandler_labelIndex SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler PotatoHandlerInput
phi RelMouseDrag
rmd
else forall a. a -> Maybe a
Just (SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler)
}
MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a. Default a => a
def {
_potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = if Bool
_autoLineLabelMoverHandler_undoFirst then forall a. a -> Maybe a
Just WSEvent
WSEUndo else forall a. Maybe a
Nothing
, _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just (SomePotatoHandler
_autoLineLabelMoverHandler_prevHandler)
}
pRenderHandler :: AutoLineLabelMoverHandler
-> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineLabelMoverHandler {Bool
Int
XY
SomePotatoHandler
_autoLineLabelMoverHandler_labelIndex :: Int
_autoLineLabelMoverHandler_undoFirst :: Bool
_autoLineLabelMoverHandler_prevHandler :: SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: XY
_autoLineLabelMoverHandler_labelIndex :: AutoLineLabelMoverHandler -> Int
_autoLineLabelMoverHandler_undoFirst :: AutoLineLabelMoverHandler -> Bool
_autoLineLabelMoverHandler_prevHandler :: AutoLineLabelMoverHandler -> SomePotatoHandler
_autoLineLabelMoverHandler_anchorOffset :: AutoLineLabelMoverHandler -> XY
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = HandlerRenderOutput
r where
labels :: [RenderHandle]
labels = PotatoHandlerInput -> Bool -> [RenderHandle]
renderLabels PotatoHandlerInput
phi Bool
False
r :: HandlerRenderOutput
r = [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput [RenderHandle]
labels
pIsHandlerActive :: AutoLineLabelMoverHandler -> Bool
pIsHandlerActive AutoLineLabelMoverHandler
_ = Bool
True
sAutoLine_deleteLabel :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteLabel :: Int -> SAutoLine -> SAutoLine
sAutoLine_deleteLabel Int
labelindex SAutoLine
sline = SAutoLine
r where
newlabels :: [SAutoLineLabel]
newlabels = forall a. Int -> [a] -> [a]
L.deleteAt Int
labelindex (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sline)
r :: SAutoLine
r = SAutoLine
sline {
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = [SAutoLineLabel]
newlabels
}
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 (forall a. a -> a -> V2 a
V2 (Int
x forall a. Num a => a -> a -> a
- Int
w forall a. Integral a => a -> a -> a
`div` Int
2) Int
y) (forall a. a -> a -> V2 a
V2 Int
w Int
1)
updateAutoLineLabelHandlerState :: (HasOwlTree a) => a -> Bool -> CanvasSelection -> AutoLineLabelHandler -> AutoLineLabelHandler
updateAutoLineLabelHandlerState :: forall a.
HasOwlTree a =>
a
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
updateAutoLineLabelHandlerState a
ot Bool
reset CanvasSelection
selection slh :: AutoLineLabelHandler
slh@AutoLineLabelHandler {Bool
Int
SAutoLineLabel
SomePotatoHandler
TextInputState
_autoLineLabelHandler_creation :: Bool
_autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_creation :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_lineLabel :: AutoLineLabelHandler -> SAutoLineLabel
_autoLineLabelHandler_labelIndex :: AutoLineLabelHandler -> Int
_autoLineLabelHandler_undoFirst :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_prevHandler :: AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_state :: AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_active :: AutoLineLabelHandler -> Bool
..} = AutoLineLabelHandler
r where
(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 forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
_autoLineLabelHandler_labelIndex
newtext :: Text
newtext = SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
pos :: XY
pos = forall a. HasOwlTree a => a -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPosition a
ot SAutoLine
sal SAutoLineLabel
llabel
width :: Int
width = 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 :: TextInputState
_autoLineLabelHandler_state = TextInputState
_autoLineLabelHandler_state {
_textInputState_original :: Maybe Text
_textInputState_original = if Bool
reset then forall a. a -> Maybe a
Just Text
newtext else TextInputState -> Maybe Text
_textInputState_original TextInputState
_autoLineLabelHandler_state
, _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
TZ.TextAlignment_Left Int
width () () (TextInputState -> TextZipper
_textInputState_zipper TextInputState
_autoLineLabelHandler_state)
, _textInputState_box :: LBox
_textInputState_box = LBox
box
}
, _autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_undoFirst = if Bool
reset
then Bool
False
else Bool
_autoLineLabelHandler_undoFirst
, _autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_lineLabel = SAutoLineLabel
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
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} RelMouseDrag
rmd = TextInputState
r where
ogtext :: Text
ogtext = SAutoLineLabel -> Text
_sAutoLineLabel_text SAutoLineLabel
llabel
pos :: XY
pos = forall a. HasOwlTree a => a -> SAutoLine -> SAutoLineLabel -> XY
getSAutoLineLabelPosition OwlPFState
_potatoHandlerInput_pFState SAutoLine
sal SAutoLineLabel
llabel
box :: LBox
box = XY -> SAutoLineLabel -> LBox
getSAutoLineLabelBox XY
pos SAutoLineLabel
llabel
width :: Int
width = forall a. Bounded a => a
maxBound :: Int
ogtz :: TextZipper
ogtz = Text -> TextZipper
TZ.fromText Text
ogtext
tis :: TextInputState
tis = TextInputState {
_textInputState_rid :: Int
_textInputState_rid = Int
rid
, _textInputState_original :: Maybe Text
_textInputState_original = forall a. a -> Maybe a
Just Text
ogtext
, _textInputState_zipper :: TextZipper
_textInputState_zipper = TextZipper
ogtz
, _textInputState_box :: LBox
_textInputState_box = LBox
box
, _textInputState_displayLines :: DisplayLines ()
_textInputState_displayLines = forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
TZ.TextAlignment_Left Int
width () () TextZipper
ogtz
}
r :: TextInputState
r = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
tis RelMouseDrag
rmd
makeAutoLineLabelInputState_from_labelIndex :: REltId -> SAutoLine -> Int -> PotatoHandlerInput -> RelMouseDrag -> TextInputState
makeAutoLineLabelInputState_from_labelIndex :: Int
-> SAutoLine
-> Int
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_labelIndex Int
rid SAutoLine
sal Int
labelindex phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} RelMouseDrag
rmd = TextInputState
r where
llabel :: SAutoLineLabel
llabel = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
labelindex
r :: TextInputState
r = Int
-> SAutoLine
-> SAutoLineLabel
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_lineLabel Int
rid SAutoLine
sal SAutoLineLabel
llabel PotatoHandlerInput
phi RelMouseDrag
rmd
makeAutoLineLabelHandler_from_newLineLabel :: REltId -> SAutoLine -> SAutoLineLabel -> SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> AutoLineLabelHandler
makeAutoLineLabelHandler_from_newLineLabel :: Int
-> SAutoLine
-> SAutoLineLabel
-> SomePotatoHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> AutoLineLabelHandler
makeAutoLineLabelHandler_from_newLineLabel Int
rid SAutoLine
sal SAutoLineLabel
llabel SomePotatoHandler
prev PotatoHandlerInput
phi RelMouseDrag
rmd = AutoLineLabelHandler {
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_active = Bool
False
, _autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state = (Int
-> SAutoLine
-> SAutoLineLabel
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_lineLabel Int
rid SAutoLine
sal SAutoLineLabel
llabel PotatoHandlerInput
phi RelMouseDrag
rmd)
, _autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_prevHandler = SomePotatoHandler
prev
, _autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_undoFirst = Bool
False
, _autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_labelIndex = Int
0
, _autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_lineLabel = SAutoLineLabel
llabel
, _autoLineLabelHandler_creation :: Bool
_autoLineLabelHandler_creation = Bool
True
}
makeAutoLineLabelHandler_from_labelIndex :: Int -> SomePotatoHandler -> PotatoHandlerInput -> RelMouseDrag -> AutoLineLabelHandler
makeAutoLineLabelHandler_from_labelIndex :: Int
-> SomePotatoHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> AutoLineLabelHandler
makeAutoLineLabelHandler_from_labelIndex Int
labelindex SomePotatoHandler
prev phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} RelMouseDrag
rmd = AutoLineLabelHandler
r where
(Int
rid, SAutoLine
sal) = CanvasSelection -> (Int, SAutoLine)
mustGetSLine CanvasSelection
_potatoHandlerInput_canvasSelection
llabel :: SAutoLineLabel
llabel = SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal forall a. HasCallStack => [a] -> Int -> a
`debugBangBang` Int
labelindex
r :: AutoLineLabelHandler
r = AutoLineLabelHandler {
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_active = Bool
False
, _autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state = TextInputState -> TextInputState
moveToEol forall a b. (a -> b) -> a -> b
$ Int
-> SAutoLine
-> Int
-> PotatoHandlerInput
-> RelMouseDrag
-> TextInputState
makeAutoLineLabelInputState_from_labelIndex Int
rid SAutoLine
sal Int
labelindex PotatoHandlerInput
phi RelMouseDrag
rmd
, _autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_prevHandler = SomePotatoHandler
prev
, _autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_undoFirst = Bool
False
, _autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_labelIndex = Int
labelindex
, _autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_lineLabel = SAutoLineLabel
llabel
, _autoLineLabelHandler_creation :: Bool
_autoLineLabelHandler_creation = Bool
False
}
handleMouseDownOrFirstUpForAutoLineLabelHandler :: AutoLineLabelHandler -> PotatoHandlerInput -> RelMouseDrag -> Bool -> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler :: AutoLineLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler slh :: AutoLineLabelHandler
slh@AutoLineLabelHandler {Bool
Int
SAutoLineLabel
SomePotatoHandler
TextInputState
_autoLineLabelHandler_creation :: Bool
_autoLineLabelHandler_lineLabel :: SAutoLineLabel
_autoLineLabelHandler_labelIndex :: Int
_autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_prevHandler :: SomePotatoHandler
_autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_creation :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_lineLabel :: AutoLineLabelHandler -> SAutoLineLabel
_autoLineLabelHandler_labelIndex :: AutoLineLabelHandler -> Int
_autoLineLabelHandler_undoFirst :: AutoLineLabelHandler -> Bool
_autoLineLabelHandler_prevHandler :: AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_state :: AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_active :: AutoLineLabelHandler -> Bool
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) Bool
isdown = Maybe PotatoHandlerOutput
r where
clickInside :: Bool
clickInside = LBox -> XY -> Bool
does_lBox_contains_XY (TextInputState -> LBox
_textInputState_box TextInputState
_autoLineLabelHandler_state) XY
_mouseDrag_to
newState :: TextInputState
newState = TextInputState -> RelMouseDrag -> TextInputState
mouseText TextInputState
_autoLineLabelHandler_state RelMouseDrag
rmd
r :: Maybe PotatoHandlerOutput
r = if Bool
clickInside
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelHandler
slh {
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_active = Bool
isdown
, _autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state = TextInputState
newState
}
}
else forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse SomePotatoHandler
_autoLineLabelHandler_prevHandler PotatoHandlerInput
phi RelMouseDrag
rmd
instance PotatoHandler AutoLineLabelHandler where
pHandlerName :: AutoLineLabelHandler -> Text
pHandlerName AutoLineLabelHandler
_ = Text
handlerName_simpleLine_textLabel
pHandleMouse :: AutoLineLabelHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse AutoLineLabelHandler
slh' phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = let
slh :: AutoLineLabelHandler
slh = forall a.
HasOwlTree a =>
a
-> Bool
-> CanvasSelection
-> AutoLineLabelHandler
-> AutoLineLabelHandler
updateAutoLineLabelHandlerState OwlPFState
_potatoHandlerInput_pFState Bool
False CanvasSelection
_potatoHandlerInput_canvasSelection AutoLineLabelHandler
slh'
in case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down -> AutoLineLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler AutoLineLabelHandler
slh PotatoHandlerInput
phi RelMouseDrag
rmd Bool
True
MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineLabelHandler
slh
MouseDragState
MouseDragState_Up -> if Bool -> Bool
not (AutoLineLabelHandler -> Bool
_autoLineLabelHandler_active AutoLineLabelHandler
slh)
then AutoLineLabelHandler
-> PotatoHandlerInput
-> RelMouseDrag
-> Bool
-> Maybe PotatoHandlerOutput
handleMouseDownOrFirstUpForAutoLineLabelHandler AutoLineLabelHandler
slh PotatoHandlerInput
phi RelMouseDrag
rmd Bool
False
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelHandler
slh {
_autoLineLabelHandler_active :: Bool
_autoLineLabelHandler_active = Bool
False
}
}
MouseDragState
MouseDragState_Cancelled -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange AutoLineLabelHandler
slh
pHandleKeyboard :: AutoLineLabelHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard AutoLineLabelHandler
slh' PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} (KeyboardData KeyboardKey
k [KeyModifier]
_) = let
slh :: AutoLineLabelHandler
slh = 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 forall a. Eq a => a -> a -> Bool
== KeyboardKey
KeyboardKey_Esc Bool -> Bool -> Bool
|| KeyboardKey
k forall a. Eq a => a -> a -> Bool
== KeyboardKey
KeyboardKey_Return -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def { _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just (AutoLineLabelHandler -> SomePotatoHandler
_autoLineLabelHandler_prevHandler AutoLineLabelHandler
slh) }
KeyboardKey
_ -> 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 :: Text
_sAutoLineLabel_text = Text
newtext
}
newsal_creation :: SAutoLine
newsal_creation = SAutoLine
sal {
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = SAutoLineLabel
newlabel forall a. a -> [a] -> [a]
: SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal
}
newsal_update :: SAutoLine
newsal_update = SAutoLine
sal {
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_labels = forall a. Int -> a -> [a] -> [a]
L.setAt (AutoLineLabelHandler -> Int
_autoLineLabelHandler_labelIndex AutoLineLabelHandler
slh) SAutoLineLabel
newlabel (SAutoLine -> [SAutoLineLabel]
_sAutoLine_labels SAutoLine
sal)
}
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
mev :: Maybe WSEvent
mev = if Bool -> Bool
not Bool
changed
then forall a. Maybe a
Nothing
else if Bool
doesdelete Bool -> Bool -> Bool
&& AutoLineLabelHandler -> Bool
_autoLineLabelHandler_creation AutoLineLabelHandler
slh
then forall a. a -> Maybe a
Just WSEvent
WSEUndo
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (AutoLineLabelHandler -> Bool
_autoLineLabelHandler_undoFirst AutoLineLabelHandler
slh, (Int, SElt) -> Llama
makeSetLlama (Int
rid, SAutoLine -> SElt
SEltLine SAutoLine
newsal))
r :: PotatoHandlerOutput
r = forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler AutoLineLabelHandler
slh {
_autoLineLabelHandler_state :: TextInputState
_autoLineLabelHandler_state = TextInputState
newtais
, _autoLineLabelHandler_undoFirst :: Bool
_autoLineLabelHandler_undoFirst = case Maybe WSEvent
mev of
Maybe WSEvent
Nothing -> AutoLineLabelHandler -> Bool
_autoLineLabelHandler_undoFirst AutoLineLabelHandler
slh
Just WSEvent
WSEUndo -> Bool
False
Maybe WSEvent
_ -> Bool
True
}
, _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = Maybe WSEvent
mev
}
pRefreshHandler :: AutoLineLabelHandler
-> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler AutoLineLabelHandler
slh PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = if forall a. Seq a -> Bool
Seq.null (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
then forall a. Maybe a
Nothing
else if Int
rid forall a. Eq a => a -> a -> Bool
/= (TextInputState -> Int
_textInputState_rid forall a b. (a -> b) -> a -> b
$ AutoLineLabelHandler -> TextInputState
_autoLineLabelHandler_state AutoLineLabelHandler
slh)
then forall a. Maybe a
Nothing
else case SElt
selt of
SEltLine SAutoLine
_ -> forall a. Maybe a
Nothing
SElt
_ -> forall a. Maybe a
Nothing
where
sowl :: SuperOwl
sowl = HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
selt :: SElt
selt = SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl
pRenderHandler :: AutoLineLabelHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler AutoLineLabelHandler
slh' PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = HandlerRenderOutput
r where
slh :: AutoLineLabelHandler
slh = 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 -> Bool
pIsHandlerActive = AutoLineLabelHandler -> Bool
_autoLineLabelHandler_active