-- 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 where

import           Relude

import           Potato.Flow.Controller.Handler
import           Potato.Flow.Controller.Input
import           Potato.Flow.Controller.Manipulator.BoxText
import           Potato.Flow.Controller.Manipulator.TextArea
import           Potato.Flow.Controller.Manipulator.Common
import           Potato.Flow.Controller.Types
import           Potato.Flow.Math
import           Potato.Flow.Methods.SEltMethods
import           Potato.Flow.Serialization.Snake
import           Potato.Flow.Types
import           Potato.Flow.OwlItem
import Potato.Flow.Owl
import Potato.Flow.OwlState
import Potato.Flow.OwlWorkspace
import Potato.Flow.Methods.Types
import Potato.Flow.Llama
import           Potato.Flow.Methods.LlamaWorks
import           Potato.Flow.Preview


import           Data.Default
import           Data.Dependent.Sum                         (DSum ((:=>)))
import qualified Data.IntMap                                as IM
import qualified Data.Map as Map
import qualified Data.List                                  as L
import qualified Data.Sequence as Seq

import Control.Exception (assert)



superOwl_isTransformable :: (HasOwlTree o) => SuperOwl -> o -> Bool
superOwl_isTransformable :: forall o. HasOwlTree o => SuperOwl -> o -> Bool
superOwl_isTransformable SuperOwl
sowl o
ot = case OwlItem -> OwlSubItem
_owlItem_subItem (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl) of
  OwlSubItem
OwlSubItemNone -> Bool
False
  OwlSubItemFolder Seq Int
_ -> Bool
False
  OwlSubItemLine SAutoLine
sline -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
    (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline Maybe Attachment -> (Attachment -> Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Attachment
att -> o -> Int -> Bool
forall o. HasOwlTree o => o -> Int -> Bool
hasOwlTree_exists o
ot (Attachment -> Int
_attachment_target Attachment
att)))
    Bool -> Bool -> Bool
&& (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline Maybe Attachment -> (Attachment -> Bool) -> Maybe Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Attachment
att -> o -> Int -> Bool
forall o. HasOwlTree o => o -> Int -> Bool
hasOwlTree_exists o
ot (Attachment -> Int
_attachment_target Attachment
att)))
  OwlSubItem
_ -> Bool
True

transformableSelection :: PotatoHandlerInput -> Seq SuperOwl
transformableSelection :: PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
..} = OwlPFState -> CanvasSelection -> Seq SuperOwl
transformableSelection' OwlPFState
_potatoHandlerInput_pFState CanvasSelection
_potatoHandlerInput_canvasSelection

transformableSelection' :: OwlPFState -> CanvasSelection -> Seq SuperOwl
transformableSelection' :: OwlPFState -> CanvasSelection -> Seq SuperOwl
transformableSelection' OwlPFState
pfs CanvasSelection
sel = (SuperOwl -> Bool) -> Seq SuperOwl -> Seq SuperOwl
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter ((SuperOwl -> OwlPFState -> Bool) -> OwlPFState -> SuperOwl -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip SuperOwl -> OwlPFState -> Bool
forall o. HasOwlTree o => SuperOwl -> o -> Bool
superOwl_isTransformable OwlPFState
pfs) (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
sel)


-- TODO rework this stuff, it was written with old assumptions that don't make sense anymore
data MouseManipulatorType = MouseManipulatorType_Corner | MouseManipulatorType_Side | MouseManipulatorType_Point | MouseManipulatorType_Area | MouseManipulatorType_Text deriving (Int -> MouseManipulatorType -> ShowS
[MouseManipulatorType] -> ShowS
MouseManipulatorType -> String
(Int -> MouseManipulatorType -> ShowS)
-> (MouseManipulatorType -> String)
-> ([MouseManipulatorType] -> ShowS)
-> Show MouseManipulatorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseManipulatorType -> ShowS
showsPrec :: Int -> MouseManipulatorType -> ShowS
$cshow :: MouseManipulatorType -> String
show :: MouseManipulatorType -> String
$cshowList :: [MouseManipulatorType] -> ShowS
showList :: [MouseManipulatorType] -> ShowS
Show, MouseManipulatorType -> MouseManipulatorType -> Bool
(MouseManipulatorType -> MouseManipulatorType -> Bool)
-> (MouseManipulatorType -> MouseManipulatorType -> Bool)
-> Eq MouseManipulatorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseManipulatorType -> MouseManipulatorType -> Bool
== :: MouseManipulatorType -> MouseManipulatorType -> Bool
$c/= :: MouseManipulatorType -> MouseManipulatorType -> Bool
/= :: MouseManipulatorType -> MouseManipulatorType -> Bool
Eq)
data MouseManipulator = MouseManipulator {
  MouseManipulator -> LBox
_mouseManipulator_box    :: LBox
  , MouseManipulator -> MouseManipulatorType
_mouseManipulator_type :: MouseManipulatorType
  -- back reference to object being manipulated?
  -- or just use a function
}
type MouseManipulatorSet = [MouseManipulator]
type ManipulatorIndex = Int

toMouseManipulators :: OwlPFState -> CanvasSelection -> MouseManipulatorSet
toMouseManipulators :: OwlPFState -> CanvasSelection -> MouseManipulatorSet
toMouseManipulators OwlPFState
pfs CanvasSelection
selection' = MouseManipulatorSet
bb where
  union_lBoxes :: NonEmpty LBox -> LBox
  union_lBoxes :: NonEmpty LBox -> LBox
union_lBoxes (LBox
x:|[LBox]
xs) = (LBox -> LBox -> LBox) -> LBox -> [LBox] -> LBox
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LBox -> LBox -> LBox
union_lBox LBox
x [LBox]
xs
  selection :: Seq SuperOwl
selection = OwlPFState -> CanvasSelection -> Seq SuperOwl
transformableSelection' OwlPFState
pfs CanvasSelection
selection'
  fmapfn :: SuperOwl -> LBox
fmapfn SuperOwl
sowl = SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_box (OwlSubItem -> SEltDrawer
getDrawer (OwlSubItem -> SEltDrawer)
-> (SuperOwl -> OwlSubItem) -> SuperOwl -> SEltDrawer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlSubItem
forall o. HasOwlItem o => o -> OwlSubItem
hasOwlItem_toOwlSubItem (SuperOwl -> SEltDrawer) -> SuperOwl -> SEltDrawer
forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) OwlPFState
pfs
  -- consider filtering out boxes with 0 area, but really _sEltDrawer_box should have return type Maybe LBox
  sboxes :: [LBox]
