{-# LANGUAGE RecordWildCards #-}
module Potato.Flow.Controller.Manipulator.Layers (
LayersHandler(..)
) where
import Relude
import Potato.Flow.Controller.Handler
import Potato.Flow.Controller.Input
import Potato.Flow.Controller.OwlLayers
import Potato.Flow.OwlItem
import Potato.Flow.Owl
import Potato.Flow.Controller.Types
import Potato.Flow.Math
import Potato.Flow.Types
import Potato.Flow.SElts
import Potato.Flow.OwlItem
import Potato.Flow.OwlWorkspace
import Potato.Flow.OwlState
import Potato.Flow.Llama
import Data.Dependent.Sum (DSum ((:=>)))
import Data.Default
import qualified Data.IntMap as IM
import qualified Data.Sequence as Seq
import Data.Sequence ((<|))
import qualified Potato.Data.Text.Zipper as TZ
import qualified Data.Text as T
import Data.Char
data LayerDragState = LDS_None | LDS_Dragging | LDS_Selecting LayerEntryPos deriving (Int -> LayerDragState -> ShowS
[LayerDragState] -> ShowS
LayerDragState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerDragState] -> ShowS
$cshowList :: [LayerDragState] -> ShowS
show :: LayerDragState -> String
$cshow :: LayerDragState -> String
showsPrec :: Int -> LayerDragState -> ShowS
$cshowsPrec :: Int -> LayerDragState -> ShowS
Show, LayerDragState -> LayerDragState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerDragState -> LayerDragState -> Bool
$c/= :: LayerDragState -> LayerDragState -> Bool
== :: LayerDragState -> LayerDragState -> Bool
$c== :: LayerDragState -> LayerDragState -> Bool
Eq)
data LayerDownType = LDT_Hide | LDT_Lock | LDT_Collapse | LDT_Normal deriving (Int -> LayerDownType -> ShowS
[LayerDownType] -> ShowS
LayerDownType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayerDownType] -> ShowS
$cshowList :: [LayerDownType] -> ShowS
show :: LayerDownType -> String
$cshow :: LayerDownType -> String
showsPrec :: Int -> LayerDownType -> ShowS
$cshowsPrec :: Int -> LayerDownType -> ShowS
Show, LayerDownType -> LayerDownType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerDownType -> LayerDownType -> Bool
$c/= :: LayerDownType -> LayerDownType -> Bool
== :: LayerDownType -> LayerDownType -> Bool
$c== :: LayerDownType -> LayerDownType -> Bool
Eq)
layersHandlerRenderEntry_selected :: LayersHandlerRenderEntry -> Bool
layersHandlerRenderEntry_selected :: LayersHandlerRenderEntry -> Bool
layersHandlerRenderEntry_selected (LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
LHRESS_Selected LayersHandlerRenderEntryDots
_ LayersHandlerRenderEntryRenaming
_ LayerEntry
_) = Bool
True
layersHandlerRenderEntry_selected (LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
LHRESS_InheritSelected LayersHandlerRenderEntryDots
_ LayersHandlerRenderEntryRenaming
_ LayerEntry
_) = Bool
True
layersHandlerRenderEntry_selected LayersHandlerRenderEntry
_ = Bool
False
doesSelectionContainREltId_linear :: REltId -> Selection -> Bool
doesSelectionContainREltId_linear :: Int -> Selection -> Bool
doesSelectionContainREltId_linear Int
rid = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\SuperOwl
sowl -> Int
rid forall a. Eq a => a -> a -> Bool
== SuperOwl -> Int
_superOwl_id SuperOwl
sowl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Seq SuperOwl
unSuperOwlParliament
collapseOffset :: Int
collapseOffset :: Int
collapseOffset = Int
0
hideOffset :: Int
hideOffset :: Int
hideOffset = Int
1
lockOffset :: Int
lockOffset :: Int
lockOffset = Int
2
titleOffset :: Int
titleOffset :: Int
titleOffset = Int
3
clickLayerNew :: Seq LayerEntry -> XY -> Maybe (SuperOwl, LayerDownType, Int)
clickLayerNew :: Seq LayerEntry -> XY -> Maybe (SuperOwl, LayerDownType, Int)
clickLayerNew Seq LayerEntry
lentries (V2 Int
absx Int
lepos) = case forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
lepos Seq LayerEntry
lentries of
Maybe LayerEntry
Nothing -> forall a. Maybe a
Nothing
Just LayerEntry
le -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,,Int
absx forall a. Num a => a -> a -> a
- LayerEntry -> Int
layerEntry_depth LayerEntry
le) SuperOwl
sowl forall a b. (a -> b) -> a -> b
$ case () of
() | LayerEntry -> Bool
layerEntry_isFolder LayerEntry
le Bool -> Bool -> Bool
&& LayerEntry -> Int
layerEntry_depth LayerEntry
le forall a. Num a => a -> a -> a
+ Int
collapseOffset forall a. Eq a => a -> a -> Bool
== Int
absx -> LayerDownType
LDT_Collapse
() | LayerEntry -> Int
layerEntry_depth LayerEntry
le forall a. Num a => a -> a -> a
+ Int
hideOffset forall a. Eq a => a -> a -> Bool
== Int
absx -> LayerDownType
LDT_Hide
() | LayerEntry -> Int
layerEntry_depth LayerEntry
le forall a. Num a => a -> a -> a
+ Int
lockOffset forall a. Eq a => a -> a -> Bool
== Int
absx -> LayerDownType
LDT_Lock
() -> LayerDownType
LDT_Normal
where
sowl :: SuperOwl
sowl = LayerEntry -> SuperOwl
_layerEntry_superOwl LayerEntry
le
data LayersHandler = LayersHandler {
LayersHandler -> LayerDragState
_layersHandler_dragState :: LayerDragState
, LayersHandler -> XY
_layersHandler_cursorPos :: XY
, LayersHandler -> Maybe OwlSpot
_layersHandler_dropSpot :: Maybe OwlSpot
}
instance Default LayersHandler where
def :: LayersHandler
def = LayersHandler {
_layersHandler_dragState :: LayerDragState
_layersHandler_dragState = LayerDragState
LDS_None
, _layersHandler_cursorPos :: XY
_layersHandler_cursorPos = XY
0
, _layersHandler_dropSpot :: Maybe OwlSpot
_layersHandler_dropSpot = forall a. Maybe a
Nothing
}
handleScroll :: (PotatoHandler h) => h -> PotatoHandlerInput -> Int -> PotatoHandlerOutput
handleScroll :: forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Int -> PotatoHandlerOutput
handleScroll h
h 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
..} Int
scroll = PotatoHandlerOutput
r where
scrollPos :: Int
scrollPos = LayersState -> Int
_layersState_scrollPos LayersState
_potatoHandlerInput_layersState
maxentries :: Int
maxentries = Int
10 forall a. Num a => a -> a -> a
+ (forall a. Seq a -> Int
Seq.length forall a b. (a -> b) -> a -> b
$ LayersState -> Seq LayerEntry
_layersState_entries LayersState
_potatoHandlerInput_layersState)
newScrollPos :: Int
newScrollPos = forall a. Ord a => a -> a -> a
max Int
0 (forall a. Ord a => a -> a -> a
min Int
maxentries (Int
scrollPos forall a. Num a => a -> a -> a
+ Int
scroll))
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 h
h
, _potatoHandlerOutput_layersState :: Maybe LayersState
_potatoHandlerOutput_layersState = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LayersState
_potatoHandlerInput_layersState { _layersState_scrollPos :: Int
_layersState_scrollPos = Int
newScrollPos}
}
resetLayersHandler :: LayersHandler -> LayersHandler
resetLayersHandler :: LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh = LayersHandler
lh {
_layersHandler_dragState :: LayerDragState
_layersHandler_dragState = LayerDragState
LDS_None
, _layersHandler_dropSpot :: Maybe OwlSpot
_layersHandler_dropSpot = forall a. Maybe a
Nothing
}
isSpotValidToDrop :: OwlTree -> Selection -> OwlSpot -> Bool
isSpotValidToDrop :: OwlTree -> Selection -> OwlSpot -> Bool
isSpotValidToDrop OwlTree
ot Selection
sel OwlSpot
spot = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ OwlTree -> Int -> OwlParliamentSet -> Bool
owlParliamentSet_descendent OwlTree
ot (OwlSpot -> Int
_owlSpot_parent OwlSpot
spot) (Selection -> OwlParliamentSet
superOwlParliament_toOwlParliamentSet Selection
sel)
instance PotatoHandler LayersHandler where
pHandlerName :: LayersHandler -> Text
pHandlerName LayersHandler
_ = Text
handlerName_layers
pHandleMouse :: LayersHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse lh :: LayersHandler
lh@LayersHandler {Maybe OwlSpot
XY
LayerDragState
_layersHandler_dropSpot :: Maybe OwlSpot
_layersHandler_cursorPos :: XY
_layersHandler_dragState :: LayerDragState
_layersHandler_dropSpot :: LayersHandler -> Maybe OwlSpot
_layersHandler_cursorPos :: LayersHandler -> XY
_layersHandler_dragState :: LayersHandler -> LayerDragState
..} 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 :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
..}) = let
selection :: Selection
selection = Selection
_potatoHandlerInput_selection
ls :: LayersState
ls@(LayersState LayerMetaMap
_ Seq LayerEntry
lentries Int
scrollPos) = LayersState
_potatoHandlerInput_layersState
pfs :: OwlPFState
pfs = OwlPFState
_potatoHandlerInput_pFState
owltree :: OwlTree
owltree = (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs)
V2 Int
rawxoffset Int
rawlepos = XY
_mouseDrag_to
leposxy :: XY
leposxy@(V2 Int
_ Int
lepos) = forall a. a -> a -> V2 a
V2 Int
rawxoffset (Int
rawlepos forall a. Num a => a -> a -> a
+ Int
scrollPos)
in case (MouseDragState
_mouseDrag_state, LayerDragState
_layersHandler_dragState) of
(MouseDragState
MouseDragState_Down, LayerDragState
LDS_None) -> Maybe PotatoHandlerOutput
r where
shift :: Bool
shift = forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers
(LayerDragState
nextDragState, Maybe LayersState
mNextLayerState, IntMap (Maybe SuperOwl)
changes) = case Seq LayerEntry -> XY -> Maybe (SuperOwl, LayerDownType, Int)
clickLayerNew Seq LayerEntry
lentries XY
leposxy of
Maybe (SuperOwl, LayerDownType, Int)
Nothing -> (LayerDragState
LDS_None, forall a. Maybe a
Nothing, forall a. IntMap a
IM.empty)
Just (SuperOwl
downsowl, LayerDownType
ldtdown, Int
_) -> case LayerDownType
ldtdown of
LayerDownType
LDT_Normal -> if Bool
shift Bool -> Bool -> Bool
|| (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Int -> Selection -> Bool
doesSelectionContainREltId_linear (SuperOwl -> Int
_superOwl_id SuperOwl
downsowl) Selection
selection)
then (Int -> LayerDragState
LDS_Selecting Int
lepos, forall a. Maybe a
Nothing, forall a. IntMap a
IM.empty)
else (LayerDragState
LDS_Dragging, forall a. Maybe a
Nothing, forall a. IntMap a
IM.empty)
LayerDownType
LDT_Hide -> (LayerDragState, Maybe LayersState, IntMap (Maybe SuperOwl))
r' where
nextLayersState :: LayersState
nextLayersState = OwlPFState
-> LayersState -> Int -> LockHideCollapseOp -> LayersState
toggleLayerEntry OwlPFState
pfs LayersState
ls Int
lepos LockHideCollapseOp
LHCO_ToggleHide
hideChanges :: IntMap (Maybe SuperOwl)
hideChanges = OwlPFState -> LayersState -> Int -> IntMap (Maybe SuperOwl)
changesFromToggleHide OwlPFState
pfs LayersState
nextLayersState Int
lepos
r' :: (LayerDragState, Maybe LayersState, IntMap (Maybe SuperOwl))
r' = (LayerDragState
LDS_None, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LayersState
nextLayersState, IntMap (Maybe SuperOwl)
hideChanges)
LayerDownType
LDT_Lock -> (LayerDragState
LDS_None, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OwlPFState
-> LayersState -> Int -> LockHideCollapseOp -> LayersState
toggleLayerEntry OwlPFState
pfs LayersState
ls Int
lepos LockHideCollapseOp
LHCO_ToggleLock, forall a. IntMap a
IM.empty)
LayerDownType
LDT_Collapse -> (LayerDragState
LDS_None, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ OwlPFState
-> LayersState -> Int -> LockHideCollapseOp -> LayersState
toggleLayerEntry OwlPFState
pfs LayersState
ls Int
lepos LockHideCollapseOp
LHCO_ToggleCollapse, forall a. IntMap a
IM.empty)
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 LayersHandler
lh {
_layersHandler_dragState :: LayerDragState
_layersHandler_dragState = LayerDragState
nextDragState
, _layersHandler_cursorPos :: XY
_layersHandler_cursorPos = XY
_mouseDrag_to
, _layersHandler_dropSpot :: Maybe OwlSpot
_layersHandler_dropSpot = forall a. Maybe a
Nothing
}
, _potatoHandlerOutput_layersState :: Maybe LayersState
_potatoHandlerOutput_layersState = Maybe LayersState
mNextLayerState
, _potatoHandlerOutput_changesFromToggleHide :: IntMap (Maybe SuperOwl)
_potatoHandlerOutput_changesFromToggleHide = IntMap (Maybe SuperOwl)
changes
}
(MouseDragState
MouseDragState_Down, LayerDragState
_) -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected, _layersHandler_dragState should have been reset on last mouse up"
(MouseDragState
MouseDragState_Dragging, LayerDragState
LDS_Dragging) -> Maybe PotatoHandlerOutput
r where
mDropSowlWithOffset :: Maybe (SuperOwl, Int)
mDropSowlWithOffset = do
(SuperOwl
downsowl, LayerDownType
_, Int
offset') <- Seq LayerEntry -> XY -> Maybe (SuperOwl, LayerDownType, Int)
clickLayerNew Seq LayerEntry
lentries XY
leposxy
forall (m :: * -> *) a. Monad m => a -> m a
return (SuperOwl
downsowl, Int
offset')
mJustAboveDropSowl :: Maybe SuperOwl
mJustAboveDropSowl = do
LayerEntry
lentry <- case Maybe (SuperOwl, Int)
mDropSowlWithOffset of
Maybe (SuperOwl, Int)
Nothing -> forall a. Int -> Seq a -> Maybe a
Seq.lookup (forall a. Seq a -> Int
Seq.length Seq LayerEntry
lentries forall a. Num a => a -> a -> a
- Int
1) Seq LayerEntry
lentries
Just (SuperOwl, Int)
_ -> forall a. Int -> Seq a -> Maybe a
Seq.lookup (Int
leposforall a. Num a => a -> a -> a
-Int
1) Seq LayerEntry
lentries
return $ LayerEntry -> SuperOwl
_layerEntry_superOwl LayerEntry
lentry
nparentoffset :: Int
nparentoffset = case Maybe (SuperOwl, Int)
mDropSowlWithOffset of
Maybe (SuperOwl, Int)
Nothing -> case Maybe SuperOwl
mJustAboveDropSowl of
Maybe SuperOwl
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen"
Just SuperOwl
asowl -> Int
rawxoffset forall a. Num a => a -> a -> a
- SuperOwl -> Int
superOwl_depth SuperOwl
asowl
Just (SuperOwl
dsowl, Int
x) -> case Maybe SuperOwl
mJustAboveDropSowl of
Maybe SuperOwl
Nothing -> Int
0
Just SuperOwl
asowl -> forall a. Ord a => a -> a -> a
max Int
x (SuperOwl -> Int
superOwl_depth SuperOwl
dsowl forall a. Num a => a -> a -> a
- SuperOwl -> Int
superOwl_depth SuperOwl
asowl)
nsibling :: Int
nsibling = forall a. Ord a => a -> a -> a
max Int
0 (- (forall a. Ord a => a -> a -> a
min Int
0 Int
nparentoffset))
targetspot :: OwlSpot
targetspot = case Maybe SuperOwl
mJustAboveDropSowl of
Maybe SuperOwl
Nothing -> Int -> LayersHandlerRenderEntryDots -> OwlSpot
OwlSpot Int
noOwl forall a. Maybe a
Nothing
Just SuperOwl
asowl -> if Int
nparentoffset forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& forall o. HasOwlItem o => o -> Bool
hasOwlItem_isFolder SuperOwl
asowl
then Int -> LayersHandlerRenderEntryDots -> OwlSpot
OwlSpot (SuperOwl -> Int
_superOwl_id SuperOwl
asowl) forall a. Maybe a
Nothing
else case OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
owltree Int
newsiblingid of
Maybe SuperOwl
Nothing -> Int -> LayersHandlerRenderEntryDots -> OwlSpot
OwlSpot Int
noOwl LayersHandlerRenderEntryDots
siblingout
Just SuperOwl
newsibling -> Int -> LayersHandlerRenderEntryDots -> OwlSpot
OwlSpot (SuperOwl -> Int
superOwl_parentId SuperOwl
newsibling) LayersHandlerRenderEntryDots
siblingout
where
newsiblingid :: Int
newsiblingid = OwlTree -> SuperOwl -> Int -> Int
owlTree_superOwlNthParentId OwlTree
owltree SuperOwl
asowl Int
nsibling
siblingout :: LayersHandlerRenderEntryDots
siblingout = case Int
newsiblingid of
Int
x | Int
x forall a. Eq a => a -> a -> Bool
== Int
noOwl -> forall a. Maybe a
Nothing
Int
x -> forall a. a -> Maybe a
Just Int
x
isSpotValid :: Bool
isSpotValid = Bool
True
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 LayersHandler
lh {
_layersHandler_cursorPos :: XY
_layersHandler_cursorPos = XY
_mouseDrag_to
, _layersHandler_dropSpot :: Maybe OwlSpot
_layersHandler_dropSpot = if Bool
isSpotValid then forall a. a -> Maybe a
Just OwlSpot
targetspot else forall a. Maybe a
Nothing
}
}
(MouseDragState
MouseDragState_Dragging, LayerDragState
_) -> 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 LayersHandler
lh {
_layersHandler_cursorPos :: XY
_layersHandler_cursorPos = XY
_mouseDrag_to
, _layersHandler_dropSpot :: Maybe OwlSpot
_layersHandler_dropSpot = forall a. Maybe a
Nothing
}
}
(MouseDragState
MouseDragState_Up, LDS_Selecting Int
leposdown) -> Maybe PotatoHandlerOutput
r where
shift :: Bool
shift = forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers
sowl :: SuperOwl
sowl = LayerEntry -> SuperOwl
_layerEntry_superOwl forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq LayerEntry
lentries Int
leposdown
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 (LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh)
, _potatoHandlerOutput_select :: Maybe (Bool, Selection)
_potatoHandlerOutput_select = forall a. a -> Maybe a
Just (Bool
shift, Seq SuperOwl -> Selection
SuperOwlParliament forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq a
Seq.singleton SuperOwl
sowl)
}
(MouseDragState
MouseDragState_Up, LayerDragState
LDS_Dragging) | forall a. Maybe a -> Bool
isNothing Maybe OwlSpot
_layersHandler_dropSpot -> case Seq LayerEntry -> XY -> Maybe (SuperOwl, LayerDownType, Int)
clickLayerNew Seq LayerEntry
lentries XY
leposxy of
Maybe (SuperOwl, LayerDownType, Int)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"pretty sure this should never happen "
Just (SuperOwl
downsowl, LayerDownType
ldtdown, Int
offset) -> case LayerDownType
ldtdown of
LayerDownType
LDT_Normal | Int
offset forall a. Ord a => a -> a -> Bool
>= Int
titleOffset -> Maybe PotatoHandlerOutput
r where
zipper :: TextZipper
zipper = Text -> TextZipper
TZ.fromText forall a b. (a -> b) -> a -> b
$ forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
downsowl
r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersRenameHandler {
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_original = LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh
, _layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_renaming = SuperOwl
downsowl
, _layersRenameHandler_index :: Int
_layersRenameHandler_index = Int
lepos
, _layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_zipper = TextZipper
zipper
}
LayerDownType
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly (LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh)
(MouseDragState
MouseDragState_Up, LayerDragState
LDS_Dragging) -> Maybe PotatoHandlerOutput
r where
mev :: Maybe WSEvent
mev = do
OwlSpot
spot <- Maybe OwlSpot
_layersHandler_dropSpot
let
isSpotValid :: Bool
isSpotValid = OwlTree -> Selection -> OwlSpot -> Bool
isSpotValidToDrop OwlTree
owltree Selection
_potatoHandlerInput_selection OwlSpot
spot
modifiedSpot :: OwlSpot
modifiedSpot = OwlSpot
spot
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isSpotValid
return $ (OwlSpot, OwlParliament) -> WSEvent
WSEMoveElt (OwlSpot
modifiedSpot, Selection -> OwlParliament
superOwlParliament_toOwlParliament Selection
selection)
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 (LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh)
, _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = Maybe WSEvent
mev
}
(MouseDragState
MouseDragState_Up, LayerDragState
LDS_None) -> 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 (LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh)
, _potatoHandlerOutput_select :: Maybe (Bool, Selection)
_potatoHandlerOutput_select = forall a. a -> Maybe a
Just (Bool
False, forall a. IsParliament a => a
isParliament_empty)
}
(MouseDragState
MouseDragState_Cancelled, LayerDragState
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly (LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh)
pHandleKeyboard :: LayersHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard LayersHandler
lh PotatoHandlerInput
phi KeyboardData
kbd = case KeyboardData
kbd of
KeyboardData (KeyboardKey_Scroll Int
scroll) [KeyModifier]
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Int -> PotatoHandlerOutput
handleScroll LayersHandler
lh PotatoHandlerInput
phi Int
scroll
KeyboardData
_ -> forall a. Maybe a
Nothing
pIsHandlerActive :: LayersHandler -> Bool
pIsHandlerActive LayersHandler {Maybe OwlSpot
XY
LayerDragState
_layersHandler_dropSpot :: Maybe OwlSpot
_layersHandler_cursorPos :: XY
_layersHandler_dragState :: LayerDragState
_layersHandler_dropSpot :: LayersHandler -> Maybe OwlSpot
_layersHandler_cursorPos :: LayersHandler -> XY
_layersHandler_dragState :: LayersHandler -> LayerDragState
..} = LayerDragState
_layersHandler_dragState forall a. Eq a => a -> a -> Bool
/= LayerDragState
LDS_None
pRefreshHandler :: LayersHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler LayersHandler
h PotatoHandlerInput
_ = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler LayersHandler
h
pRenderLayersHandler :: LayersHandler
-> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler LayersHandler {Maybe OwlSpot
XY
LayerDragState
_layersHandler_dropSpot :: Maybe OwlSpot
_layersHandler_cursorPos :: XY
_layersHandler_dragState :: LayerDragState
_layersHandler_dropSpot :: LayersHandler -> Maybe OwlSpot
_layersHandler_cursorPos :: LayersHandler -> XY
_layersHandler_dragState :: LayersHandler -> LayerDragState
..} 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
..} = Seq LayersHandlerRenderEntry -> LayersViewHandlerRenderOutput
LayersViewHandlerRenderOutput Seq LayersHandlerRenderEntry
newlentries where
selection :: Selection
selection = Selection
_potatoHandlerInput_selection
LayersState LayerMetaMap
_ Seq LayerEntry
lentries Int
_ = LayersState
_potatoHandlerInput_layersState
selectionset :: OwlParliamentSet
selectionset = Selection -> OwlParliamentSet
superOwlParliament_toOwlParliamentSet Selection
selection
isSelected :: LayerEntry -> Bool
isSelected LayerEntry
lentry = Int -> OwlParliamentSet -> Bool
owlParliamentSet_member (LayerEntry -> Int
layerEntry_rEltId LayerEntry
lentry) OwlParliamentSet
selectionset
mapaccumlfn_forselection :: LayersHandlerRenderEntryDots
-> LayerEntry
-> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
mapaccumlfn_forselection LayersHandlerRenderEntryDots
mseldepth LayerEntry
lentry = case LayersHandlerRenderEntryDots
mseldepth of
LayersHandlerRenderEntryDots
Nothing -> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
normalcase
Just Int
x -> if LayerEntry -> Int
layerEntry_depth LayerEntry
lentry forall a. Ord a => a -> a -> Bool
> Int
x
then (LayersHandlerRenderEntryDots
mseldepth, LayersHandlerRenderEntrySelectedState -> LayersHandlerRenderEntry
makelentry LayersHandlerRenderEntrySelectedState
LHRESS_InheritSelected)
else (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
normalcase
where
makelentry :: LayersHandlerRenderEntrySelectedState -> LayersHandlerRenderEntry
makelentry LayersHandlerRenderEntrySelectedState
x = LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntryRenaming
-> LayerEntry
-> LayersHandlerRenderEntry
LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
x forall a. Maybe a
Nothing forall a. Maybe a
Nothing LayerEntry
lentry
normalcase :: (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
normalcase = if LayerEntry -> Bool
isSelected LayerEntry
lentry
then (forall a. a -> Maybe a
Just (LayerEntry -> Int
layerEntry_depth LayerEntry
lentry), LayersHandlerRenderEntrySelectedState -> LayersHandlerRenderEntry
makelentry LayersHandlerRenderEntrySelectedState
LHRESS_Selected)
else (forall a. Maybe a
Nothing, LayersHandlerRenderEntrySelectedState -> LayersHandlerRenderEntry
makelentry LayersHandlerRenderEntrySelectedState
LHRESS_None)
(LayersHandlerRenderEntryDots
_,Seq LayersHandlerRenderEntry
newlentries1) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL LayersHandlerRenderEntryDots
-> LayerEntry
-> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
mapaccumlfn_forselection forall a. Maybe a
Nothing Seq LayerEntry
lentries
newlentries2 :: Seq LayersHandlerRenderEntry
newlentries2 = case Maybe OwlSpot
_layersHandler_dropSpot of
Maybe OwlSpot
Nothing -> Seq LayersHandlerRenderEntry
newlentries1
Just OwlSpot
ds -> Seq LayersHandlerRenderEntry
r where
(LayersHandlerRenderEntryDots
mleftmost, Bool
samelevel) = case OwlSpot -> Int
_owlSpot_parent OwlSpot
ds of
Int
x | Int
x forall a. Eq a => a -> a -> Bool
== Int
noOwl -> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing forall a. a -> Maybe a
Just (OwlSpot -> LayersHandlerRenderEntryDots
_owlSpot_leftSibling OwlSpot
ds), Bool
True)
Int
x -> case OwlSpot -> LayersHandlerRenderEntryDots
_owlSpot_leftSibling OwlSpot
ds of
LayersHandlerRenderEntryDots
Nothing -> (forall a. a -> Maybe a
Just Int
x, Bool
False)
Just Int
s -> (forall a. a -> Maybe a
Just Int
s, Bool
True)
r :: Seq LayersHandlerRenderEntry
r = case LayersHandlerRenderEntryDots
mleftmost of
LayersHandlerRenderEntryDots
Nothing -> Int -> LayersHandlerRenderEntry
LayersHandlerRenderEntryDummy Int
0 forall a. a -> Seq a -> Seq a
<| Seq LayersHandlerRenderEntry
newlentries1
Just Int
leftmostid -> Seq LayersHandlerRenderEntry
r' where
(Int
index, Int
depth) = case forall a. (a -> Bool) -> Seq a -> LayersHandlerRenderEntryDots
Seq.findIndexL (\LayerEntry
lentry -> SuperOwl -> Int
_superOwl_id (LayerEntry -> SuperOwl
_layerEntry_superOwl LayerEntry
lentry) forall a. Eq a => a -> a -> Bool
== Int
leftmostid) Seq LayerEntry
lentries of
LayersHandlerRenderEntryDots
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
"expected to find id " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
leftmostid forall a. Semigroup a => a -> a -> a
<> Text
" in " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Seq LayerEntry
lentries
Just Int
x -> (Int
skipped, Int
depth') where
depth' :: Int
depth' = LayerEntry -> Int
layerEntry_depth (forall a. Seq a -> Int -> a
Seq.index Seq LayerEntry
lentries Int
x) forall a. Num a => a -> a -> a
+ (if Bool
samelevel then Int
0 else Int
1)
noskiplentries :: Seq LayerEntry
noskiplentries = forall a. Int -> Seq a -> Seq a
Seq.drop (Int
xforall a. Num a => a -> a -> a
+Int
1) forall a b. (a -> b) -> a -> b
$ Seq LayerEntry
lentries
skippedlentries :: Seq LayerEntry
skippedlentries = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileL (\LayerEntry
lentry -> LayerEntry -> Int
layerEntry_depth LayerEntry
lentry forall a. Ord a => a -> a -> Bool
> Int
depth') forall a b. (a -> b) -> a -> b
$ Seq LayerEntry
noskiplentries
skipped :: Int
skipped = if Bool
samelevel then Int
x forall a. Num a => a -> a -> a
+ Int
1 forall a. Num a => a -> a -> a
+ forall a. Seq a -> Int
Seq.length Seq LayerEntry
skippedlentries else Int
xforall a. Num a => a -> a -> a
+Int
1
r' :: Seq LayersHandlerRenderEntry
r' = forall a. Int -> a -> Seq a -> Seq a
Seq.insertAt Int
index (Int -> LayersHandlerRenderEntry
LayersHandlerRenderEntryDummy Int
depth) Seq LayersHandlerRenderEntry
newlentries1
mapaccumrfn_fordots :: LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntry
-> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
mapaccumrfn_fordots LayersHandlerRenderEntryDots
mdropdepth LayersHandlerRenderEntry
lhre = case LayersHandlerRenderEntryDots
mdropdepth of
LayersHandlerRenderEntryDots
Nothing -> case LayersHandlerRenderEntry
lhre of
LayersHandlerRenderEntryDummy Int
d -> (forall a. a -> Maybe a
Just Int
d, LayersHandlerRenderEntry
lhre)
LayersHandlerRenderEntry
_ -> (LayersHandlerRenderEntryDots
mdropdepth, LayersHandlerRenderEntry
lhre)
Just Int
x -> case LayersHandlerRenderEntry
lhre of
LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
s LayersHandlerRenderEntryDots
_ LayersHandlerRenderEntryRenaming
_ LayerEntry
lentry -> if LayerEntry -> Int
layerEntry_depth LayerEntry
lentry forall a. Ord a => a -> a -> Bool
>= Int
x
then (LayersHandlerRenderEntryDots
mdropdepth, LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntryRenaming
-> LayerEntry
-> LayersHandlerRenderEntry
LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
s (forall a. a -> Maybe a
Just Int
x) forall a. Maybe a
Nothing LayerEntry
lentry)
else (forall a. Maybe a
Nothing, LayersHandlerRenderEntry
lhre)
LayersHandlerRenderEntry
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected LayersHandlerRenderEntryDummy"
(LayersHandlerRenderEntryDots
_, Seq LayersHandlerRenderEntry
newlentries3) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntry
-> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
mapaccumrfn_fordots forall a. Maybe a
Nothing Seq LayersHandlerRenderEntry
newlentries2
mapaccumrfn_forchildselected :: ([Bool], Int)
-> LayersHandlerRenderEntry
-> (([Bool], Int), LayersHandlerRenderEntry)
mapaccumrfn_forchildselected ([Bool]
selstack, Int
lastdepth) LayersHandlerRenderEntry
lhre = (([Bool]
newstack, Int
depth), LayersHandlerRenderEntry
newlhre) where
selected :: Bool
selected = LayersHandlerRenderEntry -> Bool
layersHandlerRenderEntry_selected LayersHandlerRenderEntry
lhre
depth :: Int
depth = LayersHandlerRenderEntry -> Int
layersHandlerRenderEntry_depth LayersHandlerRenderEntry
lhre
(Bool
childSelected, [Bool]
newstack) = if Int
depth forall a. Ord a => a -> a -> Bool
> Int
lastdepth
then (Bool
False, Bool
selectedforall a. a -> [a] -> [a]
:[Bool]
selstack)
else if Bool
selected
then case [Bool]
selstack of
[] -> (Bool
False, [Bool
True])
Bool
_:[Bool]
xs -> (Bool
False, Bool
Trueforall a. a -> [a] -> [a]
:[Bool]
xs)
else if Int
depth forall a. Ord a => a -> a -> Bool
< Int
lastdepth
then case [Bool]
selstack of
[] -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen"
Bool
x1:[Bool]
xs1 -> case [Bool]
xs1 of
[] -> (Bool
x1, [Bool
x1])
Bool
x2:[Bool]
xs2 -> (Bool
x1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
x2, (Bool
x1 Bool -> Bool -> Bool
|| Bool
x2) forall a. a -> [a] -> [a]
: [Bool]
xs2)
else (Bool
False, [Bool]
selstack)
newlhre :: LayersHandlerRenderEntry
newlhre = if Bool
childSelected
then case LayersHandlerRenderEntry
lhre of
LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
_ LayersHandlerRenderEntryDots
mdots LayersHandlerRenderEntryRenaming
renaming LayerEntry
lentry -> LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntryRenaming
-> LayerEntry
-> LayersHandlerRenderEntry
LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
LHRESS_ChildSelected LayersHandlerRenderEntryDots
mdots LayersHandlerRenderEntryRenaming
renaming LayerEntry
lentry
LayersHandlerRenderEntry
x -> LayersHandlerRenderEntry
x
else LayersHandlerRenderEntry
lhre
(([Bool], Int)
_, Seq LayersHandlerRenderEntry
newlentries) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR ([Bool], Int)
-> LayersHandlerRenderEntry
-> (([Bool], Int), LayersHandlerRenderEntry)
mapaccumrfn_forchildselected ([], Int
0) Seq LayersHandlerRenderEntry
newlentries3
data LayersRenameHandler = LayersRenameHandler {
LayersRenameHandler -> LayersHandler
_layersRenameHandler_original :: LayersHandler
, LayersRenameHandler -> SuperOwl
_layersRenameHandler_renaming :: SuperOwl
, LayersRenameHandler -> Int
_layersRenameHandler_index :: Int
, LayersRenameHandler -> TextZipper
_layersRenameHandler_zipper :: TZ.TextZipper
}
isValidLayerRenameChar :: Char -> Bool
isValidLayerRenameChar :: Char -> Bool
isValidLayerRenameChar Char
c = case Char
c of
Char
_ | Char -> Bool
isControl Char
c -> Bool
False
Char
' ' -> Bool
True
Char
_ | Char -> Bool
isSpace Char
c -> Bool
False
Char
_ -> Bool
True
renameTextZipperTransform :: KeyboardKey -> Maybe (TZ.TextZipper -> TZ.TextZipper)
renameTextZipperTransform :: KeyboardKey -> Maybe (TextZipper -> TextZipper)
renameTextZipperTransform = \case
KeyboardKey
KeyboardKey_Space -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> TextZipper -> TextZipper
TZ.insertChar Char
' '
KeyboardKey_Char Char
k | Char -> Bool
isValidLayerRenameChar Char
k -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> TextZipper -> TextZipper
TZ.insertChar Char
k
KeyboardKey
KeyboardKey_Backspace -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.deleteLeft
KeyboardKey
KeyboardKey_Delete -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.deleteRight
KeyboardKey
KeyboardKey_Left -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.left
KeyboardKey
KeyboardKey_Right -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.right
KeyboardKey
KeyboardKey_Home -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.home
KeyboardKey
KeyboardKey_End -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.end
KeyboardKey_Paste Text
t | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isValidLayerRenameChar Text
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> TextZipper -> TextZipper
TZ.insert Text
t
KeyboardKey
_ -> forall a. Maybe a
Nothing
renameToAndReturn :: LayersRenameHandler -> Text -> PotatoHandlerOutput
renameToAndReturn :: LayersRenameHandler -> Text -> PotatoHandlerOutput
renameToAndReturn LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_index :: Int
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
..} Text
newName = PotatoHandlerOutput
r where
controller :: DSum CTag Identity
controller = CTag CRename
CTagRename forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> (forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ CRename {
_cRename_deltaLabel :: DeltaText
_cRename_deltaLabel = (forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
_layersRenameHandler_renaming, Text
newName)
})
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 LayersHandler
_layersRenameHandler_original
, _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
False, OwlPFCmd -> Llama
makePFCLlama forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> OwlPFCmd
OwlPFCManipulate forall a b. (a -> b) -> a -> b
$ forall a. [(Int, a)] -> IntMap a
IM.fromList [(SuperOwl -> Int
_superOwl_id SuperOwl
_layersRenameHandler_renaming,DSum CTag Identity
controller)])
}
toDisplayLines :: LayersRenameHandler -> TZ.DisplayLines ()
toDisplayLines :: LayersRenameHandler -> DisplayLines ()
toDisplayLines LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_index :: Int
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
..} = forall tag.
TextAlignment
-> Int -> tag -> tag -> TextZipper -> DisplayLines tag
TZ.displayLinesWithAlignment TextAlignment
TZ.TextAlignment_Left Int
1000 () () TextZipper
_layersRenameHandler_zipper
layerJunkOffset :: Int
layerJunkOffset :: Int
layerJunkOffset = Int
7
instance PotatoHandler LayersRenameHandler where
pHandlerName :: LayersRenameHandler -> Text
pHandlerName LayersRenameHandler
_ = Text
handlerName_layersRename
pHandleMouse :: LayersRenameHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse lh :: LayersRenameHandler
lh@LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_index :: Int
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
..} 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
LayersState LayerMetaMap
_ Seq LayerEntry
lentries Int
scrollPos = LayersState
_potatoHandlerInput_layersState
V2 Int
rawxoffset Int
rawlepos = XY
_mouseDrag_to
leposxy :: XY
leposxy@(V2 Int
_ Int
lepos) = forall a. a -> a -> V2 a
V2 Int
rawxoffset (Int
rawlepos forall a. Num a => a -> a -> a
+ Int
scrollPos)
renaminglepos :: Int
renaminglepos = Int
_layersRenameHandler_index
in case MouseDragState
_mouseDrag_state of
MouseDragState
MouseDragState_Down | Int
lepos forall a. Eq a => a -> a -> Bool
== Int
renaminglepos -> Maybe PotatoHandlerOutput
r where
xpos :: Int
xpos = case Seq LayerEntry -> XY -> Maybe (SuperOwl, LayerDownType, Int)
clickLayerNew Seq LayerEntry
lentries XY
leposxy of
Maybe (SuperOwl, LayerDownType, Int)
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen"
Just (SuperOwl
_, LayerDownType
_, Int
xoff) -> Int
xoff forall a. Num a => a -> a -> a
- Int
layerJunkOffset
dl :: DisplayLines ()
dl = LayersRenameHandler -> DisplayLines ()
toDisplayLines LayersRenameHandler
lh
nexttz :: TextZipper
nexttz = forall tag.
Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
TZ.goToDisplayLinePosition Int
xpos Int
0 DisplayLines ()
dl TextZipper
_layersRenameHandler_zipper
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 LayersRenameHandler
lh {
_layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_zipper = TextZipper
nexttz
}
}
MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersRenameHandler
lh
MouseDragState
MouseDragState_Up -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersRenameHandler
lh
MouseDragState
_ -> forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
mpho' :: Maybe PotatoHandlerOutput
mpho' = forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse LayersHandler
_layersRenameHandler_original PotatoHandlerInput
phi RelMouseDrag
rmd
pho'' :: PotatoHandlerOutput
pho'' = LayersRenameHandler -> Text -> PotatoHandlerOutput
renameToAndReturn LayersRenameHandler
lh (TextZipper -> Text
TZ.value TextZipper
_layersRenameHandler_zipper)
r :: PotatoHandlerOutput
r = case Maybe PotatoHandlerOutput
mpho' of
Maybe PotatoHandlerOutput
Nothing -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen..."
Just PotatoHandlerOutput
pho' -> PotatoHandlerOutput
pho' { _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = PotatoHandlerOutput -> Maybe WSEvent
_potatoHandlerOutput_pFEvent PotatoHandlerOutput
pho'' }
pHandleKeyboard :: LayersRenameHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard lh :: LayersRenameHandler
lh@LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_index :: Int
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
..} 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
..} KeyboardData
kbd = case KeyboardData
kbd of
KeyboardData KeyboardKey
_ [KeyModifier
KeyModifier_Ctrl] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersRenameHandler
lh
KeyboardData KeyboardKey
KeyboardKey_Return [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LayersRenameHandler -> Text -> PotatoHandlerOutput
renameToAndReturn LayersRenameHandler
lh (TextZipper -> Text
TZ.value TextZipper
_layersRenameHandler_zipper)
KeyboardData KeyboardKey
KeyboardKey_Esc [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersHandler
_layersRenameHandler_original
KeyboardData (KeyboardKey_Scroll Int
scroll) [KeyModifier]
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Int -> PotatoHandlerOutput
handleScroll LayersRenameHandler
lh PotatoHandlerInput
phi Int
scroll
KeyboardData KeyboardKey
key [] -> case KeyboardKey -> Maybe (TextZipper -> TextZipper)
renameTextZipperTransform KeyboardKey
key of
Maybe (TextZipper -> TextZipper)
Nothing -> forall a. Maybe a
Nothing
Just TextZipper -> TextZipper
f -> Maybe PotatoHandlerOutput
r where
nexttz :: TextZipper
nexttz = TextZipper -> TextZipper
f TextZipper
_layersRenameHandler_zipper
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 LayersRenameHandler
lh {
_layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_zipper = TextZipper
nexttz
}
}
KeyboardData
_ -> forall a. Maybe a
Nothing
pRefreshHandler :: LayersRenameHandler
-> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler LayersRenameHandler
h PotatoHandlerInput
_ = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler LayersRenameHandler
h
pIsHandlerActive :: LayersRenameHandler -> Bool
pIsHandlerActive LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_index :: Int
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
..} = Bool
True
pRenderLayersHandler :: LayersRenameHandler
-> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_zipper :: TextZipper
_layersRenameHandler_index :: Int
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
..} 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
..} = LayersViewHandlerRenderOutput
r where
r' :: LayersViewHandlerRenderOutput
r' = forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler LayersHandler
_layersRenameHandler_original PotatoHandlerInput
phi
entries' :: Seq LayersHandlerRenderEntry
entries' = LayersViewHandlerRenderOutput -> Seq LayersHandlerRenderEntry
_layersViewHandlerRenderOutput_entries LayersViewHandlerRenderOutput
r'
adjustfn :: LayersHandlerRenderEntry -> LayersHandlerRenderEntry
adjustfn (LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
lhress LayersHandlerRenderEntryDots
dots LayersHandlerRenderEntryRenaming
_ LayerEntry
lentry) = LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntryRenaming
-> LayerEntry
-> LayersHandlerRenderEntry
LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
lhress LayersHandlerRenderEntryDots
dots (forall a. a -> Maybe a
Just TextZipper
_layersRenameHandler_zipper) LayerEntry
lentry where
adjustfn (LayersHandlerRenderEntryDummy Int
_) = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen"
entries :: Seq LayersHandlerRenderEntry
entries = forall a. (a -> a) -> Int -> Seq a -> Seq a
Seq.adjust' LayersHandlerRenderEntry -> LayersHandlerRenderEntry
adjustfn Int
_layersRenameHandler_index Seq LayersHandlerRenderEntry
entries'
r :: LayersViewHandlerRenderOutput
r = LayersViewHandlerRenderOutput { _layersViewHandlerRenderOutput_entries :: Seq LayersHandlerRenderEntry
_layersViewHandlerRenderOutput_entries = Seq LayersHandlerRenderEntry
entries }