{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Controller.Manipulator.Box (
  BoxHandleType(..)
  , BoxHandler(..)
  , BoxCreationType(..)
  , makeHandleBox
  , makeDeltaBox
  --, MouseManipulator(..)
) 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.SEltMethods
import           Potato.Flow.SElts
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           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 forall a b. (a -> b) -> a -> b
$
    (forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ SAutoLine -> Maybe Attachment
_sAutoLine_attachStart SAutoLine
sline forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Attachment
att -> forall o. HasOwlTree o => o -> Int -> Bool
hasOwlTree_exists o
ot (Attachment -> Int
_attachment_target Attachment
att)))
    Bool -> Bool -> Bool
&& (forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd SAutoLine
sline forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\Attachment
att -> 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
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
..} = 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 = forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseManipulatorType] -> ShowS
$cshowList :: [MouseManipulatorType] -> ShowS
show :: MouseManipulatorType -> String
$cshow :: MouseManipulatorType -> String
showsPrec :: Int -> MouseManipulatorType -> ShowS
$cshowsPrec :: Int -> MouseManipulatorType -> ShowS
Show, MouseManipulatorType -> MouseManipulatorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseManipulatorType -> MouseManipulatorType -> Bool
$c/= :: MouseManipulatorType -> MouseManipulatorType -> Bool
== :: MouseManipulatorType -> MouseManipulatorType -> Bool
$c== :: 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) = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o. HasOwlItem o => o -> OwlSubItem
hasOwlItem_toOwlSubItem 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 = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip BoxHandleType -> LBox -> MouseManipulator
makeHandleBox (NonEmpty LBox -> LBox
union_lBoxes (LBox
xforall 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_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
..}) 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 = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxHandleType] -> ShowS
$cshowList :: [BoxHandleType] -> ShowS
show :: BoxHandleType -> String
$cshow :: BoxHandleType -> String
showsPrec :: Int -> BoxHandleType -> ShowS
$cshowsPrec :: Int -> BoxHandleType -> ShowS
Show, BoxHandleType -> BoxHandleType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoxHandleType -> BoxHandleType -> Bool
$c/= :: BoxHandleType -> BoxHandleType -> Bool
== :: BoxHandleType -> BoxHandleType -> Bool
$c== :: BoxHandleType -> BoxHandleType -> Bool
Eq, Int -> BoxHandleType
BoxHandleType -> Int
BoxHandleType -> [BoxHandleType]
BoxHandleType -> BoxHandleType
BoxHandleType -> BoxHandleType -> [BoxHandleType]
BoxHandleType -> BoxHandleType -> BoxHandleType -> [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
enumFromThenTo :: BoxHandleType -> BoxHandleType -> BoxHandleType -> [BoxHandleType]
$cenumFromThenTo :: BoxHandleType -> BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFromTo :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
$cenumFromTo :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFromThen :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
$cenumFromThen :: BoxHandleType -> BoxHandleType -> [BoxHandleType]
enumFrom :: BoxHandleType -> [BoxHandleType]
$cenumFrom :: BoxHandleType -> [BoxHandleType]
fromEnum :: BoxHandleType -> Int
$cfromEnum :: BoxHandleType -> Int
toEnum :: Int -> BoxHandleType
$ctoEnum :: Int -> BoxHandleType
pred :: BoxHandleType -> BoxHandleType
$cpred :: BoxHandleType -> BoxHandleType
succ :: BoxHandleType -> BoxHandleType
$csucc :: 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 forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
+Int
px) (Int
yforall a. Num a => a -> a -> a
+Int
py)) (forall a. a -> a -> V2 a
V2 Int
w Int
h)
    nudgex :: Int
nudgex = if Int
w forall a. Ord a => a -> a -> Bool
< Int
0 then Int
1 else Int
0
    nudgey :: Int
nudgey = if Int
h forall a. Ord a => a -> a -> Bool
< Int
0 then Int
1 else Int
0
    l :: Int