sboxes = Seq LBox -> [LBox]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq LBox -> [LBox]) -> Seq LBox -> [LBox]
forall a b. (a -> b) -> a -> b
$ (SuperOwl -> LBox) -> Seq SuperOwl -> Seq LBox
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> LBox
fmapfn Seq SuperOwl
selection
  bb :: MouseManipulatorSet
bb = case [LBox]
sboxes of
    []   -> []
    LBox
x:[LBox]
xs -> (BoxHandleType -> MouseManipulator)
-> [BoxHandleType] -> MouseManipulatorSet
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((BoxHandleType -> LBox -> MouseManipulator)
-> LBox -> BoxHandleType -> MouseManipulator
forall a b c. (a -> b -> c) -> b -> a -> c
flip BoxHandleType -> LBox -> MouseManipulator
makeHandleBox (NonEmpty LBox -> LBox
union_lBoxes (LBox
xLBox -> [LBox] -> NonEmpty LBox
forall a. a -> [a] -> NonEmpty a
:|[LBox]
xs))) [BoxHandleType
BH_TL .. BoxHandleType
BH_A]

findFirstMouseManipulator :: OwlPFState -> RelMouseDrag -> CanvasSelection -> Maybe ManipulatorIndex
findFirstMouseManipulator :: OwlPFState -> RelMouseDrag -> CanvasSelection -> Maybe Int
findFirstMouseManipulator OwlPFState
pfs (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
..}) CanvasSelection
selection = Maybe Int
r where
  mms :: MouseManipulatorSet
mms = OwlPFState -> CanvasSelection -> MouseManipulatorSet
toMouseManipulators OwlPFState
pfs CanvasSelection
selection
  smt :: SelectionManipulatorType
smt = CanvasSelection -> SelectionManipulatorType
computeSelectionType CanvasSelection
selection

  -- TODO use select magic here
  normalSel :: Maybe Int
normalSel = (MouseManipulator -> Bool) -> MouseManipulatorSet -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
L.findIndex (\MouseManipulator
mm -> LBox -> XY -> Bool
does_lBox_contains_XY (MouseManipulator -> LBox
_mouseManipulator_box MouseManipulator
mm) XY
_mouseDrag_from) MouseManipulatorSet
mms
  r :: Maybe Int
r = case SelectionManipulatorType
smt of
    SelectionManipulatorType
SMTTextArea -> Maybe Int
normalSel -- TODO figure out how to differentiate between area / text manipulator
    SelectionManipulatorType
_       -> Maybe Int
normalSel


-- order is manipulator index
data BoxHandleType = BH_TL | BH_TR | BH_BL | BH_BR | BH_A | BH_T | BH_B | BH_L | BH_R  deriving (Int -> BoxHandleType -> ShowS
[BoxHandleType] -> ShowS
BoxHandleType -> String
(Int -> BoxHandleType -> ShowS)
-> (BoxHandleType -> String)
-> ([BoxHandleType] -> ShowS)
-> Show BoxHandleType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoxHandleType -> ShowS
showsPrec :: Int -> BoxHandleType -> ShowS
$cshow :: BoxHandleType -> String
show :: BoxHandleType -> String
$cshowList :: [BoxHandleType] -> ShowS
showList :: [BoxHandleType] -> ShowS
Show, BoxHandleType -> BoxHandleType -> Bool
(BoxHandleType -> BoxHandleType -> Bool)
-> (BoxHandleType -> BoxHandleType -> Bool) -> Eq BoxHandleType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoxHandleType -> BoxHandleType -> Bool
== :: BoxHandleType -> BoxHandleType -> Bool
$c/= :: BoxHandleType -> BoxHandleType -> Bool
/= :: BoxHandleType -> BoxHandleType -> Bool
Eq, Int -> BoxHandleType
BoxHandleType -> Int
BoxHandleType -> [BoxHandleType]
BoxHandleType -> BoxHandleType
BoxHandleType -> BoxHandleType -> [BoxHandleType]
BoxHandleType -> BoxHandleType -> BoxHandleType -> [BoxHandleType]
(BoxHandleType -> BoxHandleType)
-> (BoxHandleType -> BoxHandleType)
-> (Int -> BoxHandleType)
-> (BoxHandleType -> Int)
-> (BoxHandleType -> [BoxHandleType])
-> (BoxHandleType -> BoxHandleType -> [BoxHandleType])
-> (BoxHandleType -> BoxHandleType -> [BoxHandleType])
-> (BoxHandleType
    -> BoxHandleType -> BoxHandleType -> [BoxHandleType])
-> Enum BoxHandleType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BoxHandleType -> BoxHandleType
succ :: BoxHandleType -> BoxHandleType
$cpred :: BoxHandleType -> BoxHandleType
pred :: BoxHandleType -> BoxHandleType
$ctoEnum :: Int -> BoxHandleType
toEnum :: Int -> BoxHandleType
$cfromEnum :: BoxHandleType -> Int
fromEnum :: BoxHandleType -> Int
$cenumFrom :: BoxHandleType -> [BoxHandleType]
enumFrom :: BoxHandleType -> [BoxHandleType]
$cenumFromThen :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFromThen :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
$cenumFromTo :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFromTo :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
$cenumFromThenTo :: BoxHandleType -> BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFromThenTo :: BoxHandleType -> BoxHandleType -> BoxHandleType -> [BoxHandleType]
Enum)

makeHandleBox ::
  BoxHandleType
  -> LBox -- ^ box being manipulated
  -> MouseManipulator
makeHandleBox :: BoxHandleType -> LBox -> MouseManipulator
makeHandleBox BoxHandleType
bht (LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) = case BoxHandleType
bht of
  BoxHandleType
BH_BR -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Corner
  BoxHandleType
BH_TL -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Corner
  BoxHandleType
BH_TR -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Corner
  BoxHandleType
BH_BL -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Corner
  BoxHandleType
BH_A  -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Area
  BoxHandleType
_     -> LBox -> MouseManipulatorType -> MouseManipulator
MouseManipulator LBox
box MouseManipulatorType
MouseManipulatorType_Side
  where
    (Int
px, Int
py) = (Int
0,Int
0) -- pan position
    CanonicalLBox Bool
_ Bool
_ LBox
clbox = LBox -> CanonicalLBox
canonicalLBox_from_lBox (LBox -> CanonicalLBox) -> LBox -> CanonicalLBox
forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
px) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
py)) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
w Int
h)
    nudgex :: Int
