{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-unused-record-wildcards #-}
module Potato.Flow.Controller.Manipulator.Box where
import Relude
import Potato.Flow.Controller.Handler
import Potato.Flow.Controller.Input
import Potato.Flow.Controller.Manipulator.BoxText
import Potato.Flow.Controller.Manipulator.TextArea
import Potato.Flow.Controller.Manipulator.Common
import Potato.Flow.Controller.Types
import Potato.Flow.Math
import Potato.Flow.Methods.SEltMethods
import Potato.Flow.Serialization.Snake
import Potato.Flow.Types
import Potato.Flow.OwlItem
import Potato.Flow.Owl
import Potato.Flow.OwlState
import Potato.Flow.OwlWorkspace
import Potato.Flow.Methods.Types
import Potato.Flow.Llama
import Potato.Flow.Methods.LlamaWorks
import Potato.Flow.Preview
import Data.Default
import Data.Dependent.Sum (DSum ((:=>)))
import qualified Data.IntMap as IM
import qualified Data.Map as Map
import qualified Data.List as L
import qualified Data.Sequence as Seq
import Control.Exception (assert)
superOwl_isTransformable :: (HasOwlTree o) => SuperOwl -> o -> Bool
superOwl_isTransformable :: forall o. HasOwlTree o => SuperOwl -> o -> Bool
superOwl_isTransformable SuperOwl
sowl o
ot = case OwlItem -> OwlSubItem
_owlItem_subItem (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl) of
OwlSubItem
OwlSubItemNone -> Bool
False
OwlSubItemFolder Seq Int
_ -> Bool
False
OwlSubItemLine SAutoLine
sline -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
(Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline Maybe Attachment -> (Attachment -> Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Attachment
att -> o -> Int -> Bool
forall o. HasOwlTree o => o -> Int -> Bool
hasOwlTree_exists o
ot (Attachment -> Int
_attachment_target Attachment
att)))
Bool -> Bool -> Bool
&& (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline Maybe Attachment -> (Attachment -> Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Attachment
att -> o -> Int -> Bool
forall o. HasOwlTree o => o -> Int -> Bool
hasOwlTree_exists o
ot (Attachment -> Int
_attachment_target Attachment
att)))
OwlSubItem
_ -> Bool
True
transformableSelection :: PotatoHandlerInput -> Seq SuperOwl
transformableSelection :: PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
..} = OwlPFState -> CanvasSelection -> Seq SuperOwl
transformableSelection' OwlPFState
_potatoHandlerInput_pFState CanvasSelection
_potatoHandlerInput_canvasSelection
transformableSelection' :: OwlPFState -> CanvasSelection -> Seq SuperOwl
transformableSelection' :: OwlPFState -> CanvasSelection -> Seq SuperOwl
transformableSelection' OwlPFState
pfs CanvasSelection
sel = (SuperOwl -> Bool) -> Seq SuperOwl -> Seq SuperOwl
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter ((SuperOwl -> OwlPFState -> Bool) -> OwlPFState -> SuperOwl -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip SuperOwl -> OwlPFState -> Bool
forall o. HasOwlTree o => SuperOwl -> o -> Bool
superOwl_isTransformable OwlPFState
pfs) (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
sel)
data MouseManipulatorType = MouseManipulatorType_Corner | MouseManipulatorType_Side | MouseManipulatorType_Point | MouseManipulatorType_Area | MouseManipulatorType_Text deriving (Int -> MouseManipulatorType -> ShowS
[MouseManipulatorType] -> ShowS
MouseManipulatorType -> String
(Int -> MouseManipulatorType -> ShowS)
-> (MouseManipulatorType -> String)
-> ([MouseManipulatorType] -> ShowS)
-> Show MouseManipulatorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseManipulatorType -> ShowS
showsPrec :: Int -> MouseManipulatorType -> ShowS
$cshow :: MouseManipulatorType -> String
show :: MouseManipulatorType -> String
$cshowList :: [MouseManipulatorType] -> ShowS
showList :: [MouseManipulatorType] -> ShowS
Show, MouseManipulatorType -> MouseManipulatorType -> Bool
(MouseManipulatorType -> MouseManipulatorType -> Bool)
-> (MouseManipulatorType -> MouseManipulatorType -> Bool)
-> Eq MouseManipulatorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseManipulatorType -> MouseManipulatorType -> Bool
== :: MouseManipulatorType -> MouseManipulatorType -> Bool
$c/= :: MouseManipulatorType -> MouseManipulatorType -> Bool
/= :: MouseManipulatorType -> MouseManipulatorType -> Bool
Eq)
data MouseManipulator = MouseManipulator {
MouseManipulator -> LBox
_mouseManipulator_box :: LBox
, MouseManipulator -> MouseManipulatorType
_mouseManipulator_type :: MouseManipulatorType
}
type MouseManipulatorSet = [MouseManipulator]
type ManipulatorIndex = Int
toMouseManipulators :: OwlPFState -> CanvasSelection -> MouseManipulatorSet
toMouseManipulators :: OwlPFState -> CanvasSelection -> MouseManipulatorSet
toMouseManipulators OwlPFState
pfs CanvasSelection
selection' = MouseManipulatorSet
bb where
union_lBoxes :: NonEmpty LBox -> LBox
union_lBoxes :: NonEmpty LBox -> LBox
union_lBoxes (LBox
x:|[LBox]
xs) = (LBox -> LBox -> LBox) -> LBox -> [LBox] -> LBox
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LBox -> LBox -> LBox
union_lBox LBox
x [LBox]
xs
selection :: Seq SuperOwl
selection = OwlPFState -> CanvasSelection -> Seq SuperOwl
transformableSelection' OwlPFState
pfs CanvasSelection
selection'
fmapfn :: SuperOwl -> LBox
fmapfn SuperOwl
sowl = SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_box (OwlSubItem -> SEltDrawer
getDrawer (OwlSubItem -> SEltDrawer)
-> (SuperOwl -> OwlSubItem) -> SuperOwl -> SEltDrawer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlSubItem
forall o. HasOwlItem o => o -> OwlSubItem
hasOwlItem_toOwlSubItem (SuperOwl -> SEltDrawer) -> SuperOwl -> SEltDrawer
forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) OwlPFState
pfs
sboxes :: [LBox]
sboxes = Seq LBox -> [LBox]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq LBox -> [LBox]) -> Seq LBox -> [LBox]
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> LBox) -> Seq SuperOwl -> Seq LBox
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> LBox
fmapfn Seq SuperOwl
selection
bb :: MouseManipulatorSet
bb = case [LBox]
sboxes of
[] -> []
LBox
x:[LBox]
xs -> (BoxHandleType -> MouseManipulator)
-> [BoxHandleType] -> MouseManipulatorSet
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BoxHandleType -> LBox -> MouseManipulator)
-> LBox -> BoxHandleType -> MouseManipulator
forall a b c. (a -> b -> c) -> b -> a -> c
flip BoxHandleType -> LBox -> MouseManipulator
makeHandleBox (NonEmpty LBox -> LBox
union_lBoxes (LBox
xLBox -> [LBox] -> NonEmpty LBox
forall a. a -> [a] -> NonEmpty a
:|[LBox]
xs))) [BoxHandleType
BH_TL .. BoxHandleType
BH_A]
findFirstMouseManipulator :: OwlPFState -> RelMouseDrag -> CanvasSelection -> Maybe ManipulatorIndex
findFirstMouseManipulator :: OwlPFState -> RelMouseDrag -> CanvasSelection -> Maybe Int
findFirstMouseManipulator OwlPFState
pfs (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
..}) CanvasSelection
selection = Maybe Int
r where
mms :: MouseManipulatorSet
mms = OwlPFState -> CanvasSelection -> MouseManipulatorSet
toMouseManipulators OwlPFState
pfs CanvasSelection
selection
smt :: SelectionManipulatorType
smt = CanvasSelection -> SelectionManipulatorType
computeSelectionType CanvasSelection
selection
normalSel :: Maybe Int
normalSel = (MouseManipulator -> Bool) -> MouseManipulatorSet -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex (\MouseManipulator
mm -> LBox -> XY -> Bool
does_lBox_contains_XY (MouseManipulator -> LBox
_mouseManipulator_box MouseManipulator
mm) XY
_mouseDrag_from) MouseManipulatorSet
mms
r :: Maybe Int
r = case SelectionManipulatorType
smt of
SelectionManipulatorType
SMTTextArea -> Maybe Int
normalSel
SelectionManipulatorType
_ -> Maybe Int
normalSel
data BoxHandleType = BH_TL | BH_TR | BH_BL | BH_BR | BH_A | BH_T | BH_B | BH_L | BH_R deriving (Int -> BoxHandleType -> ShowS
[BoxHandleType] -> ShowS
BoxHandleType -> String
(Int -> BoxHandleType -> ShowS)
-> (BoxHandleType -> String)
-> ([BoxHandleType] -> ShowS)
-> Show BoxHandleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoxHandleType -> ShowS
showsPrec :: Int -> BoxHandleType -> ShowS
$cshow :: BoxHandleType -> String
show :: BoxHandleType -> String
$cshowList :: [BoxHandleType] -> ShowS
showList :: [BoxHandleType] -> ShowS
Show, BoxHandleType -> BoxHandleType -> Bool
(BoxHandleType -> BoxHandleType -> Bool)
-> (BoxHandleType -> BoxHandleType -> Bool) -> Eq BoxHandleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoxHandleType -> BoxHandleType -> Bool
== :: BoxHandleType -> BoxHandleType -> Bool
$c/= :: BoxHandleType -> BoxHandleType -> Bool
/= :: BoxHandleType -> BoxHandleType -> Bool
Eq, Int -> BoxHandleType
BoxHandleType -> Int
BoxHandleType -> [BoxHandleType]
BoxHandleType -> BoxHandleType
BoxHandleType -> BoxHandleType -> [BoxHandleType]
BoxHandleType -> BoxHandleType -> BoxHandleType -> [BoxHandleType]
(BoxHandleType -> BoxHandleType)
-> (BoxHandleType -> BoxHandleType)
-> (Int -> BoxHandleType)
-> (BoxHandleType -> Int)
-> (BoxHandleType -> [BoxHandleType])
-> (BoxHandleType -> BoxHandleType -> [BoxHandleType])
-> (BoxHandleType -> BoxHandleType -> [BoxHandleType])
-> (BoxHandleType
-> BoxHandleType -> BoxHandleType -> [BoxHandleType])
-> Enum BoxHandleType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BoxHandleType -> BoxHandleType
succ :: BoxHandleType -> BoxHandleType
$cpred :: BoxHandleType -> BoxHandleType
pred :: BoxHandleType -> BoxHandleType
$ctoEnum :: Int -> BoxHandleType
toEnum :: Int -> BoxHandleType
$cfromEnum :: BoxHandleType -> Int
fromEnum :: BoxHandleType -> Int
$cenumFrom :: BoxHandleType -> [BoxHandleType]
enumFrom :: BoxHandleType -> [BoxHandleType]
$cenumFromThen :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFromThen :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
$cenumFromTo :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFromTo :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
$cenumFromThenTo :: BoxHandleType -> BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFromThenTo :: BoxHandleType -> BoxHandleType -> BoxHandleType -> [BoxHandleType]
Enum)
makeHandleBox ::
BoxHandleType
-> LBox
-> MouseManipulator
makeHandleBox :: BoxHandleType -> LBox -> MouseManipulator
makeHandleBox BoxHandleType
bht (LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) = case BoxHandleType
bht of
BoxHandleType
BH_BR -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Corner
BoxHandleType
BH_TL -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Corner
BoxHandleType
BH_TR -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Corner
BoxHandleType
BH_BL -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Corner
BoxHandleType
BH_A -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Area
BoxHandleType
_ -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Side
where
(Int
px, Int
py) = (Int
0,Int
0)
CanonicalLBox Bool
_ Bool
_ LBox
clbox = LBox -> CanonicalLBox
canonicalLBox_from_lBox (LBox -> CanonicalLBox) -> LBox -> CanonicalLBox
forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
px) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
py)) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
w Int
h)
nudgex :: Int
nudgex = if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
1 else Int
0
nudgey :: Int
nudgey = if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
1 else Int
0
l :: Int
l = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nudgex
t :: Int
t = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pyInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nudgey
r :: Int
r = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nudgex
b :: Int
b = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pyInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nudgey
box :: LBox
box = case BoxHandleType
bht of
BoxHandleType
BH_BR -> XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
r Int
b) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
BoxHandleType
BH_TL -> XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
l Int
t) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
BoxHandleType
BH_TR -> XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
r Int
t) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
BoxHandleType
BH_BL -> XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
l Int
b) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
BoxHandleType
BH_A -> LBox
clbox
BoxHandleType
_ -> Text -> LBox
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"not supported yet"
makeDeltaBox :: BoxHandleType -> XY -> DeltaLBox
makeDeltaBox :: BoxHandleType -> XY -> DeltaLBox
makeDeltaBox BoxHandleType
bht (V2 Int
dx Int
dy) = case BoxHandleType
bht of
BoxHandleType
BH_BR -> XY -> XY -> DeltaLBox
DeltaLBox XY
0 (XY -> DeltaLBox) -> XY -> DeltaLBox
forall a b. (a -> b) -> a -> b
$ Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
dy
BoxHandleType
BH_TL -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
dy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (-Int
dx) (-Int
dy))
BoxHandleType
BH_TR -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
dy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx (-Int
dy))
BoxHandleType
BH_BL -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
0) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (-Int
dx) Int
dy)
BoxHandleType
BH_T -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
dy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 (-Int
dy))
BoxHandleType
BH_B -> XY -> XY -> DeltaLBox
DeltaLBox XY
0 (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
dy)
BoxHandleType
BH_L -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
0) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (-Int
dx) Int
0)
BoxHandleType
BH_R -> XY -> XY -> DeltaLBox
DeltaLBox XY
0 (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
0)
BoxHandleType
BH_A -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
dy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
0)
data BoxCreationType = BoxCreationType_None | BoxCreationType_Box | BoxCreationType_Text | BoxCreationType_TextArea | BoxCreationType_DragSelect deriving (Int -> BoxCreationType -> ShowS
[BoxCreationType] -> ShowS
BoxCreationType -> String
(Int -> BoxCreationType -> ShowS)
-> (BoxCreationType -> String)
-> ([BoxCreationType] -> ShowS)
-> Show BoxCreationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoxCreationType -> ShowS
showsPrec :: Int -> BoxCreationType -> ShowS
$cshow :: BoxCreationType -> String
show :: BoxCreationType -> String
$cshowList :: [BoxCreationType] -> ShowS
showList :: [BoxCreationType] -> ShowS
Show, BoxCreationType -> BoxCreationType -> Bool
(BoxCreationType -> BoxCreationType -> Bool)
-> (BoxCreationType -> BoxCreationType -> Bool)
-> Eq BoxCreationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoxCreationType -> BoxCreationType -> Bool
== :: BoxCreationType -> BoxCreationType -> Bool
$c/= :: BoxCreationType -> BoxCreationType -> Bool
/= :: BoxCreationType -> BoxCreationType -> Bool
Eq)
boxCreationType_isCreation :: BoxCreationType -> Bool
boxCreationType_isCreation :: BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
bct = BoxCreationType
bct BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
/= BoxCreationType
BoxCreationType_None Bool -> Bool -> Bool
&& BoxCreationType
bct BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
/= BoxCreationType
BoxCreationType_DragSelect
data BoxHandler = BoxHandler {
BoxHandler -> BoxHandleType
_boxHandler_handle :: BoxHandleType
, BoxHandler -> Bool
_boxHandler_undoFirst :: Bool
, BoxHandler -> BoxCreationType
_boxHandler_creation :: BoxCreationType
, BoxHandler -> Bool
_boxHandler_active :: Bool
, BoxHandler -> Bool
_boxHandler_downOnLabel :: Bool
, BoxHandler -> Maybe DeltaLBox
_boxHandler_prevDeltaLBox :: Maybe DeltaLBox
} deriving (Int -> BoxHandler -> ShowS
[BoxHandler] -> ShowS
BoxHandler -> String
(Int -> BoxHandler -> ShowS)
-> (BoxHandler -> String)
-> ([BoxHandler] -> ShowS)
-> Show BoxHandler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoxHandler -> ShowS
showsPrec :: Int -> BoxHandler -> ShowS
$cshow :: BoxHandler -> String
show :: BoxHandler -> String
$cshowList :: [BoxHandler] -> ShowS
showList :: [BoxHandler] -> ShowS
Show)
makeDragDeltaBox :: BoxHandleType -> RelMouseDrag -> DeltaLBox
makeDragDeltaBox :: BoxHandleType -> RelMouseDrag -> DeltaLBox
makeDragDeltaBox BoxHandleType
bht RelMouseDrag
rmd = DeltaLBox
r where
RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..} = RelMouseDrag
rmd
dragDelta :: XY
dragDelta = XY
_mouseDrag_to XY -> XY -> XY
forall a. Num a => a -> a -> a
- XY
_mouseDrag_from
shiftClick :: Bool
shiftClick = KeyModifier -> [KeyModifier] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers
boxRestrictedDelta :: XY
boxRestrictedDelta = if Bool
shiftClick
then XY -> XY
restrict8 XY
dragDelta
else XY
dragDelta
r :: DeltaLBox
r = BoxHandleType -> XY -> DeltaLBox
makeDeltaBox BoxHandleType
bht XY
boxRestrictedDelta
constrainDeltaLBox :: Int -> DeltaLBox -> LBox -> DeltaLBox
constrainDeltaLBox :: Int -> DeltaLBox -> LBox -> DeltaLBox
constrainDeltaLBox Int
minsize d1 :: DeltaLBox
d1@(DeltaLBox (V2 Int
dx Int
dy) (V2 Int
dw Int
dh)) d2 :: LBox
d2@((LBox (V2 Int
x Int
y) (V2 Int
w Int
h))) = DeltaLBox
r where
optuple :: b -> (b, b)
optuple b
e = (b
e, -b
e)
(Int
ndx, Int
ndw) = if Int
dx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
then Int -> (Int, Int)
forall {b}. Num b => b -> (b, b)
optuple (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
minsize) Int
dx)
else (Int
dx, (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minsize (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dw)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)
(Int
ndy, Int
ndh) = if Int
dy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
then Int -> (Int, Int)
forall {b}. Num b => b -> (b, b)
optuple (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
minsize) Int
dy)
else (Int
dy, (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minsize (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dh)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h)
istranslateonly :: Bool
istranslateonly = Int
dw Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
dh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
r :: DeltaLBox
r = if Bool
istranslateonly
then DeltaLBox
d1
else XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
ndx Int
ndy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
ndw Int
ndh)
makeDragOperationNew :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperationNew :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperationNew PotatoHandlerInput
phi DeltaLBox
dbox = Maybe Llama
op where
selection :: Seq SuperOwl
selection = PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi
selectionl :: [SuperOwl]
selectionl = Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> [SuperOwl]
forall a b. (a -> b) -> a -> b
$ PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi
pfs :: OwlPFState
pfs = PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_pFState PotatoHandlerInput
phi
lboxes :: [LBox]
lboxes = (SuperOwl -> LBox) -> [SuperOwl] -> [LBox]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_box (OwlSubItem -> SEltDrawer
getDrawer (OwlSubItem -> SEltDrawer)
-> (SuperOwl -> OwlSubItem) -> SuperOwl -> SEltDrawer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlSubItem
forall o. HasOwlItem o => o -> OwlSubItem
hasOwlItem_toOwlSubItem (SuperOwl -> SEltDrawer) -> SuperOwl -> SEltDrawer
forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) OwlPFState
pfs) [SuperOwl]
selectionl
constraineddbox :: DeltaLBox
constraineddbox = (DeltaLBox -> LBox -> DeltaLBox)
-> DeltaLBox -> [LBox] -> DeltaLBox
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int -> DeltaLBox -> LBox -> DeltaLBox
constrainDeltaLBox Int
1) DeltaLBox
dbox [LBox]
lboxes
fmapfn :: SuperOwl -> Llama
fmapfn SuperOwl
sowl = (Int, SElt) -> Llama
makeSetLlama (Int
rid, SElt
newselt) where
rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
oldselt :: SElt
oldselt = SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl
newselt :: SElt
newselt = Bool -> SElt -> CBoundingBox -> SElt
modify_sElt_with_cBoundingBox Bool
True SElt
oldselt (DeltaLBox -> CBoundingBox
CBoundingBox DeltaLBox
constraineddbox)
op :: Maybe Llama
op = if Seq SuperOwl -> Bool
forall a. Seq a -> Bool
Seq.null Seq SuperOwl
selection
then Maybe Llama
forall a. Maybe a
Nothing
else Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ [Llama] -> Llama
makeCompositionLlama ([Llama] -> Llama) -> ([Llama] -> [Llama]) -> [Llama] -> Llama
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Llama] -> [Llama]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Llama] -> Llama) -> [Llama] -> Llama
forall a b. (a -> b) -> a -> b
$ ((SuperOwl -> Llama) -> [SuperOwl] -> [Llama]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Llama
fmapfn [SuperOwl]
selectionl)
makeDragOperation :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperation :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperation PotatoHandlerInput
phi DeltaLBox
dbox = Maybe Llama
op where
selection :: Seq SuperOwl
selection = PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi
selectionl :: [SuperOwl]
selectionl = Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> [SuperOwl]
forall a b. (a -> b) -> a -> b
$ PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi
pfs :: OwlPFState
pfs = PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_pFState PotatoHandlerInput
phi
lboxes :: [LBox]
lboxes = (SuperOwl -> LBox) -> [SuperOwl] -> [LBox]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_box (OwlSubItem -> SEltDrawer
getDrawer (OwlSubItem -> SEltDrawer)
-> (SuperOwl -> OwlSubItem) -> SuperOwl -> SEltDrawer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlSubItem
forall o. HasOwlItem o => o -> OwlSubItem
hasOwlItem_toOwlSubItem (SuperOwl -> SEltDrawer) -> SuperOwl -> SEltDrawer
forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) OwlPFState
pfs) [SuperOwl]
selectionl
constraineddbox :: DeltaLBox
constraineddbox = (DeltaLBox -> LBox -> DeltaLBox)
-> DeltaLBox -> [LBox] -> DeltaLBox
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int -> DeltaLBox -> LBox -> DeltaLBox
constrainDeltaLBox Int
0) DeltaLBox
dbox [LBox]
lboxes
makeController :: SuperOwl -> DSum CTag Identity
makeController SuperOwl
_ = DSum CTag Identity
cmd where
cmd :: DSum CTag Identity
cmd = CTag CBoundingBox
CTagBoundingBox CTag CBoundingBox -> Identity CBoundingBox -> DSum CTag Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> (CBoundingBox -> Identity CBoundingBox
forall a. a -> Identity a
Identity (CBoundingBox -> Identity CBoundingBox)
-> CBoundingBox -> Identity CBoundingBox
forall a b. (a -> b) -> a -> b
$ CBoundingBox {
_cBoundingBox_deltaBox :: DeltaLBox
_cBoundingBox_deltaBox = DeltaLBox
dbox
})
op :: Maybe Llama
op = if Seq SuperOwl -> Bool
forall a. Seq a -> Bool
Seq.null Seq SuperOwl
selection
then Maybe Llama
forall a. Maybe a
Nothing
else Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ OwlPFCmd -> Llama
makePFCLlama (OwlPFCmd -> Llama)
-> (ControllersWithId -> OwlPFCmd) -> ControllersWithId -> Llama
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> OwlPFCmd
OwlPFCManipulate (ControllersWithId -> Llama) -> ControllersWithId -> Llama
forall a b. (a -> b) -> a -> b
$ [(Int, DSum CTag Identity)] -> ControllersWithId
forall a. [(Int, a)] -> IntMap a
IM.fromList ((SuperOwl -> (Int, DSum CTag Identity))
-> [SuperOwl] -> [(Int, DSum CTag Identity)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
s -> (SuperOwl -> Int
_superOwl_id SuperOwl
s, SuperOwl -> DSum CTag Identity
makeController SuperOwl
s)) [SuperOwl]
selectionl)
instance Default BoxHandler where
def :: BoxHandler
def = BoxHandler {
_boxHandler_handle :: BoxHandleType
_boxHandler_handle = BoxHandleType
BH_BR
, _boxHandler_undoFirst :: Bool
_boxHandler_undoFirst = Bool
False
, _boxHandler_creation :: BoxCreationType
_boxHandler_creation = BoxCreationType
BoxCreationType_None
, _boxHandler_active :: Bool
_boxHandler_active = Bool
False
, _boxHandler_downOnLabel :: Bool
_boxHandler_downOnLabel = Bool
False
, _boxHandler_prevDeltaLBox :: Maybe DeltaLBox
_boxHandler_prevDeltaLBox = Maybe DeltaLBox
forall a. Maybe a
Nothing
}
selectionOnlySBox :: CanvasSelection -> Maybe SBox
selectionOnlySBox :: CanvasSelection -> Maybe SBox
selectionOnlySBox (CanvasSelection Seq SuperOwl
selection) = if Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then case SuperOwl -> SElt
superOwl_toSElt_hack (Seq SuperOwl -> Int -> SuperOwl
forall a. Seq a -> Int -> a
Seq.index Seq SuperOwl
selection Int
0) of
SEltBox SBox
sbox -> SBox -> Maybe SBox
forall a. a -> Maybe a
Just SBox
sbox
SElt
_ -> Maybe SBox
forall a. Maybe a
Nothing
else Maybe SBox
forall a. Maybe a
Nothing
isMouseOnSelectionSBoxBorder :: CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder :: CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder CanvasSelection
cs (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = case CanvasSelection -> Maybe SBox
selectionOnlySBox CanvasSelection
cs of
Maybe SBox
Nothing -> Bool
False
Just SBox
sbox -> if SBoxType -> Bool
sBoxType_hasBorder (SBox -> SBoxType
_sBox_boxType SBox
sbox) Bool -> Bool -> Bool
&& LBox -> XY -> Bool
does_lBox_contains_XY (LBox -> LBox
lBox_to_boxLabelBox (SBox -> LBox
_sBox_box SBox
sbox)) XY
_mouseDrag_from
then Bool
True
else Bool
False
minusDeltaLBox :: DeltaLBox -> DeltaLBox -> DeltaLBox
minusDeltaLBox :: DeltaLBox -> DeltaLBox -> DeltaLBox
minusDeltaLBox (DeltaLBox (V2 Int
dx1 Int
dy1) (V2 Int
dw1 Int
dh1)) (DeltaLBox (V2 Int
dx2 Int
dy2) (V2 Int
dw2 Int
dh2)) = XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
dx1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dx2) (Int
dy1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dy2)) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
dw1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dw2) (Int
dh1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dh2))
instance PotatoHandler BoxHandler where
pHandlerName :: BoxHandler -> Text
pHandlerName BoxHandler
_ = Text
handlerName_box
pHandleMouse :: BoxHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse bh :: BoxHandler
bh@BoxHandler {Bool
Maybe DeltaLBox
BoxCreationType
BoxHandleType
_boxHandler_handle :: BoxHandler -> BoxHandleType
_boxHandler_undoFirst :: BoxHandler -> Bool
_boxHandler_creation :: BoxHandler -> BoxCreationType
_boxHandler_active :: BoxHandler -> Bool
_boxHandler_downOnLabel :: BoxHandler -> Bool
_boxHandler_prevDeltaLBox :: BoxHandler -> Maybe DeltaLBox
_boxHandler_handle :: BoxHandleType
_boxHandler_undoFirst :: Bool
_boxHandler_creation :: BoxCreationType
_boxHandler_active :: Bool
_boxHandler_downOnLabel :: Bool
_boxHandler_prevDeltaLBox :: Maybe DeltaLBox
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down | BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
_boxHandler_creation -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler bh { _boxHandler_active = True }
}
MouseDragState
MouseDragState_Down | KeyModifier -> [KeyModifier] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
MouseDragState
MouseDragState_Down | BoxCreationType
_boxHandler_creation BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_DragSelect -> Bool -> Maybe PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> (Selection -> Bool) -> Selection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Bool
forall a. IsParliament a => a -> Bool
isParliament_null (Selection -> Bool) -> Selection -> Bool
forall a b. (a -> b) -> a -> b
$ Selection
_potatoHandlerInput_selection) Maybe PotatoHandlerOutput
r where
newbh :: BoxHandler
newbh = BoxHandler
bh {
_boxHandler_handle = BH_A
, _boxHandler_active = True
}
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh }
MouseDragState
MouseDragState_Down -> case OwlPFState -> RelMouseDrag -> CanvasSelection -> Maybe Int
findFirstMouseManipulator OwlPFState
_potatoHandlerInput_pFState RelMouseDrag
rmd CanvasSelection
_potatoHandlerInput_canvasSelection of
Maybe Int
Nothing -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
Just Int
mi -> Maybe PotatoHandlerOutput
r where
newbh :: BoxHandler
newbh = BoxHandler
bh {
_boxHandler_handle = bht
, _boxHandler_active = True
, _boxHandler_downOnLabel = if bht == BH_A then isMouseOnSelectionSBoxBorder _potatoHandlerInput_canvasSelection rmd else False
}
bht :: BoxHandleType
bht = Int -> BoxHandleType
forall a. Enum a => Int -> a
toEnum Int
mi
clickOnSelection :: Bool
clickOnSelection = (SuperOwl -> Bool) -> Seq SuperOwl -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (XY -> SElt -> Bool
doesSEltIntersectPoint XY
_mouseDrag_to (SElt -> Bool) -> (SuperOwl -> SElt) -> SuperOwl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SElt
superOwl_toSElt_hack) (Seq SuperOwl -> Bool) -> Seq SuperOwl -> Bool
forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection
r :: Maybe PotatoHandlerOutput
r = if BoxHandleType
bht BoxHandleType -> BoxHandleType -> Bool
forall a. Eq a => a -> a -> Bool
/= BoxHandleType
BH_A Bool -> Bool -> Bool
|| Bool
clickOnSelection
then PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh }
else Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
MouseDragState
MouseDragState_Dragging -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
dragDelta :: XY
dragDelta = XY
_mouseDrag_to XY -> XY -> XY
forall a. Num a => a -> a -> a
- XY
_mouseDrag_from
newEltPos :: OwlSpot
newEltPos = OwlTree -> Selection -> OwlSpot
lastPositionInSelection (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
_potatoHandlerInput_pFState) Selection
_potatoHandlerInput_selection
boxToAdd :: SBox
boxToAdd = SBox
forall a. Default a => a
def {
_sBox_box = canonicalLBox_from_lBox_ $ LBox _mouseDrag_from dragDelta
, _sBox_boxType = if _boxHandler_creation == BoxCreationType_Text
then SBoxType_BoxText
else SBoxType_Box
, _sBox_superStyle = _potatoDefaultParameters_superStyle _potatoHandlerInput_potatoDefaultParameters
, _sBox_title = def { _sBoxTitle_align = _potatoDefaultParameters_box_label_textAlign _potatoHandlerInput_potatoDefaultParameters }
, _sBox_text = def { _sBoxText_style = def { _textStyle_alignment = _potatoDefaultParameters_box_text_textAlign _potatoHandlerInput_potatoDefaultParameters } }
}
textAreaToAdd :: STextArea
textAreaToAdd = STextArea
forall a. Default a => a
def {
_sTextArea_box = canonicalLBox_from_lBox_ $ LBox _mouseDrag_from dragDelta
, _sTextArea_text = Map.empty
, _sTextArea_transparent = True
}
nameToAdd :: Text
nameToAdd = case BoxCreationType
_boxHandler_creation of
BoxCreationType
BoxCreationType_Box -> Text
"<box>"
BoxCreationType
BoxCreationType_Text -> Text
"<text>"
BoxCreationType
BoxCreationType_TextArea -> Text
"<textarea>"
BoxCreationType
_ -> Text -> Text
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"invalid BoxCreationType"
mdd :: DeltaLBox
mdd = BoxHandleType -> RelMouseDrag -> DeltaLBox
makeDragDeltaBox BoxHandleType
_boxHandler_handle RelMouseDrag
rmd
mop :: Maybe Llama
mop = case BoxCreationType
_boxHandler_creation of
BoxCreationType
x | BoxCreationType
x BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_Box Bool -> Bool -> Bool
|| BoxCreationType
x BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_Text -> Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ OwlPFState -> OwlSpot -> OwlItem -> Llama
makeAddEltLlama OwlPFState
_potatoHandlerInput_pFState OwlSpot
newEltPos (OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
nameToAdd) (SBox -> OwlSubItem
OwlSubItemBox SBox
boxToAdd))
BoxCreationType
BoxCreationType_TextArea -> Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ OwlPFState -> OwlSpot -> OwlItem -> Llama
makeAddEltLlama OwlPFState
_potatoHandlerInput_pFState OwlSpot
newEltPos (OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
nameToAdd) (STextArea -> OwlSubItem
OwlSubItemTextArea STextArea
textAreaToAdd))
BoxCreationType
_ -> PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperationNew PotatoHandlerInput
phi (DeltaLBox -> DeltaLBox -> DeltaLBox
minusDeltaLBox DeltaLBox
mdd (DeltaLBox -> Maybe DeltaLBox -> DeltaLBox
forall a. a -> Maybe a -> a
fromMaybe (XY -> XY -> DeltaLBox
DeltaLBox XY
0 XY
0) Maybe DeltaLBox
_boxHandler_prevDeltaLBox))
newbh :: BoxHandler
newbh = BoxHandler
bh {
_boxHandler_undoFirst = True
, _boxHandler_downOnLabel = False
, _boxHandler_prevDeltaLBox = Just mdd
}
r :: PotatoHandlerOutput
r = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh
, _potatoHandlerOutput_action = case mop of
Maybe Llama
Nothing -> HandlerOutputAction
HOA_Nothing
Just Llama
op -> Preview -> HandlerOutputAction
HOA_Preview (Preview -> HandlerOutputAction) -> Preview -> HandlerOutputAction
forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview (Bool -> PreviewOperation
previewOperation_fromUndoFirst Bool
_boxHandler_undoFirst) Llama
op
}
MouseDragState
MouseDragState_Up | Bool
_boxHandler_downOnLabel -> if CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd
then BoxLabelHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> BoxLabelHandler
makeBoxLabelHandler (BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler
forall a. Default a => a
def :: BoxHandler)) CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd) PotatoHandlerInput
phi RelMouseDrag
rmd
else Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
MouseDragState
MouseDragState_Up -> Maybe PotatoHandlerOutput
r where
nselected :: Int
nselected = Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
selt :: Maybe SElt
selt = SuperOwl -> SElt
superOwl_toSElt_hack (SuperOwl -> SElt) -> Maybe SuperOwl -> Maybe SElt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => CanvasSelection -> Maybe SuperOwl
CanvasSelection -> Maybe SuperOwl
selectionToMaybeFirstSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
isBox :: Bool
isBox = Int
nselected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& case Maybe SElt
selt of
Just (SEltBox SBox
_) -> Bool
True
Maybe SElt
_ -> Bool
False
isText :: Bool
isText = Int
nselected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& case Maybe SElt
selt of
Just (SEltBox SBox{LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: SBox -> LBox
_sBox_superStyle :: SBox -> SuperStyle
_sBox_title :: SBox -> SBoxTitle
_sBox_text :: SBox -> SBoxText
_sBox_box :: LBox
_sBox_superStyle :: SuperStyle
_sBox_title :: SBoxTitle
_sBox_text :: SBoxText
_sBox_boxType :: SBoxType
..}) -> SBoxType -> Bool
sBoxType_isText SBoxType
_sBox_boxType
Maybe SElt
_ -> Bool
False
isTextArea :: Bool
isTextArea = Int
nselected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& case Maybe SElt
selt of
Just (SEltTextArea STextArea
_) -> Bool
True
Maybe SElt
_ -> Bool
False
wasNotDragSelecting :: Bool
wasNotDragSelecting = Bool -> Bool
not (BoxCreationType
_boxHandler_creation BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_DragSelect)
wasNotActuallyDragging :: Bool
wasNotActuallyDragging = Bool -> Bool
not Bool
_boxHandler_undoFirst
isCreation :: Bool
isCreation = BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
_boxHandler_creation
r :: Maybe PotatoHandlerOutput
r = if (Bool
isText Bool -> Bool -> Bool
|| (Bool
isBox Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isCreation))
Bool -> Bool -> Bool
&& (Bool
wasNotActuallyDragging Bool -> Bool -> Bool
|| Bool
isCreation)
Bool -> Bool -> Bool
&& Bool
wasNotDragSelecting
then BoxTextHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (Bool
-> SomePotatoHandler
-> CanvasSelection
-> RelMouseDrag
-> BoxTextHandler
makeBoxTextHandler Bool
isCreation (BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler
forall a. Default a => a
def :: BoxHandler)) CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd) PotatoHandlerInput
phi RelMouseDrag
rmd
else if Bool
isTextArea
Bool -> Bool -> Bool
&& (Bool
wasNotActuallyDragging Bool -> Bool -> Bool
|| Bool
isCreation)
Bool -> Bool -> Bool
&& Bool
wasNotDragSelecting
then TextAreaHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
textAreaHandler_pHandleMouse_onCreation (SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> Bool -> TextAreaHandler
makeTextAreaHandler (BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler
forall a. Default a => a
def :: BoxHandler)) CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd Bool
isCreation) PotatoHandlerInput
phi RelMouseDrag
rmd
else PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_action = HOA_Preview Preview_MaybeCommit
}
MouseDragState
MouseDragState_Cancelled -> if Bool
_boxHandler_undoFirst
then PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_action = HOA_Preview Preview_Cancel
}
else PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def
pHandleKeyboard :: BoxHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard BoxHandler
bh phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} (KeyboardData KeyboardKey
key [KeyModifier]
_) = Maybe PotatoHandlerOutput
r where
todlbox :: (Int, Int) -> Maybe DeltaLBox
todlbox (Int
x,Int
y) = DeltaLBox -> Maybe DeltaLBox
forall a. a -> Maybe a
Just (DeltaLBox -> Maybe DeltaLBox) -> DeltaLBox -> Maybe DeltaLBox
forall a b. (a -> b) -> a -> b
$ XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
y) XY
0
mmove :: Maybe DeltaLBox
mmove = case KeyboardKey
key of
KeyboardKey
KeyboardKey_Left -> (Int, Int) -> Maybe DeltaLBox
todlbox (-Int
1,Int
0)
KeyboardKey
KeyboardKey_Right -> (Int, Int) -> Maybe DeltaLBox
todlbox (Int
1,Int
0)
KeyboardKey
KeyboardKey_Up -> (Int, Int) -> Maybe DeltaLBox
todlbox (Int
0,-Int
1)
KeyboardKey
KeyboardKey_Down -> (Int, Int) -> Maybe DeltaLBox
todlbox (Int
0,Int
1)
KeyboardKey
_ -> Maybe DeltaLBox
forall a. Maybe a
Nothing
r :: Maybe PotatoHandlerOutput
r = if BoxHandler -> Bool
_boxHandler_active BoxHandler
bh
then Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
else case Maybe DeltaLBox
mmove of
Maybe DeltaLBox
Nothing -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
Just DeltaLBox
move -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r2 where
mop :: Maybe Llama
mop = PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperationNew PotatoHandlerInput
phi DeltaLBox
move
r2 :: PotatoHandlerOutput
r2 = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler bh
, _potatoHandlerOutput_action = case mop of
Maybe Llama
Nothing -> HandlerOutputAction
HOA_Nothing
Just Llama
op -> Preview -> HandlerOutputAction
HOA_Preview (Preview -> HandlerOutputAction) -> Preview -> HandlerOutputAction
forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview PreviewOperation
PO_StartAndCommit Llama
op
}
pRenderHandler :: BoxHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler BoxHandler {Bool
Maybe DeltaLBox
BoxCreationType
BoxHandleType
_boxHandler_handle :: BoxHandler -> BoxHandleType
_boxHandler_undoFirst :: BoxHandler -> Bool
_boxHandler_creation :: BoxHandler -> BoxCreationType
_boxHandler_active :: BoxHandler -> Bool
_boxHandler_downOnLabel :: BoxHandler -> Bool
_boxHandler_prevDeltaLBox :: BoxHandler -> Maybe DeltaLBox
_boxHandler_handle :: BoxHandleType
_boxHandler_undoFirst :: Bool
_boxHandler_creation :: BoxCreationType
_boxHandler_active :: Bool
_boxHandler_downOnLabel :: Bool
_boxHandler_prevDeltaLBox :: Maybe DeltaLBox
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = HandlerRenderOutput
r where
handlePoints :: [LBox]
handlePoints = (MouseManipulator -> LBox) -> MouseManipulatorSet -> [LBox]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MouseManipulator -> LBox
_mouseManipulator_box (MouseManipulatorSet -> [LBox])
-> (MouseManipulatorSet -> MouseManipulatorSet)
-> MouseManipulatorSet
-> [LBox]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MouseManipulator -> Bool)
-> MouseManipulatorSet -> MouseManipulatorSet
forall a. (a -> Bool) -> [a] -> [a]
filter (\MouseManipulator
mm -> MouseManipulator -> MouseManipulatorType
_mouseManipulator_type MouseManipulator
mm MouseManipulatorType -> MouseManipulatorType -> Bool
forall a. Eq a => a -> a -> Bool
== MouseManipulatorType
MouseManipulatorType_Corner) (MouseManipulatorSet -> [LBox]) -> MouseManipulatorSet -> [LBox]
forall a b. (a -> b) -> a -> b
$ OwlPFState -> CanvasSelection -> MouseManipulatorSet
toMouseManipulators OwlPFState
_potatoHandlerInput_pFState CanvasSelection
_potatoHandlerInput_canvasSelection
r :: HandlerRenderOutput
r = if Bool -> Bool
not Bool
_boxHandler_active Bool -> Bool -> Bool
&& BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
_boxHandler_creation
then HandlerRenderOutput
emptyHandlerRenderOutput
else [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ((LBox -> RenderHandle) -> [LBox] -> [RenderHandle]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LBox -> RenderHandle
defaultRenderHandle [LBox]
handlePoints)
pIsHandlerActive :: BoxHandler -> HandlerActiveState
pIsHandlerActive BoxHandler
bh = if BoxHandler -> Bool
_boxHandler_active BoxHandler
bh then HandlerActiveState
HAS_Active_Mouse else HandlerActiveState
HAS_Inactive
pHandlerTool :: BoxHandler -> Maybe Tool
pHandlerTool BoxHandler {Bool
Maybe DeltaLBox
BoxCreationType
BoxHandleType
_boxHandler_handle :: BoxHandler -> BoxHandleType
_boxHandler_undoFirst :: BoxHandler -> Bool
_boxHandler_creation :: BoxHandler -> BoxCreationType
_boxHandler_active :: BoxHandler -> Bool
_boxHandler_downOnLabel :: BoxHandler -> Bool
_boxHandler_prevDeltaLBox :: BoxHandler -> Maybe DeltaLBox
_boxHandler_handle :: BoxHandleType
_boxHandler_undoFirst :: Bool
_boxHandler_creation :: BoxCreationType
_boxHandler_active :: Bool
_boxHandler_downOnLabel :: Bool
_boxHandler_prevDeltaLBox :: Maybe DeltaLBox
..} = case BoxCreationType
_boxHandler_creation of
BoxCreationType
BoxCreationType_Box -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Box
BoxCreationType
BoxCreationType_Text -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Text
BoxCreationType
BoxCreationType_TextArea -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_TextArea
BoxCreationType
_ -> Maybe Tool
forall a. Maybe a
Nothing