l = Int
xforall a. Num a => a -> a -> a
+Int
pxforall a. Num a => a -> a -> a
-Int
1 forall a. Num a => a -> a -> a
+ Int
nudgex
    t :: Int
t = Int
yforall a. Num a => a -> a -> a
+Int
pyforall a. Num a => a -> a -> a
-Int
1 forall a. Num a => a -> a -> a
+ Int
nudgey
    r :: Int
r = Int
xforall a. Num a => a -> a -> a
+Int
pxforall a. Num a => a -> a -> a
+Int
w forall a. Num a => a -> a -> a
- Int
nudgex
    b :: Int
b = Int
yforall a. Num a => a -> a -> a
+Int
pyforall a. Num a => a -> a -> a
+Int
h forall a. Num a => a -> a -> a
- Int
nudgey
    box :: LBox
box = case BoxHandleType
bht of
      BoxHandleType
BH_BR -> XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
r Int
b) (forall a. a -> a -> V2 a
V2 Int
1 Int
1)
      BoxHandleType
BH_TL -> XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
l Int
t) (forall a. a -> a -> V2 a
V2 Int
1 Int
1)
      BoxHandleType
BH_TR -> XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
r Int
t) (forall a. a -> a -> V2 a
V2 Int
1 Int
1)
      BoxHandleType
BH_BL -> XY -> XY -> LBox
LBox (forall a. a -> a -> V2 a
V2 Int
l Int
b) (forall a. a -> a -> V2 a
V2 Int
1 Int
1)
      BoxHandleType
BH_A  -> LBox
clbox
      BoxHandleType
_     -> 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 forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> V2 a
V2 Int
dx Int
dy
  BoxHandleType
BH_TL -> XY -> XY -> DeltaLBox
DeltaLBox (forall a. a -> a -> V2 a
V2 Int
dx Int
dy) (forall a. a -> a -> V2 a
V2 (-Int
dx) (-Int
dy))
  BoxHandleType
BH_TR -> XY -> XY -> DeltaLBox
DeltaLBox (forall a. a -> a -> V2 a
V2 Int
0 Int
dy) (forall a. a -> a -> V2 a
V2 Int
dx (-Int
dy))
  BoxHandleType
BH_BL -> XY -> XY -> DeltaLBox
DeltaLBox (forall a. a -> a -> V2 a
V2 Int
dx Int
0) (forall a. a -> a -> V2 a
V2 (-Int
dx) Int
dy)
  BoxHandleType
BH_T  -> XY -> XY -> DeltaLBox
DeltaLBox (forall a. a -> a -> V2 a
V2 Int
0 Int
dy) (forall a. a -> a -> V2 a
V2 Int
0 (-Int
dy))
  BoxHandleType
BH_B  -> XY -> XY -> DeltaLBox
DeltaLBox XY
0 (forall a. a -> a -> V2 a
V2 Int
0 Int
dy)
  BoxHandleType
BH_L  -> XY -> XY -> DeltaLBox
DeltaLBox (forall a. a -> a -> V2 a
V2 Int
dx Int
0) (forall a. a -> a -> V2 a
V2 (-Int
dx) Int
0)
  BoxHandleType
BH_R  -> XY -> XY -> DeltaLBox
DeltaLBox XY
0 (forall a. a -> a -> V2 a
V2 Int
dx Int
0)
  BoxHandleType
BH_A  -> XY -> XY -> DeltaLBox
DeltaLBox (forall a. a -> a -> V2 a
V2 Int
dx Int
dy) (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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxCreationType] -> ShowS
$cshowList :: [BoxCreationType] -> ShowS
show :: BoxCreationType -> String
$cshow :: BoxCreationType -> String
showsPrec :: Int -> BoxCreationType -> ShowS
$cshowsPrec :: Int -> BoxCreationType -> ShowS
Show, BoxCreationType -> BoxCreationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoxCreationType -> BoxCreationType -> Bool
$c/= :: BoxCreationType -> BoxCreationType -> Bool
== :: BoxCreationType -> BoxCreationType -> Bool
$c== :: BoxCreationType -> BoxCreationType -> Bool
Eq)