nudgex = if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
1 else Int
0
    nudgey :: Int
nudgey = if Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
1 else Int
0
    l :: Int
l = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nudgex
    t :: Int
t = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pyInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nudgey
    r :: Int
r = Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nudgex
    b :: Int
b = Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
pyInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nudgey
    box :: LBox
box = case BoxHandleType
bht of
      BoxHandleType
BH_BR -> XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
r Int
b) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
      BoxHandleType
BH_TL -> XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
l Int
t) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
      BoxHandleType
BH_TR -> XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
r Int
t) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
      BoxHandleType
BH_BL -> XY -> XY -> LBox
LBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
l Int
b) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)
      BoxHandleType
BH_A  -> LBox
clbox
      BoxHandleType
_     -> Text -> LBox
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"not supported yet"

makeDeltaBox :: BoxHandleType -> XY -> DeltaLBox
makeDeltaBox :: BoxHandleType -> XY -> DeltaLBox
makeDeltaBox BoxHandleType
bht (V2 Int
dx Int
dy) = case BoxHandleType
bht of
  BoxHandleType
BH_BR -> XY -> XY -> DeltaLBox
DeltaLBox XY
0 (XY -> DeltaLBox) -> XY -> DeltaLBox
forall a b. (a -> b) -> a -> b
$ Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
dy
  BoxHandleType
BH_TL -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
dy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (-Int
dx) (-Int
dy))
  BoxHandleType
BH_TR -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
dy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx (-Int
dy))
  BoxHandleType
BH_BL -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
0) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (-Int
dx) Int
dy)
  BoxHandleType
BH_T  -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
dy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 (-Int
dy))
  BoxHandleType
BH_B  -> XY -> XY -> DeltaLBox
DeltaLBox XY
0 (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
dy)
  BoxHandleType
BH_L  -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
0) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (-Int
dx) Int
0)
  BoxHandleType
BH_R  -> XY -> XY -> DeltaLBox
DeltaLBox XY
0 (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
0)
  BoxHandleType
BH_A  -> XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
dx Int
dy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
0)



-- TODO rename to BoxHandlerType or something
data BoxCreationType = BoxCreationType_None | BoxCreationType_Box | BoxCreationType_Text | BoxCreationType_TextArea | BoxCreationType_DragSelect deriving (Int -> BoxCreationType -> ShowS
[BoxCreationType] -> ShowS
BoxCreationType -> String
(Int -> BoxCreationType -> ShowS)
-> (BoxCreationType -> String)
-> ([BoxCreationType] -> ShowS)
-> Show BoxCreationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoxCreationType -> ShowS
showsPrec :: Int -> BoxCreationType -> ShowS
$cshow :: BoxCreationType -> String
show :: BoxCreationType -> String
$cshowList :: [BoxCreationType] -> ShowS
showList :: [BoxCreationType] -> ShowS
Show, BoxCreationType -> BoxCreationType -> Bool
(BoxCreationType -> BoxCreationType -> Bool)
-> (BoxCreationType -> BoxCreationType -> Bool)
-> Eq BoxCreationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoxCreationType -> BoxCreationType -> Bool
== :: BoxCreationType -> BoxCreationType -> Bool
$c/= :: BoxCreationType -> BoxCreationType -> Bool
/= :: BoxCreationType -> BoxCreationType -> Bool
Eq)

boxCreationType_isCreation :: BoxCreationType -> Bool
boxCreationType_isCreation :: BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
bct = BoxCreationType
bct BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
/= BoxCreationType
BoxCreationType_None Bool -> Bool -> Bool
&& BoxCreationType
bct BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
/= BoxCreationType
BoxCreationType_DragSelect


-- new handler stuff
data BoxHandler = BoxHandler {

    BoxHandler -> BoxHandleType
_boxHandler_handle      :: BoxHandleType -- the current handle we are dragging

    -- TODO this is wrong as makeDragOperation does not always return a Llama
    -- rename this to mouseActive or something
    , BoxHandler -> Bool
_boxHandler_undoFirst :: Bool

    -- with this you can use same code for both create and manipulate (create the handler and immediately pass input to it)
    , BoxHandler -> BoxCreationType
_boxHandler_creation  :: BoxCreationType
    , BoxHandler -> Bool
_boxHandler_active    :: Bool

    , BoxHandler -> Bool
_boxHandler_downOnLabel :: Bool


    , BoxHandler -> Maybe DeltaLBox
_boxHandler_prevDeltaLBox :: Maybe DeltaLBox

  } deriving (Int -> BoxHandler -> ShowS
[BoxHandler] -> ShowS
BoxHandler -> String
(Int -> BoxHandler -> ShowS)
-> (BoxHandler -> String)
-> ([BoxHandler] -> ShowS)
-> Show BoxHandler
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoxHandler -> ShowS
showsPrec :: Int -> BoxHandler -> ShowS
$cshow :: BoxHandler -> String
show :: BoxHandler -> String
$cshowList :: [BoxHandler] -> ShowS
showList :: [BoxHandler] -> ShowS
Show)

makeDragDeltaBox :: BoxHandleType -> RelMouseDrag -> DeltaLBox
makeDragDeltaBox :: BoxHandleType -> RelMouseDrag -> DeltaLBox
makeDragDeltaBox BoxHandleType
bht RelMouseDrag
rmd = DeltaLBox
r where
  RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..} = RelMouseDrag
rmd
  dragDelta :: XY
dragDelta = XY
_mouseDrag_to XY -> XY -> XY
forall a. Num a => a -> a -> a
- XY
_mouseDrag_from
  shiftClick :: Bool
shiftClick = KeyModifier -> [KeyModifier] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers

  boxRestrictedDelta :: XY
boxRestrictedDelta = if Bool
shiftClick
    then XY -> XY
restrict8 XY
dragDelta
    else XY
dragDelta

  r :: DeltaLBox
r = BoxHandleType -> XY -> DeltaLBox
makeDeltaBox BoxHandleType
bht XY
boxRestrictedDelta

-- reduces the DeltaLBox such that the LBox does not invert
-- assumes LBox is canonical and that LBox is not already smaller than the desired constrained size
constrainDeltaLBox :: Int -> DeltaLBox -> LBox -> DeltaLBox
constrainDeltaLBox :: Int -> DeltaLBox -> LBox -> DeltaLBox
constrainDeltaLBox Int
minsize d1 :: DeltaLBox
d1@(DeltaLBox (V2 Int
dx Int
dy) (V2 Int
dw Int
dh)) d2 :: LBox
d2@((LBox (V2 Int
x Int
y) (V2 Int
w Int
h))) = DeltaLBox
r where
  optuple :: b -> (b, b)
