{-# 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

-- TODO we could probably change this to do a more efficient binary search based on position in hierarchy
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
  -- TODO share this code with other handler
  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
      -- TODO clamp based on number of entries
      , _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
  }



--TODO need to reorder so it becomes undo friendly here I think? (uhh, pretty sure it's ok to delete this TODO? should be ordered by assumption)
-- TODO assert elts are valid
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)


-- spot is invalid if it's a descendent of a already selected element
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

  -- we incorrectly reuse RelMouseDrag for LayersHandler even though LayersHandler doesn't care about canvas pan coords
  -- pan offset should always be set to 0 in RelMouseDrag
  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)
          -- (you can only click + drag selected elements)
          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)
              -- TODO check if element is descendent of selected element and return LDS_None if so
              -- if element wasn't selected or shift is held down, enter selection mode
              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)

            -- DELETE
            -- this variant denies selecting children of selected parents but not the other way around...
            -- maybe easier to deny this at a higher level rather than here.
            {-
            LDT_Normal -> if shift
              then if exclusivedescendent
                -- element is descendent of selection and therefore do not allow selecting
                then (LDS_None, Nothing, IM.empty)
                else (LDS_Selecting lepos, Nothing, IM.empty)
              else if not isselected
                then if exclusivedescendent
                  -- element is descendent of selection and therefore do not allow selecting (TODO consider alternatively, enter dragging mode)
                  then (LDS_None, Nothing, IM.empty)
                  -- enter selection mode
                  else (LDS_Selecting lepos, Nothing, IM.empty)
                -- entry dragging mode
              else (LDS_Dragging, Nothing, IM.empty)
              where
                rid = _superOwl_id downsowl
                selectionset = superOwlParliament_toOwlParliamentSet selection
                isselected = owlParliamentSet_member rid selectionset
                exclusivedescendent = owlParliamentSet_descendent owltree rid selectionset && not isselected
            -}

            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

        -- we will always place between dropSowl and justAboveDropSowl
        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"
            -- we are at the very bottom
            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
            -- we are at the very top
            Maybe SuperOwl
Nothing    -> Int
0
            -- limit how deep in the hierarchy we can move based on what's below the cursor
            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
          -- we are dropping at the top of our LayerEntries
          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
            -- drop inside at the top
            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

        -- check if spot is valid
        -- instead we do this check when we drop instead, that behavior "felt" nicer to me even though this is probably more correct
        --SuperOwlParliament selectedsowls = _potatoHandlerInput_selection
        --isSpotValid = isSpotValidToDrop owltree _potatoHandlerInput_selection spot
        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
            }
        }

      -- TODO someday do drag for multi-select here
      (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)
          }

      -- NOTE this will not work on inherit selected children, feature or bug??
      -- we clicked and released on a selected element, enter renaming mode
      (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 "
        -- (you can only click + drag selected elements)
        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

            -- TODO great place for TZ.selectAll when you add selection capability into TZ
            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)






      -- TODO when we have multi-user mode, we'll want to test if the target drop space is still valid
      (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

            -- TODO modify if we drag on top of existing elt... Is there anything to do here? I can't remember why I added this comment. Pretty sure there's nothing to do
            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)

          -- deselect everything 
          , _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

  --pRenderHandler lh@LayersHandler {..} PotatoHandlerInput {..} = emptyHandlerRenderOutput

  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

  -- TODO this is incorrect, we may be in the middle of dragging elements that got deleted
  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

  -- TODO generate LHRESS_ChildSelected
  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
    --pfs = _potatoHandlerInput_pFState
    --owltree = (_owlPFState_owlTree pfs)

    -- TODO would also be best to cache this in LayerState since it's also used by other operations...
    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
    -- perhaps linear search is faster for smaller sets though
    --isSelected lentry = doesSelectionContainREltId_linear (_superOwl_id $ _layerEntry_superOwl lentry) selection

    -- update the selected state
    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
        -- dot depth will be filled in later
        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

    -- next insert the drop spot
    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
            -- TODO you could probably do this more efficiently with a very bespoke fold but whatever
            (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

    -- finally add the dots indicating drop spot depth
    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

    -- determine parents of selection
    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]) -- this happens if on the first element that we mapAccumR on
            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 -- LayerEntries index of what we are renaming
    , 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 -- only allow ' ' for whitespace character
  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

-- TODO this should be configurable
-- hardcoded offset to the <elt name> e.g. " ea 𐂂 <elt name>"
layerJunkOffset :: Int
layerJunkOffset :: Int
layerJunkOffset = Int
7

-- TODO confirm/cancel if click off the one we are renaming, cancle handler and pass input onto the replacement (see TODO in GoatWidget)
instance PotatoHandler LayersRenameHandler where
  pHandlerName :: LayersRenameHandler -> Text
pHandlerName LayersRenameHandler
_ = Text
handlerName_layersRename

  -- we incorrectly reuse RelMouseDrag for LayersHandler even though LayersHandler doesn't care about canvas pan coords
  -- pan offset should always be set to 0 in RelMouseDrag
  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
              }
          }
      -- TODO drag + select when it's implemented in TZ
      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
        -- we want to pass output to original hanler
        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
        -- but we also want to return a rename event
        pho'' :: PotatoHandlerOutput
pho'' = LayersRenameHandler -> Text -> PotatoHandlerOutput
renameToAndReturn LayersRenameHandler
lh (TextZipper -> Text
TZ.value TextZipper
_layersRenameHandler_zipper)
        -- so just do both and sketch combine the results... probably ok...
        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
    -- don't allow ctrl shortcuts while renaming
    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

  -- TODO this is incorrect, we may be in the middle of renaming elements that got deleted
  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


  -- TODO render renaming stuff (or do we do this in pRenderLayersHandler?)
  --pRenderHandler lh@LayersRenameHandler {..} PotatoHandlerInput {..} = emptyHandlerRenderOutput

  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'

    -- PROBLEM you want to do some hcropping on the zipper but you don't know how much to crop by because width is unknown
    -- solution 1: align right
    -- solution 2: take over entire row from very left
    -- solution 3: ignore, user may need to resize layers area
    -- we will just do solution 3 cuz it's easiest
    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 }