boxCreationType_isCreation :: BoxCreationType -> Bool
boxCreationType_isCreation :: BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
bct = BoxCreationType
bct forall a. Eq a => a -> a -> Bool
/= BoxCreationType
BoxCreationType_None Bool -> Bool -> Bool
&& BoxCreationType
bct 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
    , 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

  } deriving (Int -> BoxHandler -> ShowS
[BoxHandler] -> ShowS
BoxHandler -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoxHandler] -> ShowS
$cshowList :: [BoxHandler] -> ShowS
show :: BoxHandler -> String
$cshow :: BoxHandler -> String
showsPrec :: Int -> BoxHandler -> ShowS
$cshowsPrec :: Int -> 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_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..} = RelMouseDrag
rmd
  dragDelta :: XY
dragDelta = XY
_mouseDrag_to forall a. Num a => a -> a -> a
- XY
_mouseDrag_from
  shiftClick :: Bool
shiftClick = 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

makeDragOperation :: Bool -> PotatoHandlerInput -> DeltaLBox -> Maybe WSEvent
makeDragOperation :: Bool -> PotatoHandlerInput -> DeltaLBox -> Maybe WSEvent
makeDragOperation Bool
undoFirst PotatoHandlerInput
phi DeltaLBox
dbox = Maybe WSEvent
op where
  selection :: Seq SuperOwl
selection = PotatoHandlerInput -> Seq SuperOwl
transformableSelection PotatoHandlerInput
phi

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

  op :: Maybe WSEvent
op = if forall a. Seq a -> Bool
Seq.null Seq SuperOwl
selection
    then forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Bool, Llama) -> WSEvent
WSEApplyLlama (Bool
undoFirst, OwlPFCmd -> Llama
makePFCLlama forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControllersWithId -> OwlPFCmd
OwlPFCManipulate forall a b. (a -> b) -> a -> b
$ forall a. [(Int, a)] -> IntMap a
IM.fromList (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)) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq SuperOwl
selection)))

-- 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
      -- TODO whatever
      --, _boxHandler_wasDragged = False
    }



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


isMouseOnSelectionSBoxBorder :: CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder :: CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder CanvasSelection
cs (RelMouseDrag MouseDrag {Bool
[KeyModifier]
XY
MouseDragState
MouseButton
_mouseDrag_isLayerMouse :: Bool
_mouseDrag_state :: MouseDragState
_mouseDrag_to :: XY
_mouseDrag_modifiers :: [KeyModifier]
_mouseDrag_button :: MouseButton
_mouseDrag_from :: XY
_mouseDrag_isLayerMouse :: MouseDrag -> Bool
_mouseDrag_state :: MouseDrag -> MouseDragState
_mouseDrag_to :: MouseDrag -> XY
_mouseDrag_modifiers :: MouseDrag -> [KeyModifier]
_mouseDrag_button :: MouseDrag -> MouseButton
_mouseDrag_from :: MouseDrag -> XY
..}) = 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


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

    -- TODO creation should be a separate handler
    MouseDragState