optuple b
e = (b
e, -b
e)

  (Int
ndx, Int
ndw) = if Int
dx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 
    then Int -> (Int, Int)
forall {b}. Num b => b -> (b, b)
optuple (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
minsize) Int
dx)
    else (Int
dx, (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minsize (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dw)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)
  
  (Int
ndy, Int
ndh) = if Int
dy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
    then Int -> (Int, Int)
forall {b}. Num b => b -> (b, b)
optuple (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
minsize) Int
dy)
    else (Int
dy, (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minsize (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dh)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h)

  istranslateonly :: Bool
istranslateonly = Int
dw Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
dh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  
  r :: DeltaLBox
r = if Bool
istranslateonly 
    then DeltaLBox
d1 
    else XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
ndx Int
ndy) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
ndw Int
ndh)

-- OR you remove the delta portion that already modified the box in preview
makeDragOperationNew :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperationNew :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperationNew PotatoHandlerInput
phi DeltaLBox
dbox = Maybe Llama
op where
  selection :: Seq SuperOwl
selection = PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi
  selectionl :: [SuperOwl]
selectionl = Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> [SuperOwl]
forall a b. (a -> b) -> a -> b
$ PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi
  pfs :: OwlPFState
pfs = PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_pFState PotatoHandlerInput
phi
  lboxes :: [LBox]
lboxes = (SuperOwl -> LBox) -> [SuperOwl] -> [LBox]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_box (OwlSubItem -> SEltDrawer
getDrawer (OwlSubItem -> SEltDrawer)
-> (SuperOwl -> OwlSubItem) -> SuperOwl -> SEltDrawer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlSubItem
forall o. HasOwlItem o => o -> OwlSubItem
hasOwlItem_toOwlSubItem (SuperOwl -> SEltDrawer) -> SuperOwl -> SEltDrawer
forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) OwlPFState
pfs) [SuperOwl]
selectionl

  -- go through each element in selection and ensure that dbox does not invert that element
  -- DANGER you need to make sure you have sensible bounding box functions or you might put things in a non-resizeable state
  constraineddbox :: DeltaLBox
constraineddbox = (DeltaLBox -> LBox -> DeltaLBox)
-> DeltaLBox -> [LBox] -> DeltaLBox
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int -> DeltaLBox -> LBox -> DeltaLBox
constrainDeltaLBox Int
1) DeltaLBox
dbox [LBox]
lboxes

  fmapfn :: SuperOwl -> Llama
fmapfn SuperOwl
sowl = (Int, SElt) -> Llama
makeSetLlama (Int
rid, SElt
newselt) where
    rid :: Int
rid = SuperOwl -> Int
_superOwl_id SuperOwl
sowl
    oldselt :: SElt
oldselt = SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl
    -- TODO don't use the CBoundingBox version of that funciton, it's deprecated, write a new one.
    newselt :: SElt
newselt = Bool -> SElt -> CBoundingBox -> SElt
modify_sElt_with_cBoundingBox Bool
True SElt
oldselt (DeltaLBox -> CBoundingBox
CBoundingBox DeltaLBox
constraineddbox)

  op :: Maybe Llama
op = if Seq SuperOwl -> Bool
forall a. Seq a -> Bool
Seq.null Seq SuperOwl
selection
    then Maybe Llama
forall a. Maybe a
Nothing
    else Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ [Llama] -> Llama
makeCompositionLlama ([Llama] -> Llama) -> ([Llama] -> [Llama]) -> [Llama] -> Llama
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Llama] -> [Llama]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Llama] -> Llama) -> [Llama] -> Llama
forall a b. (a -> b) -> a -> b
$ ((SuperOwl -> Llama) -> [SuperOwl] -> [Llama]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SuperOwl -> Llama
fmapfn [SuperOwl]
selectionl)


makeDragOperation :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperation :: PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperation PotatoHandlerInput
phi DeltaLBox
dbox = Maybe Llama
op where
  selection :: Seq SuperOwl
selection = PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi
  selectionl :: [SuperOwl]
selectionl = Seq SuperOwl -> [SuperOwl]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq SuperOwl -> [SuperOwl]) -> Seq SuperOwl -> [SuperOwl]
forall a b. (a -> b) -> a -> b
$ PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi
  pfs :: OwlPFState
pfs = PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_pFState PotatoHandlerInput
phi
  lboxes :: [LBox]
lboxes = (SuperOwl -> LBox) -> [SuperOwl] -> [LBox]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> SEltDrawer -> SEltDrawerBoxFn
_sEltDrawer_box (OwlSubItem -> SEltDrawer
getDrawer (OwlSubItem -> SEltDrawer)
-> (SuperOwl -> OwlSubItem) -> SuperOwl -> SEltDrawer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlSubItem
forall o. HasOwlItem o => o -> OwlSubItem
hasOwlItem_toOwlSubItem (SuperOwl -> SEltDrawer) -> SuperOwl -> SEltDrawer
forall a b. (a -> b) -> a -> b
$ SuperOwl
sowl) OwlPFState
pfs) [SuperOwl]
selectionl

  -- go through each element in selection and ensure that dbox does not invert that element
  -- DANGER you need to make sure you have sensible bounding box functions or you might put things in a non-resizeable state
  constraineddbox :: DeltaLBox
constraineddbox = (DeltaLBox -> LBox -> DeltaLBox)
-> DeltaLBox -> [LBox] -> DeltaLBox
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int -> DeltaLBox -> LBox -> DeltaLBox
constrainDeltaLBox Int
0) DeltaLBox
dbox [LBox]
lboxes

  makeController :: SuperOwl -> DSum CTag Identity
makeController SuperOwl
_ = DSum CTag Identity
cmd where
    cmd :: DSum CTag Identity
cmd = CTag CBoundingBox
CTagBoundingBox CTag CBoundingBox -> Identity CBoundingBox -> DSum CTag Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> (CBoundingBox -> Identity CBoundingBox
forall a. a -> Identity a
Identity (CBoundingBox -> Identity CBoundingBox)
-> CBoundingBox -> Identity CBoundingBox
forall a b. (a -> b) -> a -> b
$ CBoundingBox {
      _cBoundingBox_deltaBox :: DeltaLBox
_cBoundingBox_deltaBox = DeltaLBox
dbox -- constraineddbox
    })

  op :: Maybe Llama
