{-# OPTIONS_GHC -fno-warn-unused-record-wildcards #-}
{-# 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.Controller.Types
import Potato.Flow.Llama
import Potato.Flow.Math
import Potato.Flow.Owl
import Potato.Flow.OwlItem
import Potato.Flow.OwlState
import Potato.Flow.OwlWorkspace
import Potato.Flow.Serialization.Snake
import Potato.Flow.Types
import Potato.Flow.Preview
import Data.Char
import Data.Default
import Data.Dependent.Sum (DSum ((:=>)))
import qualified Data.IntMap as IM
import Data.Sequence ((<|))
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Potato.Data.Text.Zipper as TZ
data LayerDragState = LDS_None | LDS_Dragging | LDS_Selecting LayerEntryPos | LDS_Option LayerDownType deriving (Int -> LayerDragState -> ShowS
[LayerDragState] -> ShowS
LayerDragState -> String
(Int -> LayerDragState -> ShowS)
-> (LayerDragState -> String)
-> ([LayerDragState] -> ShowS)
-> Show LayerDragState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayerDragState -> ShowS
showsPrec :: Int -> LayerDragState -> ShowS
$cshow :: LayerDragState -> String
show :: LayerDragState -> String
$cshowList :: [LayerDragState] -> ShowS
showList :: [LayerDragState] -> ShowS
Show, LayerDragState -> LayerDragState -> Bool
(LayerDragState -> LayerDragState -> Bool)
-> (LayerDragState -> LayerDragState -> Bool) -> Eq LayerDragState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayerDragState -> LayerDragState -> Bool
== :: LayerDragState -> LayerDragState -> Bool
$c/= :: LayerDragState -> LayerDragState -> Bool
/= :: LayerDragState -> LayerDragState -> Bool
Eq)
data LayerDownType = LDT_Hide | LDT_Lock | LDT_Collapse | LDT_Normal deriving (Int -> LayerDownType -> ShowS
[LayerDownType] -> ShowS
LayerDownType -> String
(Int -> LayerDownType -> ShowS)
-> (LayerDownType -> String)
-> ([LayerDownType] -> ShowS)
-> Show LayerDownType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LayerDownType -> ShowS
showsPrec :: Int -> LayerDownType -> ShowS
$cshow :: LayerDownType -> String
show :: LayerDownType -> String
$cshowList :: [LayerDownType] -> ShowS
showList :: [LayerDownType] -> ShowS
Show, LayerDownType -> LayerDownType -> Bool
(LayerDownType -> LayerDownType -> Bool)
-> (LayerDownType -> LayerDownType -> Bool) -> Eq LayerDownType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LayerDownType -> LayerDownType -> Bool
== :: LayerDownType -> LayerDownType -> Bool
$c/= :: LayerDownType -> LayerDownType -> Bool
/= :: 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 = Maybe SuperOwl -> Bool
forall a. Maybe a -> Bool
isJust (Maybe SuperOwl -> Bool)
-> (Selection -> Maybe SuperOwl) -> Selection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperOwl -> Bool) -> Seq SuperOwl -> Maybe SuperOwl
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\SuperOwl
sowl -> Int
rid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== SuperOwl -> Int
_superOwl_id SuperOwl
sowl) (Seq SuperOwl -> Maybe SuperOwl)
-> (Selection -> Seq SuperOwl) -> Selection -> Maybe SuperOwl
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 Int -> Seq LayerEntry -> Maybe LayerEntry
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
lepos Seq LayerEntry
lentries of
Maybe LayerEntry
Nothing -> Maybe (SuperOwl, LayerDownType, Int)
forall a. Maybe a
Nothing
Just LayerEntry
le -> (SuperOwl, LayerDownType, Int)
-> Maybe (SuperOwl, LayerDownType, Int)
forall a. a -> Maybe a
Just ((SuperOwl, LayerDownType, Int)
-> Maybe (SuperOwl, LayerDownType, Int))
-> (LayerDownType -> (SuperOwl, LayerDownType, Int))
-> LayerDownType
-> Maybe (SuperOwl, LayerDownType, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,,Int
absx Int -> Int -> Int
forall a. Num a => a -> a -> a
- LayerEntry -> Int
layerEntry_depth LayerEntry
le) SuperOwl
sowl (LayerDownType -> Maybe (SuperOwl, LayerDownType, Int))
-> LayerDownType -> Maybe (SuperOwl, LayerDownType, Int)
forall a b. (a -> b) -> a -> b
$ case () of
() | LayerEntry -> Bool
layerEntry_isFolder LayerEntry
le Bool -> Bool -> Bool
&& LayerEntry -> Int
layerEntry_depth LayerEntry
le Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
collapseOffset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
absx -> LayerDownType
LDT_Collapse
() | LayerEntry -> Int
layerEntry_depth LayerEntry
le Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hideOffset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
absx -> LayerDownType
LDT_Hide
() | LayerEntry -> Int
layerEntry_depth LayerEntry
le Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lockOffset Int -> Int -> Bool
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 = Maybe OwlSpot
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
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
..} Int
scroll = PotatoHandlerOutput
r where
scrollPos :: Int
scrollPos = LayersState -> Int
_layersState_scrollPos LayersState
_potatoHandlerInput_layersState
maxentries :: Int
maxentries = Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Seq LayerEntry -> Int
forall a. Seq a -> Int
Seq.length (Seq LayerEntry -> Int) -> Seq LayerEntry -> Int
forall a b. (a -> b) -> a -> b
$ LayersState -> Seq LayerEntry
_layersState_entries LayersState
_potatoHandlerInput_layersState)
newScrollPos :: Int
newScrollPos = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxentries (Int
scrollPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
scroll))
r :: PotatoHandlerOutput
r = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler h
, _potatoHandlerOutput_action = HOA_Layers (_potatoHandlerInput_layersState { _layersState_scrollPos = newScrollPos}) IM.empty
}
resetLayersHandler :: LayersHandler -> LayersHandler
resetLayersHandler :: LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh = LayersHandler
lh {
_layersHandler_dragState = LDS_None
, _layersHandler_dropSpot = Nothing
}
moveEltLlama :: OwlPFState -> (OwlSpot, OwlParliament) -> Llama
moveEltLlama :: OwlPFState -> (OwlSpot, OwlParliament) -> Llama
moveEltLlama OwlPFState
pfs (OwlSpot
ospot, OwlParliament
op) = OwlPFCmd -> Llama
makePFCLlama (OwlPFCmd -> Llama) -> OwlPFCmd -> Llama
forall a b. (a -> b) -> a -> b
$ (OwlSpot, Selection) -> OwlPFCmd
OwlPFCMove (OwlSpot
ospot, OwlTree -> OwlParliament -> Selection
owlParliament_toSuperOwlParliament (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) OwlParliament
op)
isSpotValidToDrop :: OwlTree -> Selection -> OwlSpot -> Bool
isSpotValidToDrop :: OwlTree -> Selection -> OwlSpot -> Bool
isSpotValidToDrop OwlTree
ot Selection
sel OwlSpot
spot = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
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 {Maybe OwlSpot
XY
LayerDragState
_layersHandler_dragState :: LayersHandler -> LayerDragState
_layersHandler_cursorPos :: LayersHandler -> XY
_layersHandler_dropSpot :: LayersHandler -> Maybe OwlSpot
_layersHandler_dragState :: LayerDragState
_layersHandler_cursorPos :: XY
_layersHandler_dropSpot :: Maybe OwlSpot
..} = Text
handlerName_layers Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LayerDragState -> Text
forall b a. (Show a, IsString b) => a -> b
show LayerDragState
_layersHandler_dragState
pHandleMouse :: LayersHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse lh :: LayersHandler
lh@LayersHandler {Maybe OwlSpot
XY
LayerDragState
_layersHandler_dragState :: LayersHandler -> LayerDragState
_layersHandler_cursorPos :: LayersHandler -> XY
_layersHandler_dropSpot :: LayersHandler -> Maybe OwlSpot
_layersHandler_dragState :: LayerDragState
_layersHandler_cursorPos :: XY
_layersHandler_dropSpot :: Maybe OwlSpot
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: 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
..}) = 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) = Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
rawxoffset (Int
rawlepos Int -> Int -> Int
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 = KeyModifier -> [KeyModifier] -> Bool
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, SuperOwlChanges
changes) = case Seq LayerEntry -> XY -> Maybe (SuperOwl, LayerDownType, Int)
clickLayerNew Seq LayerEntry
lentries XY
leposxy of
Maybe (SuperOwl, LayerDownType, Int)
Nothing -> (LayerDragState
LDS_None, Maybe LayersState
forall a. Maybe a
Nothing, SuperOwlChanges
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 (Bool -> Bool) -> Bool -> Bool
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, Maybe LayersState
forall a. Maybe a
Nothing, SuperOwlChanges
forall a. IntMap a
IM.empty)
else (LayerDragState
LDS_Dragging, Maybe LayersState
forall a. Maybe a
Nothing, SuperOwlChanges
forall a. IntMap a
IM.empty)
LayerDownType
LDT_Hide -> (LayerDragState, Maybe LayersState, SuperOwlChanges)
r' where
nextLayersState :: LayersState
nextLayersState = OwlPFState
-> LayersState -> Int -> LockHideCollapseOp -> LayersState
toggleLayerEntry OwlPFState
pfs LayersState
ls Int
lepos LockHideCollapseOp
LHCO_ToggleHide
hideChanges :: SuperOwlChanges
hideChanges = OwlPFState -> LayersState -> Int -> SuperOwlChanges
changesFromToggleHide OwlPFState
pfs LayersState
nextLayersState Int
lepos
r' :: (LayerDragState, Maybe LayersState, SuperOwlChanges)
r' = (LayerDownType -> LayerDragState
LDS_Option LayerDownType
LDT_Hide, LayersState -> Maybe LayersState
forall a. a -> Maybe a
Just (LayersState -> Maybe LayersState)
-> LayersState -> Maybe LayersState
forall a b. (a -> b) -> a -> b
$ LayersState
nextLayersState, SuperOwlChanges
hideChanges)
LayerDownType
LDT_Lock -> (LayerDownType -> LayerDragState
LDS_Option LayerDownType
LDT_Lock, LayersState -> Maybe LayersState
forall a. a -> Maybe a
Just (LayersState -> Maybe LayersState)
-> LayersState -> Maybe LayersState
forall a b. (a -> b) -> a -> b
$ OwlPFState
-> LayersState -> Int -> LockHideCollapseOp -> LayersState
toggleLayerEntry OwlPFState
pfs LayersState
ls Int
lepos LockHideCollapseOp
LHCO_ToggleLock, SuperOwlChanges
forall a. IntMap a
IM.empty)
LayerDownType
LDT_Collapse -> (LayerDownType -> LayerDragState
LDS_Option LayerDownType
LDT_Collapse, LayersState -> Maybe LayersState
forall a. a -> Maybe a
Just (LayersState -> Maybe LayersState)
-> LayersState -> Maybe LayersState
forall a b. (a -> b) -> a -> b
$ OwlPFState
-> LayersState -> Int -> LockHideCollapseOp -> LayersState
toggleLayerEntry OwlPFState
pfs LayersState
ls Int
lepos LockHideCollapseOp
LHCO_ToggleCollapse, SuperOwlChanges
forall a. IntMap a
IM.empty)
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler lh {
_layersHandler_dragState = nextDragState
, _layersHandler_cursorPos = _mouseDrag_to
, _layersHandler_dropSpot = Nothing
}
, _potatoHandlerOutput_action = case mNextLayerState of
Maybe LayersState
Nothing -> HandlerOutputAction
HOA_Nothing
Just LayersState
nextLayersState -> LayersState -> SuperOwlChanges -> HandlerOutputAction
HOA_Layers LayersState
nextLayersState SuperOwlChanges
changes
}
(MouseDragState
MouseDragState_Down, LayerDragState
_) -> Text -> Maybe PotatoHandlerOutput
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
(SuperOwl, Int) -> Maybe (SuperOwl, Int)
forall a. a -> Maybe a
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 -> Int -> Seq LayerEntry -> Maybe LayerEntry
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq LayerEntry -> Int
forall a. Seq a -> Int
Seq.length Seq LayerEntry
lentries Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq LayerEntry
lentries
Just (SuperOwl, Int)
_ -> Int -> Seq LayerEntry -> Maybe LayerEntry
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Int
leposInt -> Int -> Int
forall 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 -> Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen"
Just SuperOwl
asowl -> Int
rawxoffset Int -> Int -> Int
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 -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x (SuperOwl -> Int
superOwl_depth SuperOwl
dsowl Int -> Int -> Int
forall a. Num a => a -> a -> a
- SuperOwl -> Int
superOwl_depth SuperOwl
asowl)
nsibling :: Int
nsibling = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (- (Int -> Int -> Int
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 LayersHandlerRenderEntryDots
forall a. Maybe a
Nothing
Just SuperOwl
asowl -> if Int
nparentoffset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& SuperOwl -> Bool
forall o. HasOwlItem o => o -> Bool
hasOwlItem_isFolder SuperOwl
asowl
then Int -> LayersHandlerRenderEntryDots -> OwlSpot
OwlSpot (SuperOwl -> Int
_superOwl_id SuperOwl
asowl) LayersHandlerRenderEntryDots
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> LayersHandlerRenderEntryDots
forall a. Maybe a
Nothing
Int
x -> Int -> LayersHandlerRenderEntryDots
forall a. a -> Maybe a
Just Int
x
isSpotValid :: Bool
isSpotValid = Bool
True
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler lh {
_layersHandler_cursorPos = _mouseDrag_to
, _layersHandler_dropSpot = if isSpotValid then Just targetspot else Nothing
}
}
(MouseDragState
MouseDragState_Dragging, LayerDragState
_) -> 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 lh {
_layersHandler_cursorPos = _mouseDrag_to
, _layersHandler_dropSpot = Nothing
}
}
(MouseDragState
MouseDragState_Up, LDS_Selecting Int
leposdown) -> Maybe PotatoHandlerOutput
r where
shift :: Bool
shift = KeyModifier -> [KeyModifier] -> Bool
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 (LayerEntry -> SuperOwl) -> LayerEntry -> SuperOwl
forall a b. (a -> b) -> a -> b
$ Seq LayerEntry -> Int -> LayerEntry
forall a. Seq a -> Int -> a
Seq.index Seq LayerEntry
lentries Int
leposdown
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler (resetLayersHandler lh)
, _potatoHandlerOutput_action = HOA_Select shift (SuperOwlParliament $ Seq.singleton sowl)
}
(MouseDragState
MouseDragState_Up, LayerDragState
LDS_Dragging) | Maybe OwlSpot -> Bool
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 -> Text -> Maybe PotatoHandlerOutput
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
titleOffset -> Maybe PotatoHandlerOutput
r where
zipper :: TextZipper
zipper = Text -> TextZipper
TZ.fromText (Text -> TextZipper) -> Text -> TextZipper
forall a b. (a -> b) -> a -> b
$ SuperOwl -> Text
forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
downsowl
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersRenameHandler -> PotatoHandlerOutput
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
_ -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly (LayersHandler -> LayersHandler
resetLayersHandler LayersHandler
lh)
(MouseDragState
MouseDragState_Up, LayerDragState
LDS_Dragging) -> Maybe PotatoHandlerOutput
r where
mllama :: Maybe Llama
mllama = 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
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isSpotValid
return $ OwlPFState -> (OwlSpot, OwlParliament) -> Llama
moveEltLlama OwlPFState
pfs (OwlSpot
modifiedSpot, Selection -> OwlParliament
superOwlParliament_toOwlParliament Selection
selection)
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler (resetLayersHandler lh)
, _potatoHandlerOutput_action = maybe HOA_Nothing (HOA_Preview . Preview PO_StartAndCommit) mllama
}
(MouseDragState
MouseDragState_Up, LDS_Option LayerDownType
_) -> 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 (resetLayersHandler lh)
}
(MouseDragState
MouseDragState_Up, LayerDragState
LDS_None) -> 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 (resetLayersHandler lh)
, _potatoHandlerOutput_action = HOA_Select False isParliament_empty
}
(MouseDragState
MouseDragState_Cancelled, LayerDragState
_) -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersHandler -> PotatoHandlerOutput
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]
_ -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersHandler -> PotatoHandlerInput -> Int -> PotatoHandlerOutput
forall h.
PotatoHandler h =>
h -> PotatoHandlerInput -> Int -> PotatoHandlerOutput
handleScroll LayersHandler
lh PotatoHandlerInput
phi Int
scroll
KeyboardData
_ -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pIsHandlerActive :: LayersHandler -> HandlerActiveState
pIsHandlerActive LayersHandler {Maybe OwlSpot
XY
LayerDragState
_layersHandler_dragState :: LayersHandler -> LayerDragState
_layersHandler_cursorPos :: LayersHandler -> XY
_layersHandler_dropSpot :: LayersHandler -> Maybe OwlSpot
_layersHandler_dragState :: LayerDragState
_layersHandler_cursorPos :: XY
_layersHandler_dropSpot :: Maybe OwlSpot
..} = if LayerDragState
_layersHandler_dragState LayerDragState -> LayerDragState -> Bool
forall a. Eq a => a -> a -> Bool
/= LayerDragState
LDS_None then HandlerActiveState
HAS_Active_Mouse else HandlerActiveState
HAS_Inactive
pRefreshHandler :: LayersHandler -> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler LayersHandler
h PotatoHandlerInput
_ = SomePotatoHandler -> Maybe SomePotatoHandler
forall a. a -> Maybe a
Just (SomePotatoHandler -> Maybe SomePotatoHandler)
-> SomePotatoHandler -> Maybe SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ LayersHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler LayersHandler
h
pRenderLayersHandler :: LayersHandler
-> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler LayersHandler {Maybe OwlSpot
XY
LayerDragState
_layersHandler_dragState :: LayersHandler -> LayerDragState
_layersHandler_cursorPos :: LayersHandler -> XY
_layersHandler_dropSpot :: LayersHandler -> Maybe OwlSpot
_layersHandler_dragState :: LayerDragState
_layersHandler_cursorPos :: XY
_layersHandler_dropSpot :: Maybe OwlSpot
..} 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
..} = 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 Int -> Int -> Bool
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 LayersHandlerRenderEntryDots
forall a. Maybe a
Nothing LayersHandlerRenderEntryRenaming
forall a. Maybe a
Nothing LayerEntry
lentry
normalcase :: (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
normalcase = if LayerEntry -> Bool
isSelected LayerEntry
lentry
then (Int -> LayersHandlerRenderEntryDots
forall a. a -> Maybe a
Just (LayerEntry -> Int
layerEntry_depth LayerEntry
lentry), LayersHandlerRenderEntrySelectedState -> LayersHandlerRenderEntry
makelentry LayersHandlerRenderEntrySelectedState
LHRESS_Selected)
else (LayersHandlerRenderEntryDots
forall a. Maybe a
Nothing, LayersHandlerRenderEntrySelectedState -> LayersHandlerRenderEntry
makelentry LayersHandlerRenderEntrySelectedState
LHRESS_None)
(LayersHandlerRenderEntryDots
_,Seq LayersHandlerRenderEntry
newlentries1) = (LayersHandlerRenderEntryDots
-> LayerEntry
-> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry))
-> LayersHandlerRenderEntryDots
-> Seq LayerEntry
-> (LayersHandlerRenderEntryDots, Seq LayersHandlerRenderEntry)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL LayersHandlerRenderEntryDots
-> LayerEntry
-> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
mapaccumlfn_forselection LayersHandlerRenderEntryDots
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noOwl -> (LayersHandlerRenderEntryDots
-> (Int -> LayersHandlerRenderEntryDots)
-> LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntryDots
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LayersHandlerRenderEntryDots
forall a. Maybe a
Nothing Int -> LayersHandlerRenderEntryDots
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 -> (Int -> LayersHandlerRenderEntryDots
forall a. a -> Maybe a
Just Int
x, Bool
False)
Just Int
s -> (Int -> LayersHandlerRenderEntryDots
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 LayersHandlerRenderEntry
-> Seq LayersHandlerRenderEntry -> Seq LayersHandlerRenderEntry
forall a. a -> Seq a -> Seq a
<| Seq LayersHandlerRenderEntry
newlentries1
Just Int
leftmostid -> Seq LayersHandlerRenderEntry
r' where
(Int
index, Int
depth) = case (LayerEntry -> Bool)
-> Seq LayerEntry -> LayersHandlerRenderEntryDots
forall a. (a -> Bool) -> Seq a -> LayersHandlerRenderEntryDots
Seq.findIndexL (\LayerEntry
lentry -> SuperOwl -> Int
_superOwl_id (LayerEntry -> SuperOwl
_layerEntry_superOwl LayerEntry
lentry) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
leftmostid) Seq LayerEntry
lentries of
LayersHandlerRenderEntryDots
Nothing -> Text -> (Int, Int)
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> (Int, Int)) -> Text -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Text
"expected to find id " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
leftmostid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Seq LayerEntry -> Text
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 (Seq LayerEntry -> Int -> LayerEntry
forall a. Seq a -> Int -> a
Seq.index Seq LayerEntry
lentries Int
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
samelevel then Int
0 else Int
1)
noskiplentries :: Seq LayerEntry
noskiplentries = Int -> Seq LayerEntry -> Seq LayerEntry
forall a. Int -> Seq a -> Seq a
Seq.drop (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Seq LayerEntry -> Seq LayerEntry)
-> Seq LayerEntry -> Seq LayerEntry
forall a b. (a -> b) -> a -> b
$ Seq LayerEntry
lentries
skippedlentries :: Seq LayerEntry
skippedlentries = (LayerEntry -> Bool) -> Seq LayerEntry -> Seq LayerEntry
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileL (\LayerEntry
lentry -> LayerEntry -> Int
layerEntry_depth LayerEntry
lentry Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
depth') (Seq LayerEntry -> Seq LayerEntry)
-> Seq LayerEntry -> Seq LayerEntry
forall a b. (a -> b) -> a -> b
$ Seq LayerEntry
noskiplentries
skipped :: Int
skipped = if Bool
samelevel then Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq LayerEntry -> Int
forall a. Seq a -> Int
Seq.length Seq LayerEntry
skippedlentries else Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
r' :: Seq LayersHandlerRenderEntry
r' = Int
-> LayersHandlerRenderEntry
-> Seq LayersHandlerRenderEntry
-> Seq LayersHandlerRenderEntry
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 -> (Int -> LayersHandlerRenderEntryDots
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
x
then (LayersHandlerRenderEntryDots
mdropdepth, LayersHandlerRenderEntrySelectedState
-> LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntryRenaming
-> LayerEntry
-> LayersHandlerRenderEntry
LayersHandlerRenderEntryNormal LayersHandlerRenderEntrySelectedState
s (Int -> LayersHandlerRenderEntryDots
forall a. a -> Maybe a
Just Int
x) LayersHandlerRenderEntryRenaming
forall a. Maybe a
Nothing LayerEntry
lentry)
else (LayersHandlerRenderEntryDots
forall a. Maybe a
Nothing, LayersHandlerRenderEntry
lhre)
LayersHandlerRenderEntry
_ -> Text -> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"unexpected LayersHandlerRenderEntryDummy"
(LayersHandlerRenderEntryDots
_, Seq LayersHandlerRenderEntry
newlentries3) = (LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntry
-> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry))
-> LayersHandlerRenderEntryDots
-> Seq LayersHandlerRenderEntry
-> (LayersHandlerRenderEntryDots, Seq LayersHandlerRenderEntry)
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR LayersHandlerRenderEntryDots
-> LayersHandlerRenderEntry
-> (LayersHandlerRenderEntryDots, LayersHandlerRenderEntry)
mapaccumrfn_fordots LayersHandlerRenderEntryDots
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lastdepth
then (Bool
False, Bool
selectedBool -> [Bool] -> [Bool]
forall 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
TrueBool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:[Bool]
xs)
else if Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lastdepth
then case [Bool]
selstack of
[] -> Text -> (Bool, [Bool])
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) Bool -> [Bool] -> [Bool]
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) = (([Bool], Int)
-> LayersHandlerRenderEntry
-> (([Bool], Int), LayersHandlerRenderEntry))
-> ([Bool], Int)
-> Seq LayersHandlerRenderEntry
-> (([Bool], Int), Seq LayersHandlerRenderEntry)
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 -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ Char -> TextZipper -> TextZipper
TZ.insertChar Char
' '
KeyboardKey_Char Char
k | Char -> Bool
isValidLayerRenameChar Char
k -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ Char -> TextZipper -> TextZipper
TZ.insertChar Char
k
KeyboardKey
KeyboardKey_Backspace -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.deleteLeft
KeyboardKey
KeyboardKey_Delete -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.deleteRight
KeyboardKey
KeyboardKey_Left -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.left
KeyboardKey
KeyboardKey_Right -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.right
KeyboardKey
KeyboardKey_Home -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ TextZipper -> TextZipper
TZ.home
KeyboardKey
KeyboardKey_End -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
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 -> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a. a -> Maybe a
Just ((TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper))
-> (TextZipper -> TextZipper) -> Maybe (TextZipper -> TextZipper)
forall a b. (a -> b) -> a -> b
$ Text -> TextZipper -> TextZipper
TZ.insert Text
t
KeyboardKey
_ -> Maybe (TextZipper -> TextZipper)
forall a. Maybe a
Nothing
renameToAndReturn :: LayersRenameHandler -> Text -> PotatoHandlerOutput
renameToAndReturn :: LayersRenameHandler -> Text -> PotatoHandlerOutput
renameToAndReturn LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_index :: Int
_layersRenameHandler_zipper :: TextZipper
..} Text
newName = PotatoHandlerOutput
r where
controller :: DSum CTag Identity
controller = CTag CRename
CTagRename CTag CRename -> Identity CRename -> DSum CTag Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> (CRename -> Identity CRename
forall a. a -> Identity a
Identity (CRename -> Identity CRename) -> CRename -> Identity CRename
forall a b. (a -> b) -> a -> b
$ CRename {
_cRename_deltaLabel :: DeltaText
_cRename_deltaLabel = (SuperOwl -> Text
forall o. HasOwlItem o => o -> Text
hasOwlItem_name SuperOwl
_layersRenameHandler_renaming, Text
newName)
})
r :: PotatoHandlerOutput
r = PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler _layersRenameHandler_original
, _potatoHandlerOutput_action = HOA_Preview $ Preview PO_StartAndCommit $ makePFCLlama . OwlPFCManipulate $ IM.fromList [(_superOwl_id _layersRenameHandler_renaming,controller)]
}
toDisplayLines :: LayersRenameHandler -> TZ.DisplayLines ()
toDisplayLines :: LayersRenameHandler -> DisplayLines ()
toDisplayLines LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_index :: Int
_layersRenameHandler_zipper :: TextZipper
..} = TextAlignment -> Int -> () -> () -> TextZipper -> DisplayLines ()
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_original :: LayersRenameHandler -> LayersHandler
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_index :: Int
_layersRenameHandler_zipper :: TextZipper
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = let
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) = Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
rawxoffset (Int
rawlepos Int -> Int -> Int
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 Int -> Int -> Bool
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 -> Text -> Int
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen"
Just (SuperOwl
_, LayerDownType
_, Int
xoff) -> Int
xoff Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
layerJunkOffset
dl :: DisplayLines ()
dl = LayersRenameHandler -> DisplayLines ()
toDisplayLines LayersRenameHandler
lh
nexttz :: TextZipper
nexttz = Int -> Int -> DisplayLines () -> TextZipper -> TextZipper
forall tag.
Int -> Int -> DisplayLines tag -> TextZipper -> TextZipper
TZ.goToDisplayLinePosition Int
xpos Int
0 DisplayLines ()
dl TextZipper
_layersRenameHandler_zipper
r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler lh {
_layersRenameHandler_zipper = nexttz
}
}
MouseDragState
MouseDragState_Dragging -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersRenameHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersRenameHandler
lh
MouseDragState
MouseDragState_Up -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersRenameHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersRenameHandler
lh
MouseDragState
_ -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
mpho' :: Maybe PotatoHandlerOutput
mpho' = LayersHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
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 -> Text -> PotatoHandlerOutput
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen..."
Just PotatoHandlerOutput
pho' -> PotatoHandlerOutput
pho' { _potatoHandlerOutput_action = _potatoHandlerOutput_action pho'' }
pHandleKeyboard :: LayersRenameHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard lh :: LayersRenameHandler
lh@LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_index :: Int
_layersRenameHandler_zipper :: TextZipper
..} 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
kbd = case KeyboardData
kbd of
KeyboardData KeyboardKey
_ [KeyModifier
KeyModifier_Ctrl] -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersRenameHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersRenameHandler
lh
KeyboardData KeyboardKey
KeyboardKey_Return [] -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersRenameHandler -> Text -> PotatoHandlerOutput
renameToAndReturn LayersRenameHandler
lh (TextZipper -> Text
TZ.value TextZipper
_layersRenameHandler_zipper)
KeyboardData KeyboardKey
KeyboardKey_Esc [] -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly LayersHandler
_layersRenameHandler_original
KeyboardData (KeyboardKey_Scroll Int
scroll) [KeyModifier]
_ -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ LayersRenameHandler
-> PotatoHandlerInput -> Int -> PotatoHandlerOutput
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 -> Maybe PotatoHandlerOutput
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 = 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 lh {
_layersRenameHandler_zipper = nexttz
}
}
KeyboardData
_ -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
pRefreshHandler :: LayersRenameHandler
-> PotatoHandlerInput -> Maybe SomePotatoHandler
pRefreshHandler LayersRenameHandler
h PotatoHandlerInput
_ = SomePotatoHandler -> Maybe SomePotatoHandler
forall a. a -> Maybe a
Just (SomePotatoHandler -> Maybe SomePotatoHandler)
-> SomePotatoHandler -> Maybe SomePotatoHandler
forall a b. (a -> b) -> a -> b
$ LayersRenameHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler LayersRenameHandler
h
pIsHandlerActive :: LayersRenameHandler -> HandlerActiveState
pIsHandlerActive LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_index :: Int
_layersRenameHandler_zipper :: TextZipper
..} = HandlerActiveState
HAS_Active_Keyboard
pRenderLayersHandler :: LayersRenameHandler
-> PotatoHandlerInput -> LayersViewHandlerRenderOutput
pRenderLayersHandler LayersRenameHandler {Int
TextZipper
SuperOwl
LayersHandler
_layersRenameHandler_original :: LayersRenameHandler -> LayersHandler
_layersRenameHandler_renaming :: LayersRenameHandler -> SuperOwl
_layersRenameHandler_index :: LayersRenameHandler -> Int
_layersRenameHandler_zipper :: LayersRenameHandler -> TextZipper
_layersRenameHandler_original :: LayersHandler
_layersRenameHandler_renaming :: SuperOwl
_layersRenameHandler_index :: Int
_layersRenameHandler_zipper :: TextZipper
..} 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
..} = LayersViewHandlerRenderOutput
r where
r' :: LayersViewHandlerRenderOutput
r' = LayersHandler
-> PotatoHandlerInput -> LayersViewHandlerRenderOutput
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 (TextZipper -> LayersHandlerRenderEntryRenaming
forall a. a -> Maybe a
Just TextZipper
_layersRenameHandler_zipper) LayerEntry
lentry where
adjustfn (LayersHandlerRenderEntryDummy Int
_) = Text -> LayersHandlerRenderEntry
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen"
entries :: Seq LayersHandlerRenderEntry
entries = (LayersHandlerRenderEntry -> LayersHandlerRenderEntry)
-> Int
-> Seq LayersHandlerRenderEntry
-> Seq LayersHandlerRenderEntry
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 }