MouseDragState_Down | BoxCreationType -> Bool
boxCreationType_isCreation BoxCreationType
_boxHandler_creation ->  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def {
        _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler BoxHandler
bh { _boxHandler_active :: Bool
_boxHandler_active = Bool
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 | forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem KeyModifier
KeyModifier_Shift [KeyModifier]
_mouseDrag_modifiers -> forall a. Maybe a
Nothing
    -- in DragSelect case we already have a selection
    MouseDragState
MouseDragState_Down | BoxCreationType
_boxHandler_creation forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_DragSelect  -> forall a. HasCallStack => Bool -> a -> a
assert (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsParliament a => a -> Bool
isParliament_null 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 :: BoxHandleType
_boxHandler_handle = BoxHandleType
BH_A
            , _boxHandler_active :: Bool
_boxHandler_active = Bool
True
          }
        r :: Maybe PotatoHandlerOutput
r = forall a. a -> Maybe a
Just forall a. Default a => a
def { _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler BoxHandler
newbh }
    MouseDragState
MouseDragState_Down -> case OwlPFState -> RelMouseDrag -> CanvasSelection -> Maybe Int
findFirstMouseManipulator OwlPFState
_potatoHandlerInput_pFState RelMouseDrag
rmd CanvasSelection
_potatoHandlerInput_canvasSelection of
      Maybe Int
Nothing -> 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 :: BoxHandleType
_boxHandler_handle = BoxHandleType
bht
            , _boxHandler_active :: Bool
_boxHandler_active = Bool
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 :: Bool
_boxHandler_downOnLabel = if BoxHandleType
bht forall a. Eq a => a -> a -> Bool
== BoxHandleType
BH_A then CanvasSelection -> RelMouseDrag -> Bool
isMouseOnSelectionSBoxBorder CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd else Bool
False
          }
        bht :: BoxHandleType
bht = 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (XY -> SElt -> Bool
doesSEltIntersectPoint XY
_mouseDrag_to forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> SElt
superOwl_toSElt_hack) forall a b. (a -> b) -> a -> b
$ CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection
        r :: Maybe PotatoHandlerOutput
r = if BoxHandleType
bht forall a. Eq a => a -> a -> Bool
/= BoxHandleType
BH_A Bool -> Bool -> Bool
|| Bool
clickOnSelection
          then forall a. a -> Maybe a
Just forall a. Default a => a
def { _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler BoxHandler
newbh }
          else forall a. Maybe a
Nothing


    MouseDragState
MouseDragState_Dragging -> forall a. a -> Maybe a
Just PotatoHandlerOutput
r where
      dragDelta :: XY
dragDelta = XY
_mouseDrag_to 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 = forall a. Default a => a
def {
          _sBox_box :: LBox
_sBox_box     = LBox -> LBox
canonicalLBox_from_lBox_ forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox XY
_mouseDrag_from XY
dragDelta
          -- consider using _potatoDefaultParameters_boxType instead
          , _sBox_boxType :: SBoxType
_sBox_boxType  = if BoxCreationType
_boxHandler_creation forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_Text
            then SBoxType
SBoxType_BoxText -- TODO pull from params
            else SBoxType
SBoxType_Box
          , _sBox_superStyle :: SuperStyle
_sBox_superStyle = PotatoDefaultParameters -> SuperStyle
_potatoDefaultParameters_superStyle PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters
          , _sBox_title :: SBoxTitle
_sBox_title = forall a. Default a => a
def { _sBoxTitle_align :: TextAlign
_sBoxTitle_align = PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_label_textAlign PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters }
          , _sBox_text :: SBoxText
_sBox_text = forall a. Default a => a
def { _sBoxText_style :: TextStyle
_sBoxText_style = forall a. Default a => a
def { _textStyle_alignment :: TextAlign
_textStyle_alignment = PotatoDefaultParameters -> TextAlign
_potatoDefaultParameters_box_text_textAlign PotatoDefaultParameters
_potatoHandlerInput_potatoDefaultParameters } }
        }

      textAreaToAdd :: STextArea
textAreaToAdd = forall a. Default a => a
def {
          _sTextArea_box :: LBox
_sTextArea_box   =  LBox -> LBox
canonicalLBox_from_lBox_ forall a b. (a -> b) -> a -> b
$ XY -> XY -> LBox
LBox XY
_mouseDrag_from XY
dragDelta
          , _sTextArea_text :: TextAreaMapping
_sTextArea_text        = forall k a. Map k a
Map.empty
          , _sTextArea_transparent :: Bool
_sTextArea_transparent = Bool
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
_ -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"invalid BoxCreationType"

      mop :: Maybe WSEvent
mop = case BoxCreationType
_boxHandler_creation of
        BoxCreationType
x | BoxCreationType
x forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_Box Bool -> Bool -> Bool
|| BoxCreationType
x forall a. Eq a => a -> a -> Bool
== BoxCreationType
BoxCreationType_Text -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Bool, OwlSpot, OwlItem) -> WSEvent
WSEAddElt (Bool
_boxHandler_undoFirst, OwlSpot
newEltPos, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
nameToAdd) (SBox -> OwlSubItem
OwlSubItemBox SBox
boxToAdd))
        BoxCreationType