op = if Seq SuperOwl -> Bool
forall a. Seq a -> Bool
Seq.null Seq SuperOwl
selection
    then Maybe Llama
forall a. Maybe a
Nothing
    else Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ OwlPFCmd -> Llama
makePFCLlama (OwlPFCmd -> Llama)
-> (ControllersWithId -> OwlPFCmd) -> ControllersWithId -> Llama
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> OwlPFCmd
OwlPFCManipulate (ControllersWithId -> Llama) -> ControllersWithId -> Llama
forall a b. (a -> b) -> a -> b
$ [(Int, DSum CTag Identity)] -> ControllersWithId
forall a. [(Int, a)] -> IntMap a
IM.fromList ((SuperOwl -> (Int, DSum CTag Identity))
-> [SuperOwl] -> [(Int, DSum CTag Identity)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
s -> (SuperOwl -> Int
_superOwl_id SuperOwl
s, SuperOwl -> DSum CTag Identity
makeController SuperOwl
s)) [SuperOwl]
selectionl)

-- TODO split this handler in two handlers
-- one for resizing selection (including boxes)
-- and one exclusively for creating boxes
instance Default BoxHandler where
  def :: BoxHandler
def = BoxHandler {
      _boxHandler_handle :: BoxHandleType
_boxHandler_handle       = BoxHandleType
BH_BR
      , _boxHandler_undoFirst :: Bool
_boxHandler_undoFirst  = Bool
False
      , _boxHandler_creation :: BoxCreationType
_boxHandler_creation = BoxCreationType
BoxCreationType_None
      , _boxHandler_active :: Bool
_boxHandler_active = Bool
False
      , _boxHandler_downOnLabel :: Bool
_boxHandler_downOnLabel = Bool
False
      , _boxHandler_prevDeltaLBox :: Maybe DeltaLBox
_boxHandler_prevDeltaLBox = Maybe DeltaLBox
forall a. Maybe a
Nothing
      -- TODO whatever
      --, _boxHandler_wasDragged = False
    }



selectionOnlySBox :: CanvasSelection -> Maybe SBox
selectionOnlySBox :: CanvasSelection -> Maybe SBox
selectionOnlySBox (CanvasSelection Seq SuperOwl
selection) = if Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  then case SuperOwl -> SElt
superOwl_toSElt_hack (Seq SuperOwl -> Int -> SuperOwl
forall a. Seq a -> Int -> a
Seq.index Seq SuperOwl
selection Int
0) of
    SEltBox SBox
sbox -> SBox -> Maybe SBox
forall a. a -> Maybe a
Just SBox
sbox
    SElt
_ -> Maybe SBox
forall a. Maybe a
Nothing
  else Maybe SBox
forall a. Maybe a
Nothing


isMouseOnSelectionSBoxBorder :: CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder :: CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder CanvasSelection
cs (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = case CanvasSelection -> Maybe SBox
selectionOnlySBox CanvasSelection
cs of
  -- not an SBox selected
  Maybe SBox
Nothing -> Bool
False
  Just SBox
sbox -> if SBoxType -> Bool
sBoxType_hasBorder (SBox -> SBoxType
_sBox_boxType SBox
sbox) Bool -> Bool -> Bool
&& LBox -> XY -> Bool
does_lBox_contains_XY (LBox -> LBox
lBox_to_boxLabelBox (SBox -> LBox
_sBox_box SBox
sbox)) XY
_mouseDrag_from
    then Bool
True
    else Bool
False

minusDeltaLBox :: DeltaLBox -> DeltaLBox -> DeltaLBox
minusDeltaLBox :: DeltaLBox -> DeltaLBox -> DeltaLBox
minusDeltaLBox (DeltaLBox (V2 Int
dx1 Int
dy1) (V2 Int
dw1 Int
dh1)) (DeltaLBox (V2 Int
dx2 Int
dy2) (V2 Int
dw2 Int
dh2)) = XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
dx1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dx2) (Int
dy1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dy2)) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
dw1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dw2) (Int
dh1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dh2))

instance PotatoHandler BoxHandler where
  pHandlerName :: BoxHandler -> Text
pHandlerName BoxHandler
_ = Text
handlerName_box
  pHandleMouse :: BoxHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse bh :: BoxHandler
bh@BoxHandler {Bool
Maybe DeltaLBox
BoxCreationType
BoxHandleType
_boxHandler_handle :: BoxHandler -> BoxHandleType
_boxHandler_undoFirst :: BoxHandler -> Bool
_boxHandler_creation :: BoxHandler -> BoxCreationType
_boxHandler_active :: BoxHandler -> Bool
_boxHandler_downOnLabel :: BoxHandler -> Bool
_boxHandler_prevDeltaLBox :: BoxHandler -> Maybe DeltaLBox
_boxHandler_handle :: BoxHandleType
_boxHandler_undoFirst :: Bool
_boxHandler_creation :: BoxCreationType
_boxHandler_active :: Bool
_boxHandler_downOnLabel :: Bool
_boxHandler_prevDeltaLBox :: Maybe DeltaLBox
..} phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} rmd :: RelMouseDrag
rmd@(RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_from :: XY
_mouseDrag_button :: MouseButton
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_to :: XY
_mouseDrag_state :: MouseDragState
_mouseDrag_isLayerMouse :: Bool
..}) = case MouseDragState
_mouseDrag_state of

    -- TODO creation should be a separate handler
    MouseDragState
MouseDragState_Down | BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
_boxHandler_creation ->  PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
forall a. Default a => a
def {
        _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler bh { _boxHandler_active = True }
      }
    -- if shift is held down, ignore inputs, this allows us to shift + click to deselect
    -- TODO consider moving this into GoatWidget since it's needed by many manipulators
    MouseDragState
MouseDragState_Down | KeyModifier -> [KeyModifier] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
    -- in DragSelect case we already have a selection
    MouseDragState
MouseDragState_Down | BoxCreationType
_boxHandler_creation BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_DragSelect  -> Bool -> Maybe PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> (Selection -> Bool) -> Selection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection -> Bool
forall a. IsParliament a => a -> Bool
isParliament_null (Selection -> Bool) -> Selection -> Bool
forall a b. (a -> b) -> a -> b
$ Selection
_potatoHandlerInput_selection) Maybe PotatoHandlerOutput
r where
        newbh :: BoxHandler
newbh = BoxHandler
bh {
            -- drag select case is always BH_A
            _boxHandler_handle = BH_A
            , _boxHandler_active = True
          }
        r :: Maybe PotatoHandlerOutput
r = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh }
    MouseDragState
MouseDragState_Down -> case OwlPFState -> RelMouseDrag -> CanvasSelection -> Maybe Int
findFirstMouseManipulator OwlPFState
_potatoHandlerInput_pFState RelMouseDrag
rmd CanvasSelection
_potatoHandlerInput_canvasSelection of
      Maybe Int
Nothing -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing



      -- clicked on a manipulator, begin dragging
      Just Int
mi -> Maybe PotatoHandlerOutput
r where
        newbh :: BoxHandler
newbh = BoxHandler
bh {
            _boxHandler_handle = bht
            , _boxHandler_active = True
            -- label position always intersects BH_A so we do the test in here to see if we clicked on the label area
            , _boxHandler_downOnLabel = if bht == BH_A then isMouseOnSelectionSBoxBorder _potatoHandlerInput_canvasSelection rmd else False
          }
        bht :: BoxHandleType
bht = Int -> BoxHandleType
forall a. Enum a => Int -> a
toEnum Int
mi
        -- special case behavior for BH_A require actually clicking on something on selection
        clickOnSelection :: Bool
clickOnSelection = (SuperOwl -> Bool) -> Seq SuperOwl -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (XY -> SElt -> Bool
doesSEltIntersectPoint XY
_mouseDrag_to (SElt -> Bool) -> (SuperOwl -> SElt) -> SuperOwl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SElt
superOwl_toSElt_hack) (Seq SuperOwl -> Bool) -> Seq SuperOwl -> Bool
forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection
        r :: Maybe PotatoHandlerOutput
r = if BoxHandleType
bht BoxHandleType -> BoxHandleType -> Bool
forall a. Eq a => a -> a -> Bool
/= BoxHandleType
BH_A Bool -> Bool -> Bool
|| Bool
clickOnSelection
          then PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh }
          else Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing


    MouseDragState
MouseDragState_Dragging -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
      dragDelta :: XY
dragDelta = XY
_mouseDrag_to XY -> XY -> XY
forall a. Num a => a -> a -> a
- XY
_mouseDrag_from
      newEltPos :: OwlSpot
newEltPos = OwlTree -> Selection -> OwlSpot
lastPositionInSelection (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
_potatoHandlerInput_pFState) Selection
_potatoHandlerInput_selection

      -- TODO do I use this for box creation? Prob want to restrictDiag or something though
      --shiftClick = elem KeyModifier_Shift _mouseDrag_modifiers
      --boxRestrictedDelta = if shiftClick then restrict8 dragDelta else dragDelta

      boxToAdd :: SBox
boxToAdd = SBox
forall a. Default a => a
def {
          _sBox_box     = canonicalLBox_from_lBox_ $ LBox _mouseDrag_from dragDelta
          -- consider using _potatoDefaultParameters_boxType instead
          , _sBox_boxType  = if _boxHandler_creation == BoxCreationType_Text
            then SBoxType_BoxText -- TODO pull from params
            else SBoxType_Box
          , _sBox_superStyle = _potatoDefaultParameters_superStyle _potatoHandlerInput_potatoDefaultParameters
          , _sBox_title = def { _sBoxTitle_align = _potatoDefaultParameters_box_label_textAlign _potatoHandlerInput_potatoDefaultParameters }
          , _sBox_text = def { _sBoxText_style = def { _textStyle_alignment = _potatoDefaultParameters_box_text_textAlign _potatoHandlerInput_potatoDefaultParameters } }
        }

      textAreaToAdd :: STextArea
textAreaToAdd = STextArea
forall a. Default a => a
def {
          _sTextArea_box   =  canonicalLBox_from_lBox_ $ LBox _mouseDrag_from dragDelta
          , _sTextArea_text        = Map.empty
          , _sTextArea_transparent = True
        }

      nameToAdd :: Text
nameToAdd = case BoxCreationType
_boxHandler_creation of
        BoxCreationType
BoxCreationType_Box -> Text
"<box>"
        BoxCreationType
BoxCreationType_Text -> Text
"<text>"
        BoxCreationType
BoxCreationType_TextArea -> Text
"<textarea>"
        BoxCreationType
_ -> Text -> Text
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"invalid BoxCreationType"

      mdd :: DeltaLBox
mdd = BoxHandleType -> RelMouseDrag -> DeltaLBox
makeDragDeltaBox BoxHandleType
_boxHandler_handle RelMouseDrag
rmd

      mop :: Maybe Llama
mop = case BoxCreationType
_boxHandler_creation of
        BoxCreationType
x | BoxCreationType
x BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_Box Bool -> Bool -> Bool
|| BoxCreationType
x BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_Text -> Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ OwlPFState -> OwlSpot -> OwlItem -> Llama
makeAddEltLlama OwlPFState
_potatoHandlerInput_pFState OwlSpot
newEltPos (OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
nameToAdd) (SBox -> OwlSubItem
OwlSubItemBox SBox
boxToAdd))
        BoxCreationType
BoxCreationType_TextArea -> Llama -> Maybe Llama
forall a. a -> Maybe a
Just (Llama -> Maybe Llama) -> Llama -> Maybe Llama
forall a b. (a -> b) -> a -> b
$ OwlPFState -> OwlSpot -> OwlItem -> Llama
makeAddEltLlama OwlPFState
_potatoHandlerInput_pFState OwlSpot
newEltPos (OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
nameToAdd) (STextArea -> OwlSubItem
OwlSubItemTextArea STextArea
textAreaToAdd))
        BoxCreationType
_ -> PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperationNew PotatoHandlerInput
phi (DeltaLBox -> DeltaLBox -> DeltaLBox
minusDeltaLBox DeltaLBox
mdd (DeltaLBox -> Maybe DeltaLBox -> DeltaLBox
forall a. a -> Maybe a -> a
fromMaybe (XY -> XY -> DeltaLBox
DeltaLBox XY
0 XY
0) Maybe DeltaLBox
_boxHandler_prevDeltaLBox))

      newbh :: BoxHandler
newbh = BoxHandler
bh {
          _boxHandler_undoFirst = True
          -- if we drag, we are no longer in label case
          , _boxHandler_downOnLabel = False
          , _boxHandler_prevDeltaLBox = Just mdd
        }

      -- NOTE, that if we did create a new box, it wil get auto selected and a new BoxHandler will be created for it

      r :: PotatoHandlerOutput
r = PotatoHandlerOutput
forall a. Default a => a
def {
          _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler newbh
          , _potatoHandlerOutput_action = case mop of
            Maybe Llama
Nothing -> HandlerOutputAction
HOA_Nothing
            Just Llama
op -> Preview -> HandlerOutputAction
HOA_Preview (Preview -> HandlerOutputAction) -> Preview -> HandlerOutputAction
forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview (Bool -> PreviewOperation
previewOperation_fromUndoFirst Bool
_boxHandler_undoFirst) Llama
op
        }

    MouseDragState
MouseDragState_Up | Bool
_boxHandler_downOnLabel -> if CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd
      -- clicked on the box label area
      -- pass on mouse as MouseDragState_Down is a hack but whatever it works
      -- TODO fix this hack, just have mouse up handle selection in this special case
      then BoxLabelHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> BoxLabelHandler
makeBoxLabelHandler (BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler
forall a. Default a => a
def :: BoxHandler)) CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd) PotatoHandlerInput
phi RelMouseDrag
rmd
      else Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
    MouseDragState
MouseDragState_Up -> Maybe PotatoHandlerOutput
r where

      -- TODO do selectMagic here so we can enter text edit modes from multi-selections (you will also need to modify the selection)
      nselected :: Int
nselected = Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
      selt :: Maybe SElt
selt = SuperOwl -> SElt
superOwl_toSElt_hack (SuperOwl -> SElt) -> Maybe SuperOwl -> Maybe SElt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => CanvasSelection -> Maybe SuperOwl
CanvasSelection -> Maybe SuperOwl
selectionToMaybeFirstSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
      isBox :: Bool
isBox = Int
nselected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& case Maybe SElt
selt of
        Just (SEltBox SBox
_) -> Bool
True
        Maybe SElt
_                                    -> Bool
False
      isText :: Bool
isText = Int
nselected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& case Maybe SElt
selt of
        Just (SEltBox SBox{LBox
SBoxType
SBoxText
SBoxTitle
SuperStyle
_sBox_boxType :: SBox -> SBoxType
_sBox_box :: SBox -> LBox
_sBox_superStyle :: SBox -> SuperStyle
_sBox_title :: SBox -> SBoxTitle
_sBox_text :: SBox -> SBoxText
_sBox_box :: LBox
_sBox_superStyle :: SuperStyle
_sBox_title :: SBoxTitle
_sBox_text :: SBoxText
_sBox_boxType :: SBoxType
..}) -> SBoxType -> Bool
sBoxType_isText SBoxType
_sBox_boxType
        Maybe SElt
_                                    -> Bool
False
      isTextArea :: Bool
isTextArea = Int
nselected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& case Maybe SElt
selt of
        Just (SEltTextArea STextArea
_) -> Bool
True
        Maybe SElt
_ -> Bool
False


      -- only enter sub handler if we weren't drag selecting (this includes selecting it from an unselect state without dragging)
      wasNotDragSelecting :: Bool
wasNotDragSelecting = Bool -> Bool
not (BoxCreationType
_boxHandler_creation BoxCreationType -> BoxCreationType -> Bool
forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_DragSelect)
      -- only enter subHandler we did not drag (hack, we do this by testing form _boxHandler_undoFirst)
      wasNotActuallyDragging :: Bool
wasNotActuallyDragging = Bool -> Bool
not Bool
_boxHandler_undoFirst
      -- always go straight to handler after creating a new SElt
      isCreation :: Bool
isCreation = BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
_boxHandler_creation
      r :: Maybe PotatoHandlerOutput
r = if (Bool
isText Bool -> Bool -> Bool
|| (Bool
isBox Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isCreation))
          Bool -> Bool -> Bool
&& (Bool
wasNotActuallyDragging Bool -> Bool -> Bool
|| Bool
isCreation)
          Bool -> Bool -> Bool
&& Bool
wasNotDragSelecting
        -- create box handler and pass on the input (if it was not a text box it will be converted to one by the BoxTextHandler)
        then BoxTextHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (Bool
-> SomePotatoHandler
-> CanvasSelection
-> RelMouseDrag
-> BoxTextHandler
makeBoxTextHandler Bool
isCreation (BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler
forall a. Default a => a
def :: BoxHandler)) CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd) PotatoHandlerInput
phi RelMouseDrag
rmd

        else if Bool
isTextArea
          Bool -> Bool -> Bool
&& (Bool
wasNotActuallyDragging Bool -> Bool -> Bool
|| Bool
isCreation)
          Bool -> Bool -> Bool
&& Bool
wasNotDragSelecting
          then TextAreaHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
textAreaHandler_pHandleMouse_onCreation (SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> Bool -> TextAreaHandler
makeTextAreaHandler (BoxHandler -> SomePotatoHandler
forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (BoxHandler
forall a. Default a => a
def :: BoxHandler)) CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd Bool
isCreation) PotatoHandlerInput
phi RelMouseDrag
rmd

          -- This clears the handler and causes selection to regenerate a new handler.
          -- Why do we do it this way instead of returning a handler? Not sure, doesn't matter.
          else PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def {
              _potatoHandlerOutput_action = HOA_Preview Preview_MaybeCommit
              -- doesn't work, see comments where _boxHandler_undoFirst is defined
              --_potatoHandlerOutput_action = if _boxHandler_undoFirst then HOA_Preview Preview_Commit else HOA_Nothing
            }

        -- TODO if this was a text box creation case, consider entering text edit mode

      -- TODO consider handling special case, handle when you click and release create a box in one spot, create a box that has size 1 (rather than 0 if we did it during MouseDragState_Down normal way)

    MouseDragState
MouseDragState_Cancelled -> if Bool
_boxHandler_undoFirst 
      then PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def { 
          -- you may or may not want to do this?
          --_potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler (def :: BoxHandler)
          _potatoHandlerOutput_action = HOA_Preview Preview_Cancel 
        } 
      else PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
forall a. Default a => a
def


  pHandleKeyboard :: BoxHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard BoxHandler
bh phi :: PotatoHandlerInput
phi@PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} (KeyboardData KeyboardKey
key [KeyModifier]
_) = Maybe PotatoHandlerOutput
r where

    todlbox :: (Int, Int) -> Maybe DeltaLBox
todlbox (Int
x,Int
y) = DeltaLBox -> Maybe DeltaLBox
forall a. a -> Maybe a
Just (DeltaLBox -> Maybe DeltaLBox) -> DeltaLBox -> Maybe DeltaLBox
forall a b. (a -> b) -> a -> b
$ XY -> XY -> DeltaLBox
DeltaLBox (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
y) XY
0
    mmove :: Maybe DeltaLBox
