diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,7 @@ ## [Unreleased] -## [0.0.1] -### Added -- tinytools +## [0.1.0.4] +### Changed +- handlers return `Previews` instead of relying on `undoFirst` and `LlamaStack` +- many other improvements diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,16 +1,17 @@ # tinytools -`tinytools` is a mono-space unicode flow-chart editor written in Haskell. +`tinytools` is a mono-space unicode diagram editor written in Haskell. # architecture -`tinytools` follows a strict MVC architecture. This repository contains the platform-independent model and controller. +`tinytools` follows a strict MVC architecture. This repository contains the model and controller. The view/controller is connected to the model using a [reflex](https://github.com/reflex-frp/reflex) interface defined by `GoatWidget`. -[tinytools-vty](https://github.com/pdlla/tinytools-vty) is currently the only view implementation. It is written in [reflex-vty](https://github.com/reflex-frp/reflex-vty) and runs in a terminal yay. Please see [tinytools-vty](https://github.com/pdlla/tinytools-vty) if you'd like to try it out. +[tinytools-vty](https://github.com/minimapletinytools/tinytools-vty) is currently the only view implementation. It is written in [reflex-vty](https://github.com/reflex-frp/reflex-vty) and runs in a terminal yay. Please see [tinytools-vty](https://github.com/minimapletinytools/tinytools-vty). -# features (completed) +# features +- modern and intuitive UI/UX +- several highly configurable primitives including boxes, lines and text boxes - sophisticated hierarchical layer system - transactional operations and change history -- several highly configurable primitives including boxes, lines and text boxes - basic document save/load/export functionality # roadmap @@ -21,7 +22,7 @@ ## v2 - multi-document support -- refactor handle non-linear action do/undo operations in preparation for multi-user mode +- refactor to handle non-linear action do/undo operations in preparation for multi-user mode ## v3 - grapheme clusters support (blocked by terminal support which is currently extremely inconsistent or non-existent) diff --git a/src/Potato/Data/Text/Unicode.hs b/src/Potato/Data/Text/Unicode.hs --- a/src/Potato/Data/Text/Unicode.hs +++ b/src/Potato/Data/Text/Unicode.hs @@ -3,8 +3,6 @@ import Prelude -import Graphics.Text.Width (wcwidth) - import Data.Int import Data.Text (Text) import qualified Data.Text as T diff --git a/src/Potato/Data/Text/Zipper.hs b/src/Potato/Data/Text/Zipper.hs --- a/src/Potato/Data/Text/Zipper.hs +++ b/src/Potato/Data/Text/Zipper.hs @@ -12,11 +12,12 @@ import Prelude import Control.Exception (assert) -import Control.Monad.State (evalState, forM, get, put) +import Control.Monad.State (evalState, get, put) import Data.Char (isSpace) import Data.Map (Map) -import Data.Maybe (fromMaybe) import Data.String +import Control.Monad + import Data.Text (Text) import Data.Text.Internal (Text(..), text) import Data.Text.Internal.Fusion (stream) @@ -215,10 +216,12 @@ deriving (Eq, Show) -- | Information about the document as it is displayed (i.e., post-wrapping) -data DisplayLines tag = DisplayLines - { _displayLines_spans :: [[Span tag]] - , _displayLines_offsetMap :: OffsetMapWithAlignment - , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner +data DisplayLines tag = DisplayLines { + -- NOTE this will contain a dummy ' ' character if the cursor is at the end + _displayLines_spans :: [[Span tag]] + -- NOTE this will not include offsets for the y position of dummy ' ' character if it is on its own line + , _displayLines_offsetMap :: OffsetMapWithAlignment + , _displayLines_cursorPos :: (Int, Int) -- cursor position relative to upper left hand corner } deriving (Eq, Show) @@ -235,11 +238,15 @@ in (text arr off k, text arr (off+k) (len-k)) toLogicalIndex :: Int -> Text -> Int -toLogicalIndex n' t'@(Text _ _ len') = loop 0 0 - where loop !i !cnt - | i >= len' || cnt + w > n' = i - | otherwise = loop (i+d) (cnt + w) - where Iter c d = iter t' i +toLogicalIndex n' t'@(Text _ _ len') = loop 0 0 0 + where loop !iteri !li !cumw + -- if we've gone past the last byte + | iteri >= len' = li-1 + -- if we hit our target + | cumw + w > n' = li + -- advance one character + | otherwise = loop (iteri+d) (li+1) (cumw + w) + where Iter c d = iter t' iteri w = charWidth c -- | Takes the given number of columns of characters. For example @@ -340,7 +347,6 @@ loop (x:xs) cumw out = r where newWidth = textWidth x + cumw r = if newWidth > maxWidth - -- TODO index out of bounds sometimes in the presence of widechars then if isSpace $ T.index x (toLogicalIndex (maxWidth - cumw) x) -- if line runs over but character of splitting is whitespace then split on the whitespace then let (t1,t2) = splitAtWidth (maxWidth - cumw) x @@ -355,6 +361,20 @@ + +alignmentOffset :: + TextAlignment + -> Int + -> Text + -> Int +alignmentOffset alignment maxWidth t = case alignment of + TextAlignment_Left -> 0 + TextAlignment_Right -> (maxWidth - l) + TextAlignment_Center -> (maxWidth - l) `div` 2 + where + l = textWidth t + + -- | Wraps a logical line of text to fit within the given width. The first -- wrapped line is offset by the number of columns provided. Subsequent wrapped -- lines are not. @@ -366,12 +386,12 @@ -> [WrappedLine] -- (words on that line, hidden space char, offset from beginning of line) wrapWithOffsetAndAlignment _ maxWidth _ _ | maxWidth <= 0 = [] wrapWithOffsetAndAlignment alignment maxWidth n txt = assert (n <= maxWidth) r where - r' = splitWordsAtDisplayWidth maxWidth $ wordsWithWhitespace ( T.replicate n "." <> txt) - fmapfn (t,b) = case alignment of - TextAlignment_Left -> WrappedLine t b 0 - TextAlignment_Right -> WrappedLine t b (maxWidth-l) - TextAlignment_Center -> WrappedLine t b ((maxWidth-l) `div` 2) - where l = textWidth t + r' = if T.null txt + then [("",False)] + -- I'm not sure why this is working, the "." padding will mess up splitWordsAtDisplayWidth for the next line if a single line exceeds the display width (but it doesn't) + -- it should be `T.replicate n " "` instead (which also works but makes an extra "" Wrappedline somewhere) + else splitWordsAtDisplayWidth maxWidth $ wordsWithWhitespace ( T.replicate n "." <> txt) + fmapfn (t,b) = WrappedLine t b $ alignmentOffset alignment maxWidth t r'' = case r' of [] -> [] (x,b):xs -> (T.drop n x,b):xs @@ -379,7 +399,7 @@ -- converts deleted eol spaces into logical lines eolSpacesToLogicalLines :: [[WrappedLine]] -> [[(Text, Int)]] -eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . ((L.groupBy (\(WrappedLine _ b _) _ -> not b)) =<<) +eolSpacesToLogicalLines = fmap (fmap (\(WrappedLine a _ c) -> (a,c))) . concatMap (L.groupBy (\(WrappedLine _ b _) _ -> not b)) offsetMapWithAlignmentInternal :: [[WrappedLine]] -> OffsetMapWithAlignment offsetMapWithAlignmentInternal = offsetMapWithAlignment . eolSpacesToLogicalLines @@ -414,7 +434,8 @@ -> TextZipper -- ^ The text input contents and cursor state -> DisplayLines tag displayLinesWithAlignment alignment width tag cursorTag (TextZipper lb b a la) = - let linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line + let + linesBefore :: [[WrappedLine]] -- The wrapped lines before the cursor line linesBefore = map (wrapWithOffsetAndAlignment alignment width 0) $ reverse lb linesAfter :: [[WrappedLine]] -- The wrapped lines after the cursor line linesAfter = map (wrapWithOffsetAndAlignment alignment width 0) la @@ -434,75 +455,61 @@ -- * spans that are on earlier display lines (though on the same logical line), and -- * spans that are on the same display line - (spansCurrentBefore, spansCurLineBefore) = fromMaybe ([], []) $ - initLast $ map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width 0 b) - -- Calculate the number of columns on the cursor's display line before the cursor - curLineOffset = spansWidth spansCurLineBefore - -- Check whether the spans on the current display line are long enough that - -- the cursor has to go to the next line - cursorAfterEOL = curLineOffset == width - cursorCharWidth = case T.uncons a of - Nothing -> 1 - Just (c, _) -> charWidth c + -- do the current line + curlinetext = b <> a + curwrappedlines = (wrapWithOffsetAndAlignment alignment width 0 curlinetext) + blength = T.length b - -- Separate the span after the cursor into - -- * spans that are on the same display line, and - -- * spans that are on later display lines (though on the same logical line) + -- map to spans and highlight the cursor + -- accumulator type (accumulated text length, Either (current y position) (cursor y and x position)) + --mapaccumlfn :: (Int, Either Int (Int, Int)) -> WrappedLine -> ((Int, Either Int (Int, Int)), [Span tag]) + mapaccumlfn (acclength, ecpos) (WrappedLine t dwseol xoff) = r where + tlength = T.length t + -- how many words we've gone through + nextacclength = acclength + tlength + if dwseol then 1 else 0 + nextacc = (nextacclength, nextecpos) + cursoroncurspan = nextacclength >= blength && (blength >= acclength) + charsbeforecursor = blength-acclength + ctlength = textWidth $ T.take charsbeforecursor t + cursorx = xoff + ctlength + nextecpos = case ecpos of + Left y -> if cursoroncurspan + then if ctlength == width + -- cursor wraps to next line case + then Right (y+1, 0) + else Right (y, cursorx) + else Left (y+1) + Right x -> Right x - (spansCurLineAfter, spansCurrentAfter) = fromMaybe ([], []) $ - headTail $ case T.uncons a of - Nothing -> [[Span cursorTag " "]] - Just (c, rest) -> - let o = if cursorAfterEOL then cursorCharWidth else curLineOffset + cursorCharWidth - cursor = Span cursorTag (T.singleton c) - in case map ((:[]) . Span tag) $ _wrappedLines_text <$> (wrapWithOffsetAndAlignment alignment width o rest) of - [] -> [[cursor]] - (l:ls) -> (cursor : l) : ls + beforecursor = T.take charsbeforecursor t + cursortext = T.take 1 $ T.drop charsbeforecursor t + aftercursor = T.drop (charsbeforecursor+1) t - curLineSpanNormalCase = if cursorAfterEOL - then [ spansCurLineBefore, spansCurLineAfter ] - else [ spansCurLineBefore <> spansCurLineAfter ] + cursorspans = [Span tag beforecursor, Span cursorTag cursortext] <> if T.null aftercursor then [] else [Span tag aftercursor] - -- for right alignment, we want draw the cursor tag to be on the character just before the logical cursor position - curLineSpan = if alignment == TextAlignment_Right && not cursorAfterEOL - then case reverse spansCurLineBefore of - [] -> curLineSpanNormalCase - (Span _ x):xs -> case spansCurLineAfter of - [] -> error "should not be possible" -- curLineSpanNormalCase - (Span _ y):ys -> [reverse (Span cursorTag x:xs) <> ((Span tag y):ys)] - else curLineSpanNormalCase + r = if cursoroncurspan + then (nextacc, cursorspans) + else (nextacc, [Span tag t]) + ((_, ecpos_out), curlinespans) = if T.null curlinetext + -- manually handle empty case because mapaccumlfn doesn't handle it + then ((0, Right (0, alignmentOffset alignment width "")), [[Span tag ""]]) + else L.mapAccumL mapaccumlfn (0, Left 0) curwrappedlines - cursorY = sum - [ length spansBefore - , length spansCurrentBefore - , if cursorAfterEOL then 1 else 0 - ] - -- a little silly to convert back to text but whatever, it works - cursorX = if cursorAfterEOL then 0 else textWidth (mconcat $ fmap (\(Span _ t) -> t) spansCurLineBefore) + (cursorY', cursorX) = case ecpos_out of + Right (y,x) -> (y,x) + -- if we never hit the cursor position, this means it's at the beginning of the next line + Left y -> (y+1, alignmentOffset alignment width "") + cursorY = cursorY' + length spansBefore in DisplayLines { _displayLines_spans = concat [ spansBefore - , spansCurrentBefore - , curLineSpan - , spansCurrentAfter + , curlinespans , spansAfter ] , _displayLines_offsetMap = offsets , _displayLines_cursorPos = (cursorX, cursorY) } - where - initLast :: [a] -> Maybe ([a], a) - initLast = \case - [] -> Nothing - (x:xs) -> case initLast xs of - Nothing -> Just ([], x) - Just (ys, y) -> Just (x:ys, y) - headTail :: [a] -> Maybe (a, [a]) - headTail = \case - [] -> Nothing - x:xs -> Just (x, xs) - -- | Move the cursor of the given 'TextZipper' to the logical position indicated -- by the given display line coordinates, using the provided 'DisplayLinesWithAlignment' diff --git a/src/Potato/Data/Text/Zipper2.hs b/src/Potato/Data/Text/Zipper2.hs --- a/src/Potato/Data/Text/Zipper2.hs +++ b/src/Potato/Data/Text/Zipper2.hs @@ -259,12 +259,16 @@ } deriving (Eq, Show) +-- TODO helper function to convert DisplayLines into lines before selection, selection lines, lines after selection + -- | Adjust the cursor and/or selection of the 'TextZipper' by the given display line coordinates -- If the x coordinate is beyond the start/end of a line, the cursor is moved to the start/end of that line respectively -- if `add` is true, the selection is expanded to the given position -- if `add` is false, the selection is cleared and the cursor is moved to the given position goToDisplayLinePosition :: Bool -> Int -> Int -> DisplayLines -> TextZipper -> TextZipper goToDisplayLinePosition add x y dl tz = undefined + + -- | Given a `TextAlignment`, a width and a 'TextZipper', produce a `DisplayLines` -- wrapping happens at word boundaries such that the most possible words fit into each display line -- if a line can not be wrapped (i.e. it contains a word longer than the display width) then the line is cropped in the middle of the word as necessary diff --git a/src/Potato/Flow/Attachments.hs b/src/Potato/Flow/Attachments.hs --- a/src/Potato/Flow/Attachments.hs +++ b/src/Potato/Flow/Attachments.hs @@ -18,13 +18,11 @@ import Potato.Flow.Math import Potato.Flow.OwlItem -import Potato.Flow.Owl import Potato.Flow.SElts import Potato.Flow.Methods.LineTypes import Data.List (minimumBy) import Data.Ratio -import Data.Tuple.Extra import Control.Exception (assert) @@ -39,6 +37,7 @@ type BoxWithAttachmentLocation = (LBox, AttachmentLocation, AttachmentOffsetRatio) +-- TODO there is a bug in cartRotationReflection_apply/cartRotationReflection_invert_apply where we don't actually apply the rotation but somehow this only works with that bug... Maybe the rotations cancel out? -- uh not sure if this is actually conjugation... attachLocationFromLBox_conjugateCartRotationReflection :: CartRotationReflection -> Bool -> BoxWithAttachmentLocation -> XY attachLocationFromLBox_conjugateCartRotationReflection crr offsetBorder (box, al, af) = r where @@ -48,7 +47,7 @@ -- NOTE assumes LBox is canonical attachLocationFromLBox :: Bool -> BoxWithAttachmentLocation -> XY attachLocationFromLBox True (lbx, al, af) = attachLocationFromLBox False (lBox_expand lbx (1,1,1,1), al, af) -attachLocationFromLBox offset (LBox (V2 x y) (V2 w h), al, af) = case al of +attachLocationFromLBox False (LBox (V2 x y) (V2 w h), al, af) = case al of AL_Top -> V2 (x+w * n `div` d) y AL_Bot -> V2 (x+(w-1) * dn `div` d) (y+h-1) AL_Left -> V2 x (y+(h-1) * dn `div` d ) @@ -96,7 +95,7 @@ _ -> [] isOverAttachment :: XY -> [(Attachment, XY)] -> Maybe (Attachment, XY) -isOverAttachment pos attachments = find (\(a,x) -> x == pos) attachments +isOverAttachment pos attachments = find (\(_,x) -> x == pos) attachments projectAttachment :: AttachmentLocation -> XY -> REltId -> LBox -> Maybe (Attachment, XY) @@ -115,30 +114,30 @@ then (slidecomp - _cartSegment_rightOrBot, _cartSegment_rightOrBot) else (0, slidecomp) - pos@(V2 px py) = if _cartSegment_isVertical then V2 orthcomp paracomp else V2 paracomp orthcomp + pos2@(V2 px py) = if _cartSegment_isVertical then V2 orthcomp paracomp else V2 paracomp orthcomp segl = _cartSegment_rightOrBot - _cartSegment_leftOrTop - ratio = case al of + ratio2 = case al of AL_Top -> (px - _cartSegment_leftOrTop) % segl AL_Bot -> (_cartSegment_rightOrBot - px) % segl AL_Left -> (_cartSegment_rightOrBot - py) % segl AL_Right -> (py - _cartSegment_leftOrTop) % segl AL_Any -> error "unexpected" - r2 = (parad+orthd, (ratio, pos), aa) + r2 = (parad+orthd, (ratio2, pos2), aa) rslts = fmap projdfn als cmpfn (d1, _, AvailableAttachment_CartSegment _ al1) (d2, _, AvailableAttachment_CartSegment _ al2) = compare d1 d2 <> compare (al2 == preval) (al1 == preval) - (d, (ratio, pos), AvailableAttachment_CartSegment _ al) = minimumBy cmpfn rslts + (d, (ratio1, pos1), AvailableAttachment_CartSegment _ alfinal) = minimumBy cmpfn rslts attachment = Attachment { _attachment_target = rid - , _attachment_location = al - , _attachment_offset_rel = ratio + , _attachment_location = alfinal + , _attachment_offset_rel = ratio1 } r = if d > 2 then Nothing - else Just $ (attachment, pos) + else Just $ (attachment, pos1) diff --git a/src/Potato/Flow/Configuration.hs b/src/Potato/Flow/Configuration.hs --- a/src/Potato/Flow/Configuration.hs +++ b/src/Potato/Flow/Configuration.hs @@ -7,12 +7,12 @@ import Potato.Data.Text.Unicode import Data.Default -import Data.Int import qualified Text.Show data PotatoConfiguration = PotatoConfiguration { _potatoConfiguration_allowGraphemeClusters :: Bool -- NOTE we don't support replacing grapheme clusters as this would require reverting past inputs - , _potatoConfiguration_allowOrReplaceUnicodeWideChars :: Maybe (Maybe Char) -- outer Maybe is if we allow, inner Maybe is what we replace with + -- TODO rename to disallow + , _potatoConfiguration_allowOrReplaceUnicodeWideChars :: Maybe (Maybe Char) -- outer Maybe is if we disallow, inner Maybe is what we replace with , _potatoConfiguration_unicodeWideCharFn :: Char -> Int8 } @@ -22,7 +22,8 @@ instance Default PotatoConfiguration where def = PotatoConfiguration { _potatoConfiguration_allowGraphemeClusters = False - , _potatoConfiguration_allowOrReplaceUnicodeWideChars = Just (Just '☺') + --, _potatoConfiguration_allowOrReplaceUnicodeWideChars = Just (Just '☺') + , _potatoConfiguration_allowOrReplaceUnicodeWideChars = Nothing -- NOTE getCharWidth is unsafely modified by vty on initialization based on the terminal config file , _potatoConfiguration_unicodeWideCharFn = getCharWidth } diff --git a/src/Potato/Flow/Controller/Goat.hs b/src/Potato/Flow/Controller/Goat.hs --- a/src/Potato/Flow/Controller/Goat.hs +++ b/src/Potato/Flow/Controller/Goat.hs @@ -8,9 +8,20 @@ , goatState_pFState , goatState_selectedTool , GoatState(..) - , GoatCmd(..) - , foldGoatFn + -- endo style + , endoGoatCmdSetDefaultParams + , endoGoatCmdMarkSaved + , endoGoatCmdSetTool + , endoGoatCmdSetDebugLabel + , endoGoatCmdSetCanvasRegionDim + , endoGoatCmdWSEvent + , endoGoatCmdNewFolder + , endoGoatCmdLoad + , endoGoatCmdSetFocusedArea + , endoGoatCmdMouse + , endoGoatCmdKeyboard + -- exposed for testing , potatoHandlerInputFromGoatState ) where @@ -23,7 +34,6 @@ import Potato.Flow.Controller.Handler import Potato.Flow.Controller.Input import Potato.Flow.Controller.Manipulator.Box -import Potato.Flow.Controller.Manipulator.CartLine import Potato.Flow.Controller.Manipulator.Common import Potato.Flow.Controller.Manipulator.Layers import Potato.Flow.Controller.Manipulator.Line @@ -39,7 +49,10 @@ import Potato.Flow.OwlWorkspace import Potato.Flow.Render import Potato.Flow.SEltMethods +import Potato.Flow.SElts import Potato.Flow.Types +import Potato.Flow.Preview +import Potato.Flow.Methods.LlamaWorks import Control.Exception (assert) import Data.Default @@ -86,11 +99,13 @@ , _goatState_screenRegion :: XY -- the screen dimensions , _goatState_clipboard :: Maybe SEltTree , _goatState_focusedArea :: GoatFocusedArea + + -- TODO you broke this with endo refactor + -- TODO this isn't even used right now... DELETE ME , _goatState_unbrokenInput :: Text -- grapheme clusters are inputed as several keyboard character events so we track these inputs here -- debug stuff (shared across documents) , _goatState_debugLabel :: Text - , _goatState_debugCommands :: [GoatCmd] } deriving (Show) @@ -113,11 +128,12 @@ , _renderContext_layerMetaMap = _layersState_meta initiallayersstate , _renderContext_broadPhase = initialbp -- this is ignored but we may as well set in correctly , _renderContext_renderedCanvasRegion = initialemptyrcr + , _renderContext_cache = emptyRenderCache } initialrc = _renderContext_renderedCanvasRegion $ render initialCanvasBox initialselts initialrendercontext goat = GoatState { - _goatState_workspace = loadOwlPFStateIntoWorkspace (initialstate) emptyWorkspace + _goatState_workspace = fst $ loadOwlPFStateIntoWorkspace (initialstate) emptyWorkspace , _goatState_pan = _controllerMeta_pan controllermeta , _goatState_mouseDrag = def , _goatState_handler = SomePotatoHandler EmptyHandler @@ -137,7 +153,6 @@ , _goatState_focusedArea = GoatFocusedArea_None , _goatState_unbrokenInput = "" , _goatState_screenRegion = V2 screenx screeny - (_controllerMeta_pan controllermeta) - , _goatState_debugCommands = [] } @@ -154,172 +169,14 @@ goatState_selectedTool :: GoatState -> Tool goatState_selectedTool = fromMaybe Tool_Select . pHandlerTool . _goatState_handler --- TODO deprecate this in favor of Endo style -data GoatCmd = - GoatCmdTool Tool - | GoatCmdSetFocusedArea GoatFocusedArea - | GoatCmdLoad EverythingLoadState - - -- command based input for widgets not owned by tiny tools - | GoatCmdWSEvent WSEvent - | GoatCmdSetCanvasRegionDim XY - | GoatCmdNewFolder Text - - -- direct input for widgets owned by tiny tools - | GoatCmdMouse LMouseData - | GoatCmdKeyboard KeyboardData - - -- debug nonsense - | GoatCmdSetDebugLabel Text - deriving (Show) - - - --- Ok, don't think this needs to be a part of GoatCmdTempOutput but does need to be a part of GoatState --- TODO do this later -{- -data DynGoatFlags = DynGoatFlags { - _dynGoatFlags_tool = r_tool - , _dynGoatFlags_selection = r_selection - , _dynGoatFlags_layers = r_layers - , _dynGoatFlags_pan = r_pan - , _dynGoatFlags_broadPhase = r_broadphase - , _dynGoatFlags_canvas = r_canvas - , _dynGoatFlags_renderedCanvas = r_renderedCanvas - , _dynGoatFlags_handlerRenderOutput = r_handlerRenderOutput -} deriving (Show) - -data GoatStateFlag = GoatStateFlag_Tool | GoatStateFlag_Selection | GoatStateFlag_Layers | GoatStateFlag_Pan | GoatStateFlag_BroadPhase | GoatStateFlag_Canvas | GoatStateFlag_RenderedCanvasRegion | GoatStateFlag_HandlerRenderOutput deriving (Show, Eq) --} - - -data GoatCmdTempOutput = GoatCmdTempOutput { - _goatCmdTempOutput_goatState :: GoatState - --, _goatCmdTempOutput_wasCanvasInput :: Bool - --, _goatCmdTempOutput_wasLayerInput :: Bool - - , _goatCmdTempOutput_nextHandler :: Maybe SomePotatoHandler - - , _goatCmdTempOutput_select :: Maybe (Bool, Selection) - , _goatCmdTempOutput_pFEvent :: Maybe (Bool, WSEvent) -- bool is true if it was a canvas handler event - , _goatCmdTempOutput_pan :: Maybe XY - , _goatCmdTempOutput_layersState :: Maybe LayersState - , _goatCmdTempOutput_changesFromToggleHide :: SuperOwlChanges -} deriving (Show) - --- helpers to extract stuff out of goatState because we use record wildcards and can't access otherwise -goatCmdTempOutput_screenRegion :: GoatCmdTempOutput -> XY -goatCmdTempOutput_screenRegion = _goatState_screenRegion . _goatCmdTempOutput_goatState - -goatCmdTempOutput_layersHandler :: GoatCmdTempOutput -> SomePotatoHandler -goatCmdTempOutput_layersHandler = _goatState_layersHandler . _goatCmdTempOutput_goatState - - -instance Default GoatCmdTempOutput where - def = GoatCmdTempOutput { - - -- TODO just don't use Default if you're gonna do this... - _goatCmdTempOutput_goatState = undefined --error "this is expected to be overwritten during initialization" - - , _goatCmdTempOutput_nextHandler = Nothing - , _goatCmdTempOutput_select = Nothing - , _goatCmdTempOutput_pFEvent = Nothing - , _goatCmdTempOutput_pan = Nothing - , _goatCmdTempOutput_layersState = Nothing - , _goatCmdTempOutput_changesFromToggleHide = IM.empty - } - -makeGoatCmdTempOutputFromNothing :: GoatState -> GoatCmdTempOutput -makeGoatCmdTempOutputFromNothing goatState = def { - _goatCmdTempOutput_goatState = goatState - - -- NOTE the value of _potatoHandlerOutput_nextHandler is not directly translated here - -- PotatoHandlerOutput interpretation: isNothing _potatoHandlerOutput_nextHandler => handler does not capture input - -- GoatCmdTempOutput interpretation (when non-canvas input): - -- -isNothing _potatoHandlerOutput_nextHandler => the particular event we just processed is not related to the canvas handler - -- -so in this case we default _goatCmdTempOutput_nextHandler = Just _goatState_handler - , _goatCmdTempOutput_nextHandler = Just (_goatState_handler goatState) - } - -makeGoatCmdTempOutputFromNothingClearHandler :: GoatState -> GoatCmdTempOutput -makeGoatCmdTempOutputFromNothingClearHandler goatState = def { - _goatCmdTempOutput_goatState = goatState - } - -makeGoatCmdTempOutputFromEvent :: GoatState -> WSEvent -> GoatCmdTempOutput -makeGoatCmdTempOutputFromEvent goatState wsev = (makeGoatCmdTempOutputFromNothing goatState) { - _goatCmdTempOutput_pFEvent = Just (False, wsev) - } - -makeGoatCmdTempOutputFromMaybeEvent :: GoatState -> Maybe WSEvent -> GoatCmdTempOutput -makeGoatCmdTempOutputFromMaybeEvent goatState mwsev = (makeGoatCmdTempOutputFromNothing goatState) { - _goatCmdTempOutput_pFEvent = fmap (\x -> (False,x)) mwsev - } - -makeGoatCmdTempOutputFromPotatoHandlerOutput :: GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput -makeGoatCmdTempOutputFromPotatoHandlerOutput goatState PotatoHandlerOutput {..} = def { - _goatCmdTempOutput_goatState = goatState - , _goatCmdTempOutput_nextHandler = _potatoHandlerOutput_nextHandler - , _goatCmdTempOutput_select = _potatoHandlerOutput_select - , _goatCmdTempOutput_pFEvent = fmap (\x -> (True,x)) _potatoHandlerOutput_pFEvent - , _goatCmdTempOutput_pan = _potatoHandlerOutput_pan - , _goatCmdTempOutput_layersState = _potatoHandlerOutput_layersState - , _goatCmdTempOutput_changesFromToggleHide = _potatoHandlerOutput_changesFromToggleHide -- actually not needed, only used by layers - } +goatState_hasLocalPreview :: GoatState -> Bool +goatState_hasLocalPreview = owlPFWorkspace_hasLocalPreview . _goatState_workspace -makeGoatCmdTempOutputFromLayersPotatoHandlerOutput :: GoatState -> PotatoHandlerOutput -> GoatCmdTempOutput -makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatState PotatoHandlerOutput {..} = def { - _goatCmdTempOutput_goatState = goatState { - _goatState_layersHandler = case _potatoHandlerOutput_nextHandler of - Just h -> h - Nothing -> error "expected LayersHandler to return a new handler" - } - -- TODO flag that this was not canvas input - , _goatCmdTempOutput_nextHandler = Nothing - , _goatCmdTempOutput_select = _potatoHandlerOutput_select - , _goatCmdTempOutput_pFEvent = fmap (\x -> (False,x)) _potatoHandlerOutput_pFEvent - , _goatCmdTempOutput_pan = _potatoHandlerOutput_pan - , _goatCmdTempOutput_layersState = _potatoHandlerOutput_layersState - , _goatCmdTempOutput_changesFromToggleHide = _potatoHandlerOutput_changesFromToggleHide - } - -makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea :: GoatState -> GoatFocusedArea -> GoatCmdTempOutput -makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea goatState gfa = r where - didchange = gfa /= _goatState_focusedArea goatState - goatstatewithnewfocus = goatState { _goatState_focusedArea = gfa } - noactionneeded = makeGoatCmdTempOutputFromNothing goatstatewithnewfocus - potatoHandlerInput = potatoHandlerInputFromGoatState goatState - -- if we were renaming, finalize the rename operation by sending a fake return key event, I can't think of a less ad-hoc way to do this - r = if didchange && pHandlerName (_goatState_layersHandler goatState) == handlerName_layersRename - then assert (_goatState_focusedArea goatState == GoatFocusedArea_Layers) $ case pHandleKeyboard (_goatState_layersHandler goatState) potatoHandlerInput (KeyboardData KeyboardKey_Return []) of - Nothing -> noactionneeded - Just pho -> makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatstatewithnewfocus pho - else noactionneeded - --- | hack function for resetting both handlers --- It would be nice if we actually cancel/reset the handlers (such that in progress operations are undone), but I don't think it really matters -forceResetBothHandlersAndMakeGoatCmdTempOutput :: GoatState -> GoatCmdTempOutput -forceResetBothHandlersAndMakeGoatCmdTempOutput goatState = r where - - -- I think this is Ok - msph_h = Nothing - msph_lh = Just (SomePotatoHandler (def :: LayersHandler)) - - r = def { - _goatCmdTempOutput_goatState = goatState { - _goatState_layersHandler = case msph_lh of - Just x -> x - Nothing -> error "expected LayersHandler to return a new handler" - } - , _goatCmdTempOutput_nextHandler = msph_h - } - makeHandlerFromNewTool :: GoatState -> Tool -> SomePotatoHandler makeHandlerFromNewTool GoatState{..} = \case Tool_Box -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_Box } Tool_Line -> SomePotatoHandler $ def { _autoLineHandler_isCreation = True } - Tool_CartLine -> SomePotatoHandler $ def { _cartLineHandler_isCreation = True } Tool_Select -> makeHandlerFromSelection _goatState_canvasSelection Tool_Text -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_Text } Tool_TextArea -> SomePotatoHandler $ def { _boxHandler_creation = BoxCreationType_TextArea } @@ -338,7 +195,8 @@ maybeUpdateHandlerFromSelection :: SomePotatoHandler -> CanvasSelection -> SomePotatoHandler maybeUpdateHandlerFromSelection sph selection = case sph of - SomePotatoHandler h -> if pIsHandlerActive h + -- TODO instead, just check if there is a preview operation or not + SomePotatoHandler h -> if handlerActiveState_isActive $ pIsHandlerActive h then sph else makeHandlerFromSelection selection @@ -348,10 +206,11 @@ then _goatState_clipboard else Just $ superOwlParliament_toSEltTree (goatState_owlTree goatState) _goatState_selection +-- TODO move to Potato.Flow.Methods.LlamaWorks deleteSelectionEvent :: GoatState -> Maybe WSEvent -deleteSelectionEvent GoatState {..} = if isParliament_null _goatState_selection +deleteSelectionEvent gs@GoatState {..} = if isParliament_null _goatState_selection then Nothing - else Just $ WSERemoveEltAndUpdateAttachments (superOwlParliament_toOwlParliament _goatState_selection) (_goatState_attachmentMap) + else Just $ WSEApplyPreview dummyShepard dummyShift $ Preview PO_StartAndCommit $ removeEltAndUpdateAttachments_to_llama (goatState_pFState gs) _goatState_attachmentMap (superOwlParliament_toOwlParliament _goatState_selection) potatoHandlerInputFromGoatState :: GoatState -> PotatoHandlerInput potatoHandlerInputFromGoatState GoatState {..} = r where @@ -372,8 +231,6 @@ } - - -- | filters out keyboard input based on the configuration -- must provide last character-unbroken sequence of text input in order to detect grapheme cluster -- relies on assumption 🙈 @@ -392,249 +249,445 @@ else Just k _ -> Just k --- TODO probably should have done "Endo GoatState" instead of "GoatCmd" --- TODO extract this method into another file --- TODO make State monad for this -foldGoatFn :: GoatCmd -> GoatState -> GoatState ---foldGoatFn cmd goatStateIgnore = trace ("FOLDING " <> show cmd) $ finalGoatState where -foldGoatFn cmd goatStateIgnore = finalGoatState where - -- TODO do some sort of rolling buffer here prob - -- NOTE even with a rolling buffer, I think this will leak if no one forces the thunk! - --goatState = goatStateIgnore { _goatState_debugCommands = cmd:_goatState_debugCommands } - goatState' = goatStateIgnore - -- it's convenient/lazy to reset unbrokenInput here, this will get overriden in cases where it needs to be - goatState = goatState' { _goatState_unbrokenInput = "" } - last_unbrokenInput = _goatState_unbrokenInput goatState' - last_workspace = _goatState_workspace goatState - last_pFState = _owlPFWorkspace_owlPFState last_workspace + + +endoGoatCmdSetDefaultParams :: SetPotatoDefaultParameters -> GoatState -> GoatState +endoGoatCmdSetDefaultParams spdp gs = gs { + _goatState_potatoDefaultParameters = potatoDefaultParameters_set (_goatState_potatoDefaultParameters gs) spdp + } + +endoGoatCmdMarkSaved :: () -> GoatState -> GoatState +endoGoatCmdMarkSaved _ gs = gs { + _goatState_workspace = markWorkspaceSaved (_goatState_workspace gs) + } + +-- TODO do I need to do anything else after setting handler?? +endoGoatCmdSetTool :: Tool -> GoatState -> GoatState +endoGoatCmdSetTool tool gs = gs { + _goatState_handler = makeHandlerFromNewTool gs tool + } + +endoGoatCmdSetDebugLabel :: Text -> GoatState -> GoatState +endoGoatCmdSetDebugLabel x gs = gs { + _goatState_debugLabel = x + } + +endoGoatCmdSetCanvasRegionDim :: V2 Int -> GoatState -> GoatState +endoGoatCmdSetCanvasRegionDim x gs = r where + -- set the screen region + -- rerender + gs_1 = gs { + _goatState_screenRegion = x + } + r = goat_setPan (_goatState_pan gs_1) gs_1 + + +endoGoatCmdWSEvent :: WSEvent -> GoatState -> GoatState +endoGoatCmdWSEvent wsev gs = goat_applyWSEvent WSEventType_Local_Refresh wsev gs + +endoGoatCmdNewFolder :: Text -> GoatState -> GoatState +endoGoatCmdNewFolder x gs = goat_applyWSEvent WSEventType_Local_Refresh newFolderEv gs where + pfs = goatState_pFState gs + folderPos = lastPositionInSelection (_owlPFState_owlTree pfs) (_goatState_selection gs) + newFolderEv = WSEApplyPreview dummyShepard dummyShift $ Preview PO_StartAndCommit $ makeAddFolderLlama pfs (folderPos, x) + +endoGoatCmdLoad :: (SPotatoFlow, ControllerMeta) -> GoatState -> GoatState +endoGoatCmdLoad (spf, cm) gs = r where + gs' = goat_applyWSEvent WSEventType_Local_Refresh (WSELoad spf) gs + r = gs' { + _goatState_pan = _controllerMeta_pan cm + , _goatState_layersState = makeLayersStateFromOwlPFState (goatState_pFState gs') (_controllerMeta_layers cm) + -- NOTE _goatState_layersHandler gets set by goat_applyWSEvent during refresh + } + +endoGoatCmdSetFocusedArea :: GoatFocusedArea -> GoatState -> GoatState +endoGoatCmdSetFocusedArea gfa goatState = r where + didchange = gfa /= _goatState_focusedArea goatState + goatstatewithnewfocus = goatState { _goatState_focusedArea = gfa } + noactionneeded = goatstatewithnewfocus potatoHandlerInput = potatoHandlerInputFromGoatState goatState + r = if didchange && pHandlerName (_goatState_layersHandler goatState) == handlerName_layersRename + then let + goatState_afterAction = case pHandleKeyboard (_goatState_layersHandler goatState) potatoHandlerInput (KeyboardData KeyboardKey_Return []) of + Nothing -> noactionneeded + Just pho -> goat_processLayersHandlerOutput pho goatstatewithnewfocus + in assert (_goatState_focusedArea goatState == GoatFocusedArea_Layers) $ goatState_afterAction + else noactionneeded - -- TODO this step can update OwlState built-in cache (via select operation) - -- | Process commands | - goatCmdTempOutput = case (_goatState_handler goatState) of - SomePotatoHandler handler -> case cmd of - GoatCmdSetDebugLabel x -> makeGoatCmdTempOutputFromNothing $ goatState { _goatState_debugLabel = x } - GoatCmdSetCanvasRegionDim x -> makeGoatCmdTempOutputFromNothing $ goatState { _goatState_screenRegion = x } - GoatCmdWSEvent x -> makeGoatCmdTempOutputFromEvent goatState x - GoatCmdNewFolder x -> makeGoatCmdTempOutputFromEvent goatState newFolderEv where - folderPos = lastPositionInSelection (_owlPFState_owlTree . _owlPFWorkspace_owlPFState $ (_goatState_workspace goatState)) (_goatState_selection goatState) - newFolderEv = WSEAddFolder (folderPos, x) - GoatCmdLoad (spf, cm) -> r where - -- HACK this won't get generated until later but we need this to generate layersState... - -- someday we'll split up foldGoatFn by `GoatCmd` (or switch to Endo `GoatState`) and clean this up - tempOwlPFStateHack = sPotatoFlow_to_owlPFState spf - r = (makeGoatCmdTempOutputFromEvent goatState (WSELoad spf)) { - _goatCmdTempOutput_pan = Just $ _controllerMeta_pan cm - , _goatCmdTempOutput_layersState = Just $ makeLayersStateFromOwlPFState tempOwlPFStateHack (_controllerMeta_layers cm) - } +endoGoatCmdMouse :: LMouseData -> GoatState -> GoatState +endoGoatCmdMouse mouseData goatState = trace ("endomouse: " <> show mouseData) $ r where + sameSource = _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState) == _lMouseData_isLayerMouse mouseData + mouseSourceFailure = _mouseDrag_state (_goatState_mouseDrag goatState) /= MouseDragState_Up && not sameSource + mouseDrag = case _mouseDrag_state (_goatState_mouseDrag goatState) of + MouseDragState_Up -> newDrag mouseData + MouseDragState_Cancelled -> (continueDrag mouseData (_goatState_mouseDrag goatState)) { _mouseDrag_state = MouseDragState_Cancelled } - GoatCmdTool x -> r where - -- TODO do we need to cancel the old handler? - r = makeGoatCmdTempOutputFromNothing (goatState { _goatState_handler = makeHandlerFromNewTool goatState x }) + _ -> continueDrag mouseData (_goatState_mouseDrag goatState) + canvasDrag = toRelMouseDrag last_pFState (_goatState_pan goatState) mouseDrag + goatState_withNewMouse = goatState { + _goatState_mouseDrag = mouseDrag + , _goatState_focusedArea = if isLayerMouse then GoatFocusedArea_Layers else GoatFocusedArea_Canvas + } + noChangeOutput = goatState_withNewMouse + -- TODO maybe split this case out to endoGoatCmdLayerMouse + isLayerMouse = _mouseDrag_isLayerMouse mouseDrag - GoatCmdSetFocusedArea gfa -> makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea goatState gfa + potatoHandlerInput = potatoHandlerInputFromGoatState goatState_withNewMouse + last_pFState = goatState_pFState goatState_withNewMouse + handler = _goatState_handler goatState_withNewMouse - GoatCmdMouse mouseData -> - let - sameSource = _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState) == _lMouseData_isLayerMouse mouseData - mouseSourceFailure = _mouseDrag_state (_goatState_mouseDrag goatState) /= MouseDragState_Up && not sameSource - mouseDrag = case _mouseDrag_state (_goatState_mouseDrag goatState) of - MouseDragState_Up -> newDrag mouseData - MouseDragState_Cancelled -> (continueDrag mouseData (_goatState_mouseDrag goatState)) { _mouseDrag_state = MouseDragState_Cancelled } - _ -> continueDrag mouseData (_goatState_mouseDrag goatState) + r = case _mouseDrag_state mouseDrag of - canvasDrag = toRelMouseDrag last_pFState (_goatState_pan goatState) mouseDrag + -- TODO soft failure + _ | mouseSourceFailure -> error "invalid mouse sequence due to source" - goatState_withNewMouse = goatState { - _goatState_mouseDrag = mouseDrag - , _goatState_focusedArea = if isLayerMouse then GoatFocusedArea_Layers else GoatFocusedArea_Canvas - } - -- TODO call makeGoatCmdTempOutputFromUpdateGoatStateFocusedArea and merge outputs instead UG, or is there a trick for us to be renentrant into foldGoatFn? + -- TODO assert false here? I'm pretty sure this should never happen + -- if mouse was cancelled, update _goatState_mouseDrag accordingly + MouseDragState_Cancelled -> if _lMouseData_isRelease mouseData + then goatState_withNewMouse { _goatState_mouseDrag = def } + else noChangeOutput -- still cancelled - noChangeOutput = makeGoatCmdTempOutputFromNothing goatState_withNewMouse + -- if mouse is intended for layers + _ | isLayerMouse -> case pHandleMouse (_goatState_layersHandler goatState) potatoHandlerInput (RelMouseDrag mouseDrag) of + Just pho -> goat_processLayersHandlerOutput pho goatState_withNewMouse + Nothing -> noChangeOutput - isLayerMouse = _mouseDrag_isLayerMouse mouseDrag + -- if middle mouse button, create a temporary PanHandler + MouseDragState_Down | _lMouseData_button mouseData == MouseButton_Middle -> r where + panhandler = def { _panHandler_maybePrevHandler = Just (SomePotatoHandler handler) } + r = case pHandleMouse panhandler potatoHandlerInput canvasDrag of + Just pho -> goat_processCanvasHandlerOutput pho goatState_withNewMouse + Nothing -> error "PanHandler expected to capture mouse input" - in case _mouseDrag_state mouseDrag of + -- pass onto canvas handler + _ -> case pHandleMouse handler potatoHandlerInput canvasDrag of + Just pho -> goat_processCanvasHandlerOutput pho goatState_withNewMouse - -- hack to recover after sameSource issue - -- TODO TEST - _ | mouseSourceFailure -> assert False $ - forceResetBothHandlersAndMakeGoatCmdTempOutput goatState_withNewMouse + -- input not captured by handler, pass onto select or select+drag + Nothing | _mouseDrag_state mouseDrag == MouseDragState_Down -> case pHandleMouse (def :: SelectHandler) potatoHandlerInput canvasDrag of + Just pho -> goat_processCanvasHandlerOutput pho goatState_withNewMouse + Nothing -> error "handler was expected to capture this mouse state" - -- if mouse was cancelled, update _goatState_mouseDrag accordingly - MouseDragState_Cancelled -> if _lMouseData_isRelease mouseData - then makeGoatCmdTempOutputFromNothing $ goatState_withNewMouse { _goatState_mouseDrag = def } - else noChangeOutput -- still cancelled + Nothing -> error $ "handler " <> show (pHandlerName handler) <> "was expected to capture mouse state " <> show (_mouseDrag_state mouseDrag) - -- if mouse is intended for layers - _ | isLayerMouse -> case pHandleMouse (_goatState_layersHandler goatState) potatoHandlerInput (RelMouseDrag mouseDrag) of - Just pho -> makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatState_withNewMouse pho - Nothing -> noChangeOutput - -- if middle mouse button, create a temporary PanHandler - MouseDragState_Down | _lMouseData_button mouseData == MouseButton_Middle -> r where - panhandler = def { _panHandler_maybePrevHandler = Just (SomePotatoHandler handler) } - r = case pHandleMouse panhandler potatoHandlerInput canvasDrag of - Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withNewMouse pho - Nothing -> error "PanHandler expected to capture mouse input" - -- pass onto canvas handler - _ -> case pHandleMouse handler potatoHandlerInput canvasDrag of - Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withNewMouse pho - -- input not captured by handler, pass onto select or select+drag - Nothing | _mouseDrag_state mouseDrag == MouseDragState_Down -> assert (not $ pIsHandlerActive handler) r where - r = case pHandleMouse (def :: SelectHandler) potatoHandlerInput canvasDrag of - Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withNewMouse pho - Nothing -> error "handler was expected to capture this mouse state" +endoGoatCmdKeyboard :: KeyboardData -> GoatState -> GoatState +endoGoatCmdKeyboard kbd' goatState = r where + -- TODO you need to do reset logic for this (basically, reset it anytime there was a non-keyboard event) + last_unbrokenInput = _goatState_unbrokenInput goatState + next_unbrokenInput = case kbd' of + KeyboardData (KeyboardKey_Char c) _ -> T.snoc last_unbrokenInput c + _ -> "" + mkbd = potatoModifyKeyboardKey (_goatState_configuration goatState) last_unbrokenInput kbd' + goatState_withKeyboard = goatState { _goatState_unbrokenInput = next_unbrokenInput} + potatoHandlerInput = potatoHandlerInputFromGoatState goatState_withKeyboard + last_pFState = goatState_pFState goatState_withKeyboard + -- TODO rename to canvasHandler + handler = _goatState_handler goatState_withKeyboard - Nothing -> error $ "handler " <> show (pHandlerName handler) <> "was expected to capture mouse state " <> show (_mouseDrag_state mouseDrag) + r = case mkbd of + Nothing -> goatState_withKeyboard + -- special case, treat escape cancel mouse drag as a mouse input + Just (KeyboardData KeyboardKey_Esc _) | mouseDrag_isActive (_goatState_mouseDrag goatState_withKeyboard) -> r where + canceledMouse = cancelDrag (_goatState_mouseDrag goatState_withKeyboard) + goatState_withNewMouse = goatState_withKeyboard { + _goatState_mouseDrag = canceledMouse - GoatCmdKeyboard kbd' -> let - next_unbrokenInput = case kbd' of - KeyboardData (KeyboardKey_Char c) _ -> T.snoc last_unbrokenInput c - _ -> "" - mkbd = potatoModifyKeyboardKey (_goatState_configuration goatState) last_unbrokenInput kbd' - goatState_withKeyboard = goatState { _goatState_unbrokenInput = next_unbrokenInput} - in case mkbd of - Nothing -> makeGoatCmdTempOutputFromNothing goatState_withKeyboard - -- special case, treat escape cancel mouse drag as a mouse input - Just (KeyboardData KeyboardKey_Esc _) | mouseDrag_isActive (_goatState_mouseDrag goatState_withKeyboard) -> r where - canceledMouse = cancelDrag (_goatState_mouseDrag goatState_withKeyboard) - goatState_withNewMouse = goatState_withKeyboard { - _goatState_mouseDrag = canceledMouse + -- escape will cancel mouse focus + -- TODO this isn't correct, you have some handlers that cancel into each other, you should only reset to GoatFocusedArea_None if they canceled to Nothing + , _goatState_focusedArea = GoatFocusedArea_None - -- escape will cancel mouse focus - -- TODO this isn't correct, you have some handlers that cancel into each other, you should only reset to GoatFocusedArea_None if they canceled to Nothing - , _goatState_focusedArea = GoatFocusedArea_None + } - } + -- TODO use _goatState_focusedArea instead + r = if _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState_withKeyboard) + then case pHandleMouse (_goatState_layersHandler goatState_withKeyboard) potatoHandlerInput (RelMouseDrag canceledMouse) of + Just pho -> goat_processLayersHandlerOutput pho goatState_withNewMouse + -- TODO I think this is fine, but maybe you should you clear the handler instead? + Nothing -> goatState_withNewMouse + else case pHandleMouse handler potatoHandlerInput (toRelMouseDrag last_pFState (_goatState_pan goatState_withKeyboard) canceledMouse) of + Just pho -> goat_processCanvasHandlerOutput pho goatState_withNewMouse + -- TODO I think this is fine, but maybe you should you clear the handler instead? + Nothing -> goatState_withNewMouse - -- TODO use _goatState_focusedArea instead - r = if _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState_withKeyboard) - then case pHandleMouse (_goatState_layersHandler goatState_withKeyboard) potatoHandlerInput (RelMouseDrag canceledMouse) of - Just pho -> makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatState_withNewMouse pho - Nothing -> makeGoatCmdTempOutputFromNothingClearHandler goatState_withNewMouse - else case pHandleMouse handler potatoHandlerInput (toRelMouseDrag last_pFState (_goatState_pan goatState_withKeyboard) canceledMouse) of - Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withNewMouse pho - Nothing -> makeGoatCmdTempOutputFromNothingClearHandler goatState_withNewMouse + -- we are in the middle of mouse drag, ignore all keyboard inputs + -- perhaps a better way to do this is to have handlers capture all inputs when active + Just _ | mouseDrag_isActive (_goatState_mouseDrag goatState_withKeyboard) -> goatState_withKeyboard - -- we are in the middle of mouse drag, ignore all keyboard inputs - -- perhaps a better way to do this is to have handlers capture all inputs when active - Just _ | mouseDrag_isActive (_goatState_mouseDrag goatState_withKeyboard) -> makeGoatCmdTempOutputFromNothing goatState_withKeyboard + Just kbd -> + let + maybeHandleLayers = do + guard $ _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState_withKeyboard) + pho <- pHandleKeyboard (_goatState_layersHandler goatState_withKeyboard) potatoHandlerInput kbd + return $ goat_processLayersHandlerOutput pho goatState_withKeyboard + in case maybeHandleLayers of + Just x -> x + Nothing -> case pHandleKeyboard handler potatoHandlerInput kbd of + Just pho -> goat_processCanvasHandlerOutput pho goatState_withKeyboard + -- input not captured by handler + -- TODO consider wrapping this all up in KeyboardHandler or something? Unfortunately, copy needs to modify goatState_withKeyboard which PotatoHandlerOutput can't atm + Nothing -> case kbd of + KeyboardData KeyboardKey_Esc _ -> case _mouseDrag_state (_goatState_mouseDrag goatState_withKeyboard) of + x | x == MouseDragState_Up || x == MouseDragState_Cancelled -> goat_setSelection False isParliament_empty goatState_withKeyboard + _ -> goatState_withKeyboard - Just kbd -> - let - maybeHandleLayers = do - guard $ _mouseDrag_isLayerMouse (_goatState_mouseDrag goatState_withKeyboard) - pho <- pHandleKeyboard (_goatState_layersHandler goatState_withKeyboard) potatoHandlerInput kbd - return $ makeGoatCmdTempOutputFromLayersPotatoHandlerOutput goatState_withKeyboard pho - in case maybeHandleLayers of - Just x -> x - Nothing -> case pHandleKeyboard handler potatoHandlerInput kbd of - Just pho -> makeGoatCmdTempOutputFromPotatoHandlerOutput goatState_withKeyboard pho - -- input not captured by handler - -- TODO consider wrapping this all up in KeyboardHandler or something? Unfortunately, copy needs to modify goatState_withKeyboard which PotatoHandlerOutput can't atm - Nothing -> case kbd of - KeyboardData KeyboardKey_Esc _ -> - (makeGoatCmdTempOutputFromNothing goatState_withKeyboard) { - -- TODO change tool back to select? - -- cancel selection if we are in a neutral mouse state and there is no handler - _goatCmdTempOutput_select = case _mouseDrag_state (_goatState_mouseDrag goatState_withKeyboard) of - MouseDragState_Up -> Just (False, isParliament_empty) - MouseDragState_Cancelled -> Just (False, isParliament_empty) - _ -> Nothing - } + KeyboardData k [] | k == KeyboardKey_Delete || k == KeyboardKey_Backspace -> case deleteSelectionEvent goatState_withKeyboard of + Nothing -> goatState_withKeyboard + Just wsev -> goat_applyWSEvent WSEventType_Local_Refresh wsev goatState_withKeyboard + KeyboardData (KeyboardKey_Char 'c') [KeyModifier_Ctrl] -> r where + copied = makeClipboard goatState_withKeyboard + r = goatState_withKeyboard { _goatState_clipboard = copied } + KeyboardData (KeyboardKey_Char 'x') [KeyModifier_Ctrl] -> r where + copied = makeClipboard goatState_withKeyboard + goatState_withClipboard = goatState_withKeyboard { _goatState_clipboard = copied } + r = case deleteSelectionEvent goatState_withKeyboard of + Nothing -> goatState_withClipboard + Just wsev -> goat_applyWSEvent WSEventType_Local_Refresh wsev goatState_withClipboard + KeyboardData (KeyboardKey_Char 'v') [KeyModifier_Ctrl] -> case _goatState_clipboard goatState_withKeyboard of + Nothing -> goatState_withKeyboard + Just stree -> r where + offsetstree = offsetSEltTree (V2 1 1) stree + minitree' = owlTree_fromSEltTree offsetstree + -- reindex the tree so there are no collisions with the current state + maxid1 = owlTree_maxId minitree' + 1 + maxid2 = owlPFState_nextId (_owlPFWorkspace_owlPFState (_goatState_workspace goatState_withKeyboard)) + minitree = owlTree_reindex (max maxid1 maxid2) minitree' + spot = lastPositionInSelection (goatState_owlTree goatState_withKeyboard) (_goatState_selection goatState_withKeyboard) + treePastaEv = WSEApplyPreview dummyShepard dummyShift $ Preview PO_StartAndCommit $ makePFCLlama $ OwlPFCNewTree (minitree, spot) + r = goat_applyWSEvent WSEventType_Local_Refresh treePastaEv (goatState_withKeyboard { _goatState_clipboard = Just offsetstree }) + KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl] -> r where + r = goat_applyWSEvent WSEventType_Local_Refresh WSEUndo goatState_withKeyboard + KeyboardData (KeyboardKey_Char 'y') [KeyModifier_Ctrl] -> r where + r = goat_applyWSEvent WSEventType_Local_Refresh WSERedo goatState_withKeyboard + -- tool hotkeys + KeyboardData (KeyboardKey_Char key) _ -> r where + mtool = case key of + 'v' -> Just Tool_Select + 'p' -> Just Tool_Pan + 'b' -> Just Tool_Box + 'l' -> Just Tool_Line + 'n' -> Just Tool_TextArea + _ -> Nothing + newHandler = maybe (_goatState_handler goatState_withKeyboard) (makeHandlerFromNewTool goatState_withKeyboard) mtool + -- TODO should I call a goat_setHandler function instead? + r = goatState_withKeyboard { _goatState_handler = newHandler } + _ -> goatState_withKeyboard - KeyboardData (KeyboardKey_Delete) [] -> r where - r = makeGoatCmdTempOutputFromMaybeEvent goatState_withKeyboard (deleteSelectionEvent goatState_withKeyboard) - KeyboardData (KeyboardKey_Backspace) [] -> r where - r = makeGoatCmdTempOutputFromMaybeEvent goatState_withKeyboard (deleteSelectionEvent goatState_withKeyboard) - KeyboardData (KeyboardKey_Char 'c') [KeyModifier_Ctrl] -> r where - copied = makeClipboard goatState_withKeyboard - r = makeGoatCmdTempOutputFromNothing $ goatState_withKeyboard { _goatState_clipboard = copied } - KeyboardData (KeyboardKey_Char 'x') [KeyModifier_Ctrl] -> r where - copied = makeClipboard goatState_withKeyboard - r = makeGoatCmdTempOutputFromMaybeEvent (goatState_withKeyboard { _goatState_clipboard = copied }) (deleteSelectionEvent goatState_withKeyboard) - KeyboardData (KeyboardKey_Char 'v') [KeyModifier_Ctrl] -> case _goatState_clipboard goatState_withKeyboard of - Nothing -> makeGoatCmdTempOutputFromNothing goatState_withKeyboard - Just stree -> r where +goat_renderCanvas_move :: RenderContext -> XY -> XY -> (RenderContext, Bool) +goat_renderCanvas_move rc@RenderContext {..} pan sr = r where + newBox = LBox (-pan) sr + didScreenRegionMove = _renderedCanvasRegion_box _renderContext_renderedCanvasRegion /= newBox + r = if didScreenRegionMove + then (moveRenderedCanvasRegion newBox rc, True) + else (rc, False) - -- TODO this is totally wrong, it won't handle parent/children stuff correctly - -- TODO convert to MiniOwlTree :D - offsetstree = offsetSEltTree (V2 1 1) stree - minitree' = owlTree_fromSEltTree offsetstree - maxid1 = owlTree_maxId minitree' + 1 - maxid2 = owlPFState_nextId (_owlPFWorkspace_owlPFState (_goatState_workspace goatState_withKeyboard)) - minitree = owlTree_reindex (max maxid1 maxid2) minitree' - spot = lastPositionInSelection (goatState_owlTree goatState_withKeyboard) (_goatState_selection goatState_withKeyboard) - treePastaEv = WSEAddTree (spot, minitree) +goat_renderCanvas_update :: (HasCallStack) => RenderContext -> NeedsUpdateSet -> SuperOwlChanges -> RenderContext +goat_renderCanvas_update rc needsupdateaabbs cslmap = r where + r = if IM.null cslmap + then rc + else updateCanvas cslmap needsupdateaabbs rc - r = makeGoatCmdTempOutputFromEvent (goatState_withKeyboard { _goatState_clipboard = Just offsetstree }) treePastaEv - KeyboardData (KeyboardKey_Char 'z') [KeyModifier_Ctrl] -> r where - r = makeGoatCmdTempOutputFromEvent goatState_withKeyboard WSEUndo - KeyboardData (KeyboardKey_Char 'y') [KeyModifier_Ctrl] -> r where - r = makeGoatCmdTempOutputFromEvent goatState_withKeyboard WSERedo - -- tool hotkeys - KeyboardData (KeyboardKey_Char key) _ -> r where - mtool = case key of - 'v' -> Just Tool_Select - 'p' -> Just Tool_Pan - 'b' -> Just Tool_Box - 'l' -> Just Tool_Line - 't' -> Just Tool_Text - 'n' -> Just Tool_TextArea - _ -> Nothing +-- USAGE this function is a little sneaky, we pass in the canvas RenderContext and alter it to use it for selection rendering +-- So you want to pull out the _renderContext_renderedCanvasRegion but throw away the rest of the render context from the output +-- I guess you also want to pull out _renderContext_cache? +-- In the future, selection rendering will have its own context and you won't want to do this I guess? +goat_renderCanvas_selection :: RenderContext -> SuperOwlParliament -> RenderContext +goat_renderCanvas_selection rc_from_canvas next_selection = r where + newBox = _renderedCanvasRegion_box $ _renderContext_renderedCanvasRegion rc_from_canvas + rendercontext_forSelection = rc_from_canvas { + -- NOTE this will render hidden stuff that's selected via layers!! + _renderContext_layerMetaMap = IM.empty + -- empty canvas to render our selection in, we just re-render everything for now (in the future you can try and do partial rendering though) + , _renderContext_renderedCanvasRegion = emptyRenderedCanvasRegion newBox + } + selectionselts = toList . fmap _superOwl_id $ unSuperOwlParliament next_selection + r = render_new newBox selectionselts rendercontext_forSelection - newHandler = maybe (_goatState_handler goatState_withKeyboard) (makeHandlerFromNewTool goatState_withKeyboard) mtool - r = makeGoatCmdTempOutputFromNothing $ goatState_withKeyboard { _goatState_handler = newHandler } + -- TODO just DELETE this... + {- TODO render only parts of selection that have changed TODO broken + next_renderedSelection' = if didScreenRegionMove + then moveRenderedCanvasRegion next_broadPhaseState (owlTree_withCacheResetOnAttachments) newBox _goatState_renderedSelection + else _goatState_renderedSelection + prevSelChangeMap = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, Nothing)) $ unSuperOwlParliament _goatState_selection + curSelChangeMap = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, Just sowl)) $ unSuperOwlParliament next_selection + -- TODO you can be even smarter about this by combining cslmap_forRendering I think + cslmapForSelectionRendering = curSelChangeMap `IM.union` prevSelChangeMap + -- you need to do something like this but this is wrong.... + --(needsupdateaabbsforrenderselection, _) = update_bPTree cslmapForSelectionRendering (_broadPhaseState_bPTree next_broadPhaseState) + needsupdateaabbsforrenderselection = needsupdateaabbs + next_renderedSelection = if IM.null cslmapForSelectionRendering + then next_renderedSelection' + else updateCanvas cslmapForSelectionRendering needsupdateaabbsforrenderselection next_broadPhaseState pFState_withCacheResetOnAttachments next_renderedSelection' + -} - -- unhandled input - _ -> makeGoatCmdTempOutputFromNothing goatState_withKeyboard +renderContextFromGoatState :: GoatState -> RenderContext +renderContextFromGoatState goatState = RenderContext { + _renderContext_cache = _goatState_renderCache goatState + , _renderContext_owlTree = _owlPFState_owlTree (goatState_pFState goatState) + , _renderContext_layerMetaMap = _layersState_meta (_goatState_layersState goatState) + , _renderContext_broadPhase = _goatState_broadPhaseState goatState + , _renderContext_renderedCanvasRegion = _goatState_renderedCanvas goatState + } - -- | update OwlPFWorkspace from GoatCmdTempOutput | - (workspace_afterEvent, cslmap_afterEvent) = case _goatCmdTempOutput_pFEvent goatCmdTempOutput of - -- if there was no update, then changes are not valid - Nothing -> (_goatState_workspace goatState, IM.empty) - Just (_, wsev) -> (r1,r2) where - r1 = updateOwlPFWorkspace wsev (_goatState_workspace goatState) - r2 = _owlPFWorkspace_lastChanges r1 - pFState_afterEvent = _owlPFWorkspace_owlPFState workspace_afterEvent +goat_setPan :: XY -> GoatState -> GoatState +goat_setPan (V2 dx dy) goatState = r where + -- set the pan + -- render move + -- render selection + V2 cx0 cy0 = _goatState_pan goatState + next_pan = V2 (cx0+dx) (cy0 + dy) - -- | update pan from GoatCmdTempOutput | - next_pan = case _goatCmdTempOutput_pan goatCmdTempOutput of - Nothing -> _goatState_pan goatState - Just (V2 dx dy) -> V2 (cx0+dx) (cy0 + dy) where - V2 cx0 cy0 = _goatState_pan goatState + rc = renderContextFromGoatState goatState + (rc_aftermove, _) = goat_renderCanvas_move rc next_pan (_goatState_screenRegion goatState) + rc_afterselection = goat_renderCanvas_selection rc_aftermove (_goatState_selection goatState) + r = goatState { + _goatState_pan = next_pan + , _goatState_renderedCanvas = _renderContext_renderedCanvasRegion rc_aftermove + , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterselection + } - -- | get layersState from GoatCmdTempOutput | - next_layersState'' = case _goatCmdTempOutput_layersState goatCmdTempOutput of - Nothing -> _goatState_layersState goatState - Just ls -> ls - -- | get selection from GoatCmdTempOutput | - mSelectionFromPho = case _goatCmdTempOutput_select goatCmdTempOutput of - Nothing -> Nothing - --Just (add, sel) -> assert (superOwlParliament_isValid nextot r) $ Just r where - Just (add, sel) -> assert (superOwlParliament_isValid nextot r) (Just r)where - nextot = _owlPFState_owlTree pFState_afterEvent - r' = if add - then superOwlParliament_disjointUnionAndCorrect nextot (_goatState_selection goatState) sel - else sel - r = SuperOwlParliament . Seq.sortBy (owlTree_superOwl_comparePosition nextot) . unSuperOwlParliament $ r' - -- | compute selection based on changes from updating OwlPFState (i.e. auto select newly created stuff if appropriate) | - (isNewSelection', selectionAfterChanges) = if IM.null cslmap_afterEvent - then (False, _goatState_selection goatState) +computeCanvasSelection :: (HasCallStack) => GoatState -> CanvasSelection +computeCanvasSelection goatState = r where + pfs = goatState_pFState goatState + filterHiddenOrLocked sowl = not $ layerMetaMap_isInheritHiddenOrLocked (_owlPFState_owlTree pfs) (_superOwl_id sowl) (_layersState_meta (_goatState_layersState goatState)) + r = superOwlParliament_convertToCanvasSelection (_owlPFState_owlTree pfs) filterHiddenOrLocked (_goatState_selection goatState) + + +goat_autoExpandFoldersOfSelection :: GoatState -> GoatState +goat_autoExpandFoldersOfSelection goatState = r where + -- auto expand folders for selected elements + (this will also auto expand when you drag or paste stuff into a folder) + -- NOTE this will prevent you from ever collapsing a folder that has a selected child in it (that's not true, you can still collapse it but it will rexpand the moment you make any changes, which might be kind of buggy) + -- so maybe auto expand should only happen on newly created elements or add a way to detect for newly selected elements (e.g. diff between old selection) + next_layersState = expandAllCollapsedParents (_goatState_selection goatState) (goatState_pFState goatState) (_goatState_layersState goatState) + r = goatState { _goatState_layersState = next_layersState } + + +goat_setSelection :: Bool -> SuperOwlParliament -> GoatState -> GoatState +goat_setSelection add selection goatState = r where + + -- set the new selection + ot = hasOwlTree_owlTree . goatState_pFState $ goatState + next_selection = SuperOwlParliament . Seq.sortBy (owlTree_superOwl_comparePosition ot) . unSuperOwlParliament $ if add + then superOwlParliament_disjointUnionAndCorrect ot (_goatState_selection goatState) selection + else selection + goatState_afterSelection = goat_autoExpandFoldersOfSelection goatState { _goatState_selection = next_selection } + + -- set the new canvas selection + -- create new handler as appropriate + -- rerender selection + next_canvasSelection = computeCanvasSelection goatState_afterSelection + next_handler = maybeUpdateHandlerFromSelection (_goatState_handler goatState_afterSelection) next_canvasSelection + -- MAYBE TODO consider rendering selected hidden/locked stuff too (it's still possible to select them via layers)? + -- Except we removed it from the BroadPhase already. And it would be weird because you bulk selected you would edit only the non-hidden/locked stuff + rc_afterselection = goat_renderCanvas_selection (renderContextFromGoatState goatState_afterSelection) (SuperOwlParliament $ unCanvasSelection next_canvasSelection) + r = goatState_afterSelection { + _goatState_handler = next_handler + , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterselection + , _goatState_canvasSelection = next_canvasSelection + } + + + +goat_setLayersStateWithChangesFromToggleHide :: LayersState -> SuperOwlChanges -> GoatState -> GoatState +goat_setLayersStateWithChangesFromToggleHide ls changes goatState = r where + + -- set the layers state + goatState_afterLayers = goatState { + _goatState_layersState = ls + } + + -- set the canvas selection and handler + next_canvasSelection = computeCanvasSelection $ goatState_afterLayers + goatState_afterSelection = goatState_afterLayers { + _goatState_canvasSelection = next_canvasSelection + , _goatState_handler = assert (not . handlerActiveState_isActive $ pIsHandlerActive (_goatState_handler goatState_afterLayers)) makeHandlerFromSelection next_canvasSelection + } + + -- set the broadphase + (needsupdateaabbs, next_broadPhaseState) = update_bPTree (goatState_pFState goatState_afterSelection) changes (_broadPhaseState_bPTree (_goatState_broadPhaseState goatState_afterSelection)) + goatState_afterUpdateBroadPhase = goatState_afterSelection { _goatState_broadPhaseState = next_broadPhaseState } + + -- render changes + -- render selection + rc = renderContextFromGoatState goatState_afterUpdateBroadPhase + rc_afterupdate = goat_renderCanvas_update rc needsupdateaabbs changes + rc_afterselection = goat_renderCanvas_selection rc_afterupdate ( SuperOwlParliament . unCanvasSelection $ next_canvasSelection) + r = goatState_afterUpdateBroadPhase { + -- MAYBE TODO refresh the layers handler (), this might be relevant if we support shared lock/hide state of layers in the future + --, _goatState_layersHandler = fromMaybe (SomePotatoHandler (def :: LayersHandler)) .... + _goatState_renderedCanvas = _renderContext_renderedCanvasRegion rc_afterupdate + , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterselection + } + + +goat_processHandlerOutput_noSetHandler :: PotatoHandlerOutput -> GoatState -> GoatState +goat_processHandlerOutput_noSetHandler pho goatState = trace ("goat_processHandlerOutput_noSetHandler HANDLER OUTPUT: " <> show pho <> " CURRENT HANDLER: " <> show (_goatState_handler goatState)) $ r where + + r = case _potatoHandlerOutput_action pho of + HOA_Select x y -> goat_setSelection x y goatState + HOA_Pan x -> goat_setPan x goatState + HOA_Layers x y -> goat_setLayersStateWithChangesFromToggleHide x y goatState + HOA_Preview p -> goat_applyWSEvent WSEventType_Local_NoRefresh (WSEApplyPreview dummyShepard dummyShift p) goatState + HOA_Nothing -> goatState + + +goat_processLayersHandlerOutput :: PotatoHandlerOutput -> GoatState -> GoatState +goat_processLayersHandlerOutput pho goatState = goat_processHandlerOutput_noSetHandler pho $ goatState { _goatState_layersHandler = fromMaybe (_goatState_layersHandler goatState) (_potatoHandlerOutput_nextHandler pho) } + +goat_processCanvasHandlerOutput :: PotatoHandlerOutput -> GoatState -> GoatState +goat_processCanvasHandlerOutput pho goatState = r where + canvasSelection = computeCanvasSelection goatState + + wasNoAction = handlerOutputAction_isNothing $ _potatoHandlerOutput_action pho + -- TODO you can DELETE workspace stuff here once all handlers properly return commit actions when they are done + -- you need this right now otherwise, for example, drag creating a box via BoxHandler will not commit after mouseup as it returns (handler: Nothing, action: HOA_Nothing) + (next_handler, next_workspace) = case _potatoHandlerOutput_nextHandler pho of + -- if we replaced the handler and there was HOA_Nothing, commit its local preview if there was one + Nothing -> (makeHandlerFromSelection canvasSelection, if wasNoAction then maybeCommitLocalPreviewToLlamaStackAndClear $ _goatState_workspace goatState else _goatState_workspace goatState) + Just x -> (x, _goatState_workspace goatState) + goatState' = goatState { + _goatState_handler = next_handler + , _goatState_workspace = next_workspace + } + r = goat_processHandlerOutput_noSetHandler pho $ goatState' + + +data WSEventType = WSEventType_Local_NoRefresh | WSEventType_Local_Refresh | WSEventType_Remote_Refresh deriving (Eq, Show) + +wSEventType_isRemote :: WSEventType -> Bool +wSEventType_isRemote WSEventType_Remote_Refresh = True +wSEventType_isRemote _ = False + +wSEventType_needsRefresh :: WSEventType -> Bool +wSEventType_needsRefresh WSEventType_Local_Refresh = True +wSEventType_needsRefresh WSEventType_Remote_Refresh = True +wSEventType_needsRefresh _ = False + +goat_applyWSEvent :: WSEventType -> WSEvent -> GoatState -> GoatState +goat_applyWSEvent wsetype wse goatState = goatState_final where + + -- apply the event + last_pFState = goatState_pFState goatState + (workspace_afterEvent, cslmap_afterEvent) = updateOwlPFWorkspace wse (_goatState_workspace goatState) + goatState_afterEvent = goatState { _goatState_workspace = workspace_afterEvent } + pFState_afterEvent = _owlPFWorkspace_owlPFState workspace_afterEvent + + + -- compute selection based on changes from updating OwlPFState (i.e. auto select newly created stuff if appropriate) + (isNewSelection, next_selection) = if IM.null cslmap_afterEvent + then (False, _goatState_selection goatState_afterEvent) else r where -- extract elements that got created @@ -649,13 +702,14 @@ -- pretty sure this does the same thing.. --sortedNewlyCreatedSEltls = makeSortedSuperOwlParliament (_owlPFState_owlTree $ pFState_afterEvent) (Seq.fromList newlyCreatedSEltls) - wasLoad = case cmd of - GoatCmdLoad _ -> True + wasLoad = case wse of + WSELoad _ -> True _ -> False - r = if wasLoad || null newlyCreatedSEltls + -- TODO add `|| wasRemoteChange` condition + r = if wasLoad || null newlyCreatedSEltls || wSEventType_isRemote wsetype -- if there are no newly created elts, we still need to update the selection - then (\x -> (False, SuperOwlParliament x)) $ catMaybesSeq . flip fmap (unSuperOwlParliament (_goatState_selection goatState)) $ \sowl -> + then (\x -> (False, SuperOwlParliament x)) $ catMaybesSeq . flip fmap (unSuperOwlParliament (_goatState_selection goatState_afterEvent)) $ \sowl -> case IM.lookup (_superOwl_id sowl) cslmap_afterEvent of -- no changes means not deleted Nothing -> Just sowl @@ -664,61 +718,78 @@ -- it was changed, update selection to newest version Just (Just x) -> Just x else (True, sortedNewlyCreatedSEltls) - -- for now, newly created stuff is the same as anything that got auto selected --newlyCreatedRids = IS.fromList . toList . fmap _superOwl_id . unSuperOwlParliament $ selectionAfterChanges + goatState_afterSelection = goatState_afterEvent { _goatState_selection = next_selection } - -- | update the new selection based on previous computations| - (isNewSelection, next_selection) = case mSelectionFromPho of - Just x -> assert (not isNewSelection') (True, x) - -- better/more expensive check to ensure mSelectionFromPho stuff is mutually exclusive to selectionAfterChanges - --Just x -> assert (selectionAfterChanges == _goatState_selection) (True, x) - Nothing -> (isNewSelection', selectionAfterChanges) + -- | refresh the handler if there was a non-canvas or non-local state change | + goatState_afterRefreshHandler = if wSEventType_needsRefresh wsetype + then let + layersHandler = _goatState_layersHandler goatState_afterSelection + canvasHandler = _goatState_handler goatState_afterSelection + -- TODO remove this assert, this will happen for stuff like boxtexthandler + -- since we don't have multi-user events, the handler should never be active when this happens + checkvalid = assert (pIsHandlerActive canvasHandler /= HAS_Active_Mouse && pIsHandlerActive layersHandler /= HAS_Active_Mouse) + -- safe for now, since `potatoHandlerInputFromGoatState` does not use `_goatState_handler/_goatState_layersHandler finalGoatState` which is set to `next_handler/next_layersHandler` + next_potatoHandlerInput = potatoHandlerInputFromGoatState goatState_afterSelection + canvasSelection = computeCanvasSelection goatState_afterSelection + refreshedCanvasHandler = fromMaybe (makeHandlerFromSelection canvasSelection) ( pRefreshHandler canvasHandler next_potatoHandlerInput) + refreshedLayersHandler = fromMaybe (SomePotatoHandler (def :: LayersHandler)) (pRefreshHandler layersHandler next_potatoHandlerInput) + + -- TODO cancel the preview + + + in checkvalid goatState_afterSelection { + _goatState_handler = refreshedCanvasHandler + , _goatState_layersHandler = refreshedLayersHandler + } + else goatState_afterSelection + -- | update LayersState based from SuperOwlChanges after applying events | - next_layersState' = updateLayers pFState_afterEvent cslmap_afterEvent next_layersState'' + next_layersState' = updateLayers pFState_afterEvent cslmap_afterEvent (_goatState_layersState goatState_afterRefreshHandler) + goatState_afterSetLayersState = goat_autoExpandFoldersOfSelection $ goatState_afterRefreshHandler { _goatState_layersState = next_layersState' } - -- | auto-expand folders and compute LayersState | - -- auto expand folders for selected elements + (this will also auto expand when you drag or paste stuff into a folder) - -- NOTE this will prevent you from ever collapsing a folder that has a selected child in it - -- so maybe auto expand should only happen on newly created elements or add a way to detect for newly selected elements (e.g. diff between old selection) - next_layersState = expandAllCollapsedParents next_selection pFState_afterEvent next_layersState' - --next_layersState = next_layersState' + -- | set the new handler based on the new Selection and LayersState + next_canvasSelection = computeCanvasSelection goatState_afterSetLayersState -- (TODO pretty sure this is the same as `canvasSelection = computeCanvasSelection goatState_afterSelection` above..) - -- | update the next handler | - mHandlerFromPho = _goatCmdTempOutput_nextHandler goatCmdTempOutput - filterHiddenOrLocked sowl = not $ layerMetaMap_isInheritHiddenOrLocked (_owlPFState_owlTree pFState_afterEvent) (_superOwl_id sowl) (_layersState_meta next_layersState) - next_canvasSelection = superOwlParliament_convertToCanvasSelection (_owlPFState_owlTree pFState_afterEvent) filterHiddenOrLocked next_selection - nextHandlerFromSelection = makeHandlerFromSelection next_canvasSelection - next_handler' = if isNewSelection - -- if there is a new selection, update the handler with new selection if handler wasn't active - then maybeUpdateHandlerFromSelection (fromMaybe (SomePotatoHandler EmptyHandler) mHandlerFromPho) next_canvasSelection - -- otherwise, use the returned handler or make a new one from selection - else fromMaybe nextHandlerFromSelection mHandlerFromPho - next_layersHandler' = goatCmdTempOutput_layersHandler goatCmdTempOutput - (next_handler, next_layersHandler) = case _goatCmdTempOutput_pFEvent goatCmdTempOutput of + -- we check both the pIsHandlerActive and goatState_hasLocalPreview condition to see if we want to recreate the handler + -- actually, we could only check pIsHandlerActive if all handlers properly reported their state + -- TODO the issue with not (goatState_hasLocalPreview goatState_afterSetLayersState) is that we may actually want to regen the handler we just haven't commit its preview yet (i.e. box creation) + -- NO that's not true because in those cases you can return an explicit commit action or you return HOA_Nothing which should also commit when the handler is replaced + (next_handler, next_workspace) = if (not . handlerActiveState_isActive) (pIsHandlerActive (_goatState_handler goatState_afterSetLayersState)) && not (goatState_hasLocalPreview goatState_afterSetLayersState) + -- if we replaced the handler, commit its local preview if there was one + then trace "COMMIT: " $ (makeHandlerFromSelection next_canvasSelection, maybeCommitLocalPreviewToLlamaStackAndClear $ _goatState_workspace goatState_afterSetLayersState) + else (_goatState_handler goatState_afterSetLayersState, _goatState_workspace goatState_afterSetLayersState) + goatState_afterSetHandler = goatState_afterSetLayersState { + _goatState_handler = next_handler + , _goatState_canvasSelection = next_canvasSelection + , _goatState_workspace = next_workspace + } - -- TODO you only need to do this if handler is one that came from mHandlerFromPho - -- if there was a non-canvas event, reset the handler D: - -- since we don't have multi-user events, the handler should never be active when this happens - Just (False, _) -> assert (not (pIsHandlerActive next_handler')) $ (refreshedHandler,refreshedLayersHandler) where - -- CAREFUL INFINITE LOOP DANGER WITH USE OF `finalGoatState` - -- safe for now, since `potatoHandlerInputFromGoatState` does not use `_goatState_handler/_goatState_layersHandler finalGoatState` which is set to `next_handler/next_layersHandler` - next_potatoHandlerInput = potatoHandlerInputFromGoatState finalGoatState - refreshedHandler = fromMaybe nextHandlerFromSelection ( pRefreshHandler next_handler' next_potatoHandlerInput) - refreshedLayersHandler = fromMaybe (SomePotatoHandler (def :: LayersHandler)) (pRefreshHandler next_layersHandler' next_potatoHandlerInput) + -- | update AttachmentMap based on new state and clear the cache on these changes | + (needsupdateaabbs, goatState_afterUpdateAttachmentsAndRenderState) = goat_updateAttachmentsAndRenderStateFromChanges cslmap_afterEvent goatState_afterSetHandler + -- | render everything + rc = renderContextFromGoatState goatState_afterUpdateAttachmentsAndRenderState + rc_afterRenderCanvas = goat_renderCanvas_update rc needsupdateaabbs cslmap_afterEvent + rc_afterRenderSelection = goat_renderCanvas_selection rc (_goatState_selection goatState_afterUpdateAttachmentsAndRenderState) + -- | DONE + goatState_final = goatState_afterUpdateAttachmentsAndRenderState { + _goatState_renderedCanvas = _renderContext_renderedCanvasRegion rc_afterRenderCanvas + , _goatState_renderedSelection = _renderContext_renderedCanvasRegion rc_afterRenderSelection + } - _ -> (next_handler', next_layersHandler') - -- | TODO enter rename mode for newly created folders | - -- TODO if cslmap_afterEvent has a newly created folder (i.e. we just createda folder) then we want to enter rename mode for that folder - -- this is not correct, we want a condition for when we hit the "new folder" button. Perhaps there needs to be a separate command for enter rename and FE triggers 2 events in succession? - --_goatState_layersHandler +-- this one also updates attachment map based on changes +goat_updateAttachmentsAndRenderStateFromChanges :: SuperOwlChanges -> GoatState -> ([AABB], GoatState) +goat_updateAttachmentsAndRenderStateFromChanges cslmap_afterEvent goatState = r where + pFState_afterEvent = goatState_pFState goatState + -- | update AttachmentMap based on new state and clear the cache on these changes | next_attachmentMap = updateAttachmentMapFromSuperOwlChanges cslmap_afterEvent (_goatState_attachmentMap goatState) -- we need to union with `_goatState_attachmentMap` as next_attachmentMap does not contain deleted targets and stuff we detached from @@ -728,96 +799,16 @@ -- | compute SuperOwlChanges for rendering | cslmap_withAttachments = IM.union cslmap_afterEvent attachmentChanges - cslmap_fromLayersHide = _goatCmdTempOutput_changesFromToggleHide goatCmdTempOutput - cslmap_forRendering = cslmap_fromLayersHide `IM.union` cslmap_withAttachments -- | clear the cache at places that have changed renderCache_resetOnChangesAndAttachments = renderCache_clearAtKeys (_goatState_renderCache goatState) (IM.keys cslmap_withAttachments) -- | update the BroadPhase - (needsupdateaabbs, next_broadPhaseState) = update_bPTree (_owlPFState_owlTree pFState_afterEvent) cslmap_forRendering (_broadPhaseState_bPTree (_goatState_broadPhaseState goatState)) - - -- | update the rendered region if we moved the screen | - canvasRegionBox = LBox (-next_pan) (goatCmdTempOutput_screenRegion goatCmdTempOutput) - newBox = canvasRegionBox - didScreenRegionMove = _renderedCanvasRegion_box (_goatState_renderedCanvas goatState) /= newBox - rendercontext_forMove = RenderContext { - _renderContext_cache = renderCache_resetOnChangesAndAttachments - , _renderContext_owlTree = _owlPFState_owlTree pFState_afterEvent - , _renderContext_layerMetaMap = _layersState_meta next_layersState - , _renderContext_broadPhase = next_broadPhaseState - , _renderContext_renderedCanvasRegion = _goatState_renderedCanvas goatState - } - rendercontext_forUpdate = if didScreenRegionMove - then moveRenderedCanvasRegion newBox rendercontext_forMove - else rendercontext_forMove - - -- | render the scene if there were changes, note that updates from actual changes are mutually exclusive from updates due to panning (although I think it would still work even if it weren't) | - rendercontext_afterUpdate = if IM.null cslmap_forRendering - then rendercontext_forUpdate - else updateCanvas cslmap_forRendering needsupdateaabbs rendercontext_forUpdate - - next_renderedCanvas = _renderContext_renderedCanvasRegion rendercontext_afterUpdate - - -- | render the selection | - rendercontext_forSelection = rendercontext_afterUpdate { - -- NOTE this will render hidden stuff that's selected via layers!! - _renderContext_layerMetaMap = IM.empty - - -- TODO DELETE THIS YOU SHOULDN'T HAVE TO DO THIS, this is breaking caching (you can fix by commenting it out) - -- IDK WHY BUT IF YOU SELECT AUTOLINE WITH BOX AND MOVE BOTH THE CACHE STAYS WITH ORIGINAL PLACE AND SELECTED LINE DOESN'T MOVE - -- so temp fix it by reseting the cache on attached lines whos target moved - , _renderContext_cache = renderCache_resetOnChangesAndAttachments - - -- empty canvas to render our selection in - -- we just re-render everything for now (in the future you can try and do partial rendering though) - , _renderContext_renderedCanvasRegion = emptyRenderedCanvasRegion newBox - } - selectionselts = toList . fmap _superOwl_id $ unSuperOwlParliament next_selection - - (next_renderedSelection, next_renderCache) = if _goatState_selection goatState == next_selection && not didScreenRegionMove && IM.null cslmap_forRendering - -- nothing changed, we can keep our selection rendering - then (_goatState_renderedSelection goatState, _renderContext_cache rendercontext_afterUpdate) - else (_renderContext_renderedCanvasRegion rctx, _renderContext_cache rctx) where - rctx = render_new newBox selectionselts rendercontext_forSelection - - -- TODO just DELETE this... - {- TODO render only parts of selection that have changed TODO broken - next_renderedSelection' = if didScreenRegionMove - then moveRenderedCanvasRegion next_broadPhaseState (owlTree_withCacheResetOnAttachments) newBox _goatState_renderedSelection - else _goatState_renderedSelection - prevSelChangeMap = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, Nothing)) $ unSuperOwlParliament _goatState_selection - curSelChangeMap = IM.fromList . toList . fmap (\sowl -> (_superOwl_id sowl, Just sowl)) $ unSuperOwlParliament next_selection - -- TODO you can be even smarter about this by combining cslmap_forRendering I think - cslmapForSelectionRendering = curSelChangeMap `IM.union` prevSelChangeMap - -- you need to do something like this but this is wrong.... - --(needsupdateaabbsforrenderselection, _) = update_bPTree cslmapForSelectionRendering (_broadPhaseState_bPTree next_broadPhaseState) - needsupdateaabbsforrenderselection = needsupdateaabbs - next_renderedSelection = if IM.null cslmapForSelectionRendering - then next_renderedSelection' - else updateCanvas cslmapForSelectionRendering needsupdateaabbsforrenderselection next_broadPhaseState pFState_withCacheResetOnAttachments next_renderedSelection' - -} - - next_pFState = pFState_afterEvent { _owlPFState_owlTree = _renderContext_owlTree rendercontext_forSelection } - next_workspace = workspace_afterEvent { _owlPFWorkspace_owlPFState = next_pFState} + (needsupdateaabbs, next_broadPhaseState) = update_bPTree (_owlPFState_owlTree pFState_afterEvent) cslmap_withAttachments (_broadPhaseState_bPTree (_goatState_broadPhaseState goatState)) - checkAttachmentMap = owlTree_makeAttachmentMap (_owlPFState_owlTree next_pFState) == next_attachmentMap + r = (needsupdateaabbs, goatState { + _goatState_attachmentMap = next_attachmentMap + , _goatState_broadPhaseState = next_broadPhaseState + , _goatState_renderCache = renderCache_resetOnChangesAndAttachments + }) - -- TODO remove assert in production builds - finalGoatState = if not checkAttachmentMap - then error $ (show (owlTree_makeAttachmentMap (_owlPFState_owlTree next_pFState))) <> "\n\n\n" <> show next_attachmentMap - else - (_goatCmdTempOutput_goatState goatCmdTempOutput) { - _goatState_workspace = next_workspace - , _goatState_pan = next_pan - , _goatState_layersHandler = next_layersHandler - , _goatState_handler = next_handler - , _goatState_selection = next_selection - , _goatState_canvasSelection = next_canvasSelection - , _goatState_broadPhaseState = next_broadPhaseState - , _goatState_renderedCanvas = next_renderedCanvas - , _goatState_renderedSelection = next_renderedSelection - , _goatState_layersState = next_layersState - , _goatState_attachmentMap = next_attachmentMap - , _goatState_renderCache = next_renderCache - } diff --git a/src/Potato/Flow/Controller/Handler.hs b/src/Potato/Flow/Controller/Handler.hs --- a/src/Potato/Flow/Controller/Handler.hs +++ b/src/Potato/Flow/Controller/Handler.hs @@ -15,6 +15,7 @@ import Potato.Flow.OwlState import Potato.Flow.OwlWorkspace import Potato.Flow.SElts +import qualified Potato.Flow.Preview as Preview import qualified Potato.Data.Text.Zipper as TZ @@ -24,23 +25,39 @@ import qualified Data.Text as T import qualified Text.Show + +data HandlerOutputAction = + HOA_Nothing + | HOA_Pan XY + | HOA_Select Bool Selection + | HOA_Layers LayersState SuperOwlChanges + | HOA_LayersScroll Int + | HOA_Preview Preview.Preview + deriving (Show) + +handlerOutputAction_isNothing :: HandlerOutputAction -> Bool +handlerOutputAction_isNothing = \case + HOA_Nothing -> True + _ -> False + +handlerOutputAction_isSelect :: HandlerOutputAction -> Bool +handlerOutputAction_isSelect = \case + HOA_Select _ _ -> True + _ -> False + +-- TODO split out into mutually exclusive actions data PotatoHandlerOutput = PotatoHandlerOutput { _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler - , _potatoHandlerOutput_select :: Maybe (Bool, Selection) - , _potatoHandlerOutput_pFEvent :: Maybe WSEvent - , _potatoHandlerOutput_pan :: Maybe XY - , _potatoHandlerOutput_layersState :: Maybe LayersState - , _potatoHandlerOutput_changesFromToggleHide :: SuperOwlChanges + + , _potatoHandlerOutput_action :: HandlerOutputAction } deriving (Show) + + instance Default PotatoHandlerOutput where def = PotatoHandlerOutput { _potatoHandlerOutput_nextHandler = Nothing - , _potatoHandlerOutput_pFEvent = Nothing - , _potatoHandlerOutput_pan = Nothing - , _potatoHandlerOutput_select = Nothing - , _potatoHandlerOutput_layersState = Nothing - , _potatoHandlerOutput_changesFromToggleHide = IM.empty + , _potatoHandlerOutput_action = HOA_Nothing } -- TODO replace this with just GoatState @@ -139,7 +156,14 @@ emptyHandlerRenderOutput :: HandlerRenderOutput emptyHandlerRenderOutput = HandlerRenderOutput { _handlerRenderOutput_temp = [] } +data HandlerActiveState = HAS_Active_Mouse | HAS_Active_Keyboard | HAS_Active_Waiting | HAS_Inactive deriving (Show, Eq) +handlerActiveState_isActive :: HandlerActiveState -> Bool +handlerActiveState_isActive = \case + HAS_Inactive -> False + _ -> True + + -- we check handler name for debug reasons so it's useful to have constants -- there should be no non-test code that depends on comparing pHandlerName handlerName_box :: Text @@ -208,9 +232,11 @@ pRefreshHandler :: h -> PotatoHandlerInput -> Maybe SomePotatoHandler pRefreshHandler _ _ = Nothing + + -- TODO change this to an enum so you can capture different notion of activeness -- active manipulators will not be overwritten by new handlers via selection from changes - pIsHandlerActive :: h -> Bool - pIsHandlerActive _ = False + pIsHandlerActive :: h -> HandlerActiveState + pIsHandlerActive _ = HAS_Inactive pRenderHandler :: h -> PotatoHandlerInput -> HandlerRenderOutput pRenderHandler _ _ = def @@ -227,12 +253,18 @@ -- default version that ensures mouse state is valid when handler is active pValidateMouse h (RelMouseDrag MouseDrag {..}) = case _mouseDrag_state of MouseDragState_Cancelled -> False - MouseDragState_Down -> not $ pIsHandlerActive h + MouseDragState_Down -> not . handlerActiveState_isActive $ pIsHandlerActive h _ -> True -- determine which selected tool to show pHandlerTool :: h -> Maybe Tool pHandlerTool _ = Nothing + + + -- whether to commit or cancel the Preview operation when replacing the handler or not + -- True is commit, False is cancel + --pCommitOrCancelOnReplace :: h -> Bool + --pCommitOrCancelOnReplace _ = True data SomePotatoHandler = forall h . PotatoHandler h => SomePotatoHandler h diff --git a/src/Potato/Flow/Controller/Input.hs b/src/Potato/Flow/Controller/Input.hs --- a/src/Potato/Flow/Controller/Input.hs +++ b/src/Potato/Flow/Controller/Input.hs @@ -58,15 +58,15 @@ data MouseDragState = MouseDragState_Down | MouseDragState_Dragging | MouseDragState_Up | MouseDragState_Cancelled deriving (Show, Eq) --- TODO add modifier --- TODO is this the all encompassing mouse event we want? + -- TODO is there a way to optionally support more fidelity here? --- mouse drags are sent as click streams +-- NOTE mouse drags are sent as click streams data LMouseData = LMouseData { _lMouseData_position :: XY , _lMouseData_isRelease :: Bool , _lMouseData_button :: MouseButton , _lMouseData_modifiers :: [KeyModifier] + -- TODO get rid of this, instead split input into 2 , _lMouseData_isLayerMouse :: Bool } deriving (Show, Eq) @@ -76,6 +76,7 @@ , _mouseDrag_modifiers :: [KeyModifier] -- tracks modifiers held at current state of drag , _mouseDrag_to :: XY -- likely not needed as they will be in the input event, but whatever , _mouseDrag_state :: MouseDragState + -- TODO get rid of this, instead split input into 2 , _mouseDrag_isLayerMouse :: Bool } deriving (Show, Eq) diff --git a/src/Potato/Flow/Controller/Manipulator/Box.hs b/src/Potato/Flow/Controller/Manipulator/Box.hs --- a/src/Potato/Flow/Controller/Manipulator/Box.hs +++ b/src/Potato/Flow/Controller/Manipulator/Box.hs @@ -1,5 +1,12 @@ +-- This handler does the following things +-- - transform any selection (drag + resize) +-- - create boxes (consider splitting this one out) +-- - go to box text label or text area edit handler + {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fno-warn-unused-record-wildcards #-} + module Potato.Flow.Controller.Manipulator.Box ( BoxHandleType(..) , BoxHandler(..) @@ -23,13 +30,14 @@ import Potato.Flow.Types import Potato.Flow.OwlItem import Potato.Flow.Owl -import Potato.Flow.OwlItem import Potato.Flow.OwlState -import Potato.Flow.OwlItem import Potato.Flow.OwlWorkspace import Potato.Flow.Methods.Types import Potato.Flow.Llama +import Potato.Flow.Methods.LlamaWorks +import Potato.Flow.Preview + import Data.Default import Data.Dependent.Sum (DSum ((:=>))) import qualified Data.IntMap as IM @@ -170,8 +178,8 @@ r = makeDeltaBox bht boxRestrictedDelta -makeDragOperation :: Bool -> PotatoHandlerInput -> DeltaLBox -> Maybe WSEvent -makeDragOperation undoFirst phi dbox = op where +makeDragOperation :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama +makeDragOperation phi dbox = op where selection = transformableSelection phi makeController _ = cmd where @@ -181,7 +189,7 @@ op = if Seq.null selection then Nothing - else Just $ WSEApplyLlama (undoFirst, makePFCLlama . OwlPFCManipulate $ IM.fromList (fmap (\s -> (_superOwl_id s, makeController s)) (toList selection))) + else Just $ makePFCLlama . OwlPFCManipulate $ IM.fromList (fmap (\s -> (_superOwl_id s, makeController s)) (toList selection)) -- TODO split this handler in two handlers -- one for resizing selection (including boxes) @@ -287,10 +295,11 @@ BoxCreationType_TextArea -> "