BoxCreationType_TextArea -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Bool, OwlSpot, OwlItem) -> WSEvent
WSEAddElt (Bool
_boxHandler_undoFirst, OwlSpot
newEltPos, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
nameToAdd) (STextArea -> OwlSubItem
OwlSubItemTextArea STextArea
textAreaToAdd))
        BoxCreationType
_ -> Bool -> PotatoHandlerInput -> DeltaLBox -> Maybe WSEvent
makeDragOperation Bool
_boxHandler_undoFirst PotatoHandlerInput
phi (BoxHandleType -> RelMouseDrag -> DeltaLBox
makeDragDeltaBox BoxHandleType
_boxHandler_handle RelMouseDrag
rmd)

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

      -- 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 = forall a. Default a => a
def {
          _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler BoxHandler
newbh
          , _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = Maybe WSEvent
mop
        }

    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 forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> BoxLabelHandler
makeBoxLabelHandler (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (forall a. Default a => a
def :: BoxHandler)) CanvasSelection
_potatoHandlerInput_canvasSelection RelMouseDrag
rmd) PotatoHandlerInput
phi RelMouseDrag
rmd
      else 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 = forall a. Seq a -> Int
Seq.length (CanvasSelection -> Seq SuperOwl
unCanvasSelection CanvasSelection
_potatoHandlerInput_canvasSelection)
      selt :: Maybe SElt
selt = SuperOwl -> SElt
superOwl_toSElt_hack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => CanvasSelection -> Maybe SuperOwl
selectionToMaybeFirstSuperOwl CanvasSelection
_potatoHandlerInput_canvasSelection
      isText :: Bool
isText = Int
nselected 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 :: SBoxType
_sBox_text :: SBoxText
_sBox_title :: SBoxTitle
_sBox_superStyle :: SuperStyle
_sBox_box :: LBox
_sBox_text :: SBox -> SBoxText
_sBox_title :: SBox -> SBoxTitle
_sBox_superStyle :: SBox -> SuperStyle
_sBox_box :: SBox -> LBox
_sBox_boxType :: SBox -> SBoxType
..}) -> SBoxType -> Bool
sBoxType_isText SBoxType
_sBox_boxType
        Maybe SElt
_                                    -> Bool
False
      isTextArea :: Bool
isTextArea = Int
nselected 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 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
wasNotActuallyDragging Bool -> Bool -> Bool
|| Bool
isCreation)
          Bool -> Bool -> Bool
&& Bool
wasNotDragSelecting
        -- create box handler and pass on the input
        then forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> BoxTextHandler