mmove = case KeyboardKey
key of
      KeyboardKey
KeyboardKey_Left -> (Int, Int) -> Maybe DeltaLBox
todlbox (-Int
1,Int
0)
      KeyboardKey
KeyboardKey_Right -> (Int, Int) -> Maybe DeltaLBox
todlbox (Int
1,Int
0)
      KeyboardKey
KeyboardKey_Up -> (Int, Int) -> Maybe DeltaLBox
todlbox (Int
0,-Int
1)
      KeyboardKey
KeyboardKey_Down -> (Int, Int) -> Maybe DeltaLBox
todlbox (Int
0,Int
1)
      KeyboardKey
_ -> Maybe DeltaLBox
forall a. Maybe a
Nothing

    r :: Maybe PotatoHandlerOutput
r = if BoxHandler -> Bool
_boxHandler_active BoxHandler
bh
      -- ignore inputs when we're in the middle of dragging
      then Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
      else case Maybe DeltaLBox
mmove of
        Maybe DeltaLBox
Nothing -> Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
        Just DeltaLBox
move -> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just PotatoHandlerOutput
r2 where
          mop :: Maybe Llama
mop = PotatoHandlerInput -> DeltaLBox -> Maybe Llama
makeDragOperationNew PotatoHandlerInput
phi DeltaLBox
move
          r2 :: PotatoHandlerOutput
r2 = PotatoHandlerOutput
forall a. Default a => a
def {
              _potatoHandlerOutput_nextHandler = Just $ SomePotatoHandler bh
              , _potatoHandlerOutput_action = case mop of
                Maybe Llama
Nothing -> HandlerOutputAction
HOA_Nothing

                -- TODO we want to PO_Start/Continue here, but we need to Preview_Commit somewhere
                Just Llama
op -> Preview -> HandlerOutputAction
HOA_Preview (Preview -> HandlerOutputAction) -> Preview -> HandlerOutputAction
forall a b. (a -> b) -> a -> b
$ PreviewOperation -> Llama -> Preview
Preview PreviewOperation
PO_StartAndCommit Llama
op
            }

  pRenderHandler :: BoxHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler BoxHandler {Bool
Maybe DeltaLBox
BoxCreationType
BoxHandleType
_boxHandler_handle :: BoxHandler -> BoxHandleType
_boxHandler_undoFirst :: BoxHandler -> Bool
_boxHandler_creation :: BoxHandler -> BoxCreationType
_boxHandler_active :: BoxHandler -> Bool
_boxHandler_downOnLabel :: BoxHandler -> Bool
_boxHandler_prevDeltaLBox :: BoxHandler -> Maybe DeltaLBox
_boxHandler_handle :: BoxHandleType
_boxHandler_undoFirst :: Bool
_boxHandler_creation :: BoxCreationType
_boxHandler_active :: Bool
_boxHandler_downOnLabel :: Bool
_boxHandler_prevDeltaLBox :: Maybe DeltaLBox
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
RenderCache
OwlPFState
PotatoDefaultParameters
LayersState
BroadPhaseState
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_canvasSelection :: CanvasSelection
..} = HandlerRenderOutput
r where
    handlePoints :: [LBox]
handlePoints = (MouseManipulator -> LBox) -> MouseManipulatorSet -> [LBox]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MouseManipulator -> LBox
_mouseManipulator_box (MouseManipulatorSet -> [LBox])
-> (MouseManipulatorSet -> MouseManipulatorSet)
-> MouseManipulatorSet
-> [LBox]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MouseManipulator -> Bool)
-> MouseManipulatorSet -> MouseManipulatorSet
forall a. (a -> Bool) -> [a] -> [a]
filter (\MouseManipulator
mm -> MouseManipulator -> MouseManipulatorType
_mouseManipulator_type MouseManipulator
mm MouseManipulatorType -> MouseManipulatorType -> Bool
forall a. Eq a => a -> a -> Bool
== MouseManipulatorType
MouseManipulatorType_Corner) (MouseManipulatorSet -> [LBox]) -> MouseManipulatorSet -> [LBox]
forall a b. (a -> b) -> a -> b
$ OwlPFState -> CanvasSelection -> MouseManipulatorSet
toMouseManipulators OwlPFState
_potatoHandlerInput_pFState CanvasSelection
_potatoHandlerInput_canvasSelection
    -- TODO highlight active manipulator if active
    --if (_boxHandler_active)
    r :: HandlerRenderOutput
r = if Bool -> Bool
not Bool
_boxHandler_active Bool -> Bool -> Bool
&& BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
_boxHandler_creation
      -- don't render anything if we are about to create a box
      then HandlerRenderOutput
emptyHandlerRenderOutput
      else [RenderHandle] -> HandlerRenderOutput
HandlerRenderOutput ((LBox -> RenderHandle) -> [LBox] -> [RenderHandle]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LBox -> RenderHandle
defaultRenderHandle [LBox]
handlePoints)
      
  pIsHandlerActive :: BoxHandler -> HandlerActiveState
pIsHandlerActive BoxHandler
bh = if BoxHandler -> Bool
_boxHandler_active BoxHandler
bh then HandlerActiveState
HAS_Active_Mouse else HandlerActiveState
HAS_Inactive

  pHandlerTool :: BoxHandler -> Maybe Tool
pHandlerTool BoxHandler {Bool
Maybe DeltaLBox
BoxCreationType
BoxHandleType
_boxHandler_handle :: BoxHandler -> BoxHandleType
_boxHandler_undoFirst :: BoxHandler -> Bool
_boxHandler_creation :: BoxHandler -> BoxCreationType
_boxHandler_active :: BoxHandler -> Bool
_boxHandler_downOnLabel :: BoxHandler -> Bool
_boxHandler_prevDeltaLBox :: BoxHandler -> Maybe DeltaLBox
_boxHandler_handle :: BoxHandleType
_boxHandler_undoFirst :: Bool
_boxHandler_creation :: BoxCreationType
_boxHandler_active :: Bool
_boxHandler_downOnLabel :: Bool
_boxHandler_prevDeltaLBox :: Maybe DeltaLBox
..} = case BoxCreationType
_boxHandler_creation of
    BoxCreationType
BoxCreationType_Box -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Box
    BoxCreationType
BoxCreationType_Text -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Text
    BoxCreationType
BoxCreationType_TextArea -> Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_TextArea
    BoxCreationType
_ -> Maybe Tool
forall a. Maybe a
Nothing