makeBoxTextHandler (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (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 forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (SomePotatoHandler
-> CanvasSelection -> RelMouseDrag -> Bool -> TextAreaHandler
makeTextAreaHandler (forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler (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 forall a. a -> Maybe a
Just forall a. Default a => a
def

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

    -- TODO check undo first condition
    MouseDragState
MouseDragState_Cancelled -> if Bool
_boxHandler_undoFirst then forall a. a -> Maybe a
Just forall a. Default a => a
def { _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = forall a. a -> Maybe a
Just WSEvent
WSEUndo } else forall a. a -> Maybe a
Just forall a. Default a => a
def


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

    todlbox :: (Int, Int) -> Maybe DeltaLBox
todlbox (Int
x,Int
y) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ XY -> XY -> DeltaLBox
DeltaLBox (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
_ -> 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 forall a. Maybe a
Nothing
      else case Maybe DeltaLBox
mmove of
        Maybe DeltaLBox
Nothing -> forall a. Maybe a
Nothing
        Just DeltaLBox
move -> forall a. a -> Maybe a
Just PotatoHandlerOutput
r2 where
          mop :: Maybe WSEvent
mop = Bool -> PotatoHandlerInput -> DeltaLBox -> Maybe WSEvent
makeDragOperation Bool
False PotatoHandlerInput
phi DeltaLBox
move
          r2 :: PotatoHandlerOutput
r2 = forall a. Default a => a
def {
              _potatoHandlerOutput_nextHandler :: Maybe SomePotatoHandler
_potatoHandlerOutput_nextHandler = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall h. PotatoHandler h => h -> SomePotatoHandler
SomePotatoHandler BoxHandler
bh
              , _potatoHandlerOutput_pFEvent :: Maybe WSEvent
_potatoHandlerOutput_pFEvent = Maybe WSEvent
mop
            }

  pRenderHandler :: BoxHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler BoxHandler {Bool
BoxCreationType
BoxHandleType
_boxHandler_downOnLabel :: Bool
_boxHandler_active :: Bool
_boxHandler_creation :: BoxCreationType
_boxHandler_undoFirst :: Bool
_boxHandler_handle :: BoxHandleType
_boxHandler_downOnLabel :: BoxHandler -> Bool
_boxHandler_active :: BoxHandler -> Bool
_boxHandler_creation :: BoxHandler -> BoxCreationType
_boxHandler_undoFirst :: BoxHandler -> Bool
_boxHandler_handle :: BoxHandler -> BoxHandleType
..} PotatoHandlerInput {LBox
CanvasSelection
Selection
PotatoDefaultParameters
RenderCache
OwlPFState
LayersState
BroadPhaseState
_potatoHandlerInput_canvasSelection :: CanvasSelection
_potatoHandlerInput_selection :: Selection
_potatoHandlerInput_screenRegion :: LBox
_potatoHandlerInput_layersState :: LayersState
_potatoHandlerInput_renderCache :: RenderCache
_potatoHandlerInput_broadPhase :: BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoDefaultParameters
_potatoHandlerInput_pFState :: OwlPFState
_potatoHandlerInput_canvasSelection :: PotatoHandlerInput -> CanvasSelection
_potatoHandlerInput_selection :: PotatoHandlerInput -> Selection
_potatoHandlerInput_screenRegion :: PotatoHandlerInput -> LBox
_potatoHandlerInput_layersState :: PotatoHandlerInput -> LayersState
_potatoHandlerInput_renderCache :: PotatoHandlerInput -> RenderCache
_potatoHandlerInput_broadPhase :: PotatoHandlerInput -> BroadPhaseState
_potatoHandlerInput_potatoDefaultParameters :: PotatoHandlerInput -> PotatoDefaultParameters
_potatoHandlerInput_pFState :: PotatoHandlerInput -> OwlPFState
..} = HandlerRenderOutput
r where
    handlePoints :: [LBox]
handlePoints = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MouseManipulator -> LBox
_mouseManipulator_box forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\MouseManipulator
mm -> MouseManipulator -> MouseManipulatorType
_mouseManipulator_type MouseManipulator
mm forall a. Eq a => a -> a -> Bool
== MouseManipulatorType
MouseManipulatorType_Corner) 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LBox -> RenderHandle
defaultRenderHandle [LBox]
handlePoints)
  pIsHandlerActive :: BoxHandler -> Bool
pIsHandlerActive = BoxHandler -> Bool
_boxHandler_active

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