{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-unused-record-wildcards #-}



module Potato.Flow.Controller.Manipulator.Select (
  SelectHandler(..)
) where

import           Relude

import           Potato.Flow.BroadPhase
import           Potato.Flow.Controller.Handler
import           Potato.Flow.Controller.Input
import           Potato.Flow.Controller.Manipulator.Box
import           Potato.Flow.Controller.OwlLayers
import           Potato.Flow.Methods.LineDrawer
import           Potato.Flow.Controller.Types
import           Potato.Flow.Math
import           Potato.Flow.Owl
import           Potato.Flow.OwlItem
import           Potato.Flow.OwlState
import Potato.Flow.RenderCache
import           Potato.Flow.Serialization.Snake

import           Control.Exception                      (assert)
import           Data.Default
import           Data.Foldable                          (maximumBy)
import qualified Data.Sequence                          as Seq

selectBoxFromRelMouseDrag :: RelMouseDrag -> LBox
selectBoxFromRelMouseDrag :: RelMouseDrag -> LBox
selectBoxFromRelMouseDrag (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
..}) = LBox
r where
  LBox XY
pos' XY
sz' = XY -> XY -> LBox
make_lBox_from_XYs XY
_mouseDrag_to XY
_mouseDrag_from
  -- always expand selection by 1
  r :: LBox
r = XY -> XY -> LBox
LBox XY
pos' (XY
sz' XY -> XY -> XY
forall a. Num a => a -> a -> a
+ Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
1 Int
1)


doesOwlSubItemIntersectBox :: OwlTree -> RenderCache -> LBox -> SuperOwl -> Bool
doesOwlSubItemIntersectBox :: OwlTree -> RenderCache -> LBox -> SuperOwl -> Bool
doesOwlSubItemIntersectBox OwlTree
ot RenderCache
rcache LBox
lbox SuperOwl
sowl = case SuperOwl -> OwlSubItem
superOwl_owlSubItem SuperOwl
sowl of
  OwlSubItemBox SBox
x -> LBox -> LBox -> Bool
does_lBox_intersect_include_zero_area LBox
lbox (SBox -> LBox
_sBox_box SBox
x)
  OwlSubItemTextArea STextArea
x -> LBox -> LBox -> Bool
does_lBox_intersect_include_zero_area LBox
lbox (STextArea -> LBox
_sTextArea_box STextArea
x)
  OwlSubItemLine sline :: SAutoLine
sline@SAutoLine {[SAutoLineLabel]
[SAutoLineConstraint]
Maybe Attachment
XY
LineStyle
SuperStyle
_sAutoLine_start :: XY
_sAutoLine_end :: XY
_sAutoLine_superStyle :: SuperStyle
_sAutoLine_lineStyle :: LineStyle
_sAutoLine_lineStyleEnd :: LineStyle
_sAutoLine_attachStart :: Maybe Attachment
_sAutoLine_attachEnd :: Maybe Attachment
_sAutoLine_midpoints :: [SAutoLineConstraint]
_sAutoLine_labels :: [SAutoLineLabel]
_sAutoLine_start :: SAutoLine -> XY
_sAutoLine_end :: SAutoLine -> XY
_sAutoLine_superStyle :: SAutoLine -> SuperStyle
_sAutoLine_lineStyle :: SAutoLine -> LineStyle
_sAutoLine_lineStyleEnd :: SAutoLine -> LineStyle
_sAutoLine_attachStart :: SAutoLine -> Maybe Attachment
_sAutoLine_attachEnd :: SAutoLine -> Maybe Attachment
_sAutoLine_midpoints :: SAutoLine -> [SAutoLineConstraint]
_sAutoLine_labels :: SAutoLine -> [SAutoLineLabel]
..} -> Bool
r where
    anchors :: LineAnchorsForRender
anchors = case RenderCache -> Int -> Maybe OwlItemCache
renderCache_lookup RenderCache
rcache (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) of
      Maybe OwlItemCache
Nothing -> OwlTree -> SAutoLine -> LineAnchorsForRender
forall a. HasOwlTree a => a -> SAutoLine -> LineAnchorsForRender
sSimpleLineNewRenderFnComputeCache OwlTree
ot SAutoLine
sline
      Just (OwlItemCache_Line LineAnchorsForRender
lar PreRender
_)  -> LineAnchorsForRender
lar
      Maybe OwlItemCache
_ -> Bool -> LineAnchorsForRender -> LineAnchorsForRender
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (OwlTree -> SAutoLine -> LineAnchorsForRender
forall a. HasOwlTree a => a -> SAutoLine -> LineAnchorsForRender
sSimpleLineNewRenderFnComputeCache OwlTree
ot SAutoLine
sline)
    r :: Bool
r = LineAnchorsForRender -> LBox -> Bool
lineAnchorsForRender_doesIntersectBox LineAnchorsForRender
anchors LBox
lbox
  OwlSubItem
_ -> Bool
False


-- TODO ignore locked and hidden elements here
-- for now hidden + locked elements ARE inctluded in BroadPhaseState
selectMagic :: OwlPFState -> RenderCache -> LayerMetaMap -> BroadPhaseState -> RelMouseDrag -> Selection
selectMagic :: OwlPFState
-> RenderCache
-> LayerMetaMap
-> BroadPhaseState
-> RelMouseDrag
-> Selection
selectMagic OwlPFState
pfs RenderCache
rcache LayerMetaMap
lmm BroadPhaseState
bps RelMouseDrag
rmd = Selection
r where
  selectBox :: LBox
selectBox = RelMouseDrag -> LBox
selectBoxFromRelMouseDrag RelMouseDrag
rmd
  boxSize :: Int
boxSize = LBox -> Int
lBox_area LBox
selectBox
  singleClick :: Bool
singleClick = Int
boxSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

  isboxshaped :: SuperOwl -> Bool
isboxshaped SuperOwl
sowl = case SuperOwl -> OwlItem
_superOwl_elt SuperOwl
sowl of
    OwlItem OwlInfo
_ (OwlSubItemBox SBox
_)      -> Bool
True
    OwlItem OwlInfo
_ (OwlSubItemTextArea STextArea
_) -> Bool
True
    OwlItem
_                                -> Bool
False

  unculledrids :: [Int]
unculledrids = LBox -> BPTree -> [Int]
broadPhase_cull_includeZero LBox
selectBox (BroadPhaseState -> BPTree
_broadPhaseState_bPTree BroadPhaseState
bps)
  unculledsowls :: [SuperOwl]
unculledsowls = (Int -> SuperOwl) -> [Int] -> [SuperOwl]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
rid ->  (?callStack::CallStack) => OwlTree -> Int -> SuperOwl
OwlTree -> Int -> SuperOwl
owlTree_mustFindSuperOwl (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) Int
rid) [Int]
unculledrids
  selectedsowls'' :: [SuperOwl]
selectedsowls'' = ((SuperOwl -> Bool) -> [SuperOwl] -> [SuperOwl])
-> [SuperOwl] -> (SuperOwl -> Bool) -> [SuperOwl]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SuperOwl -> Bool) -> [SuperOwl] -> [SuperOwl]
forall a. (a -> Bool) -> [a] -> [a]
filter [SuperOwl]
unculledsowls ((SuperOwl -> Bool) -> [SuperOwl])
-> (SuperOwl -> Bool) -> [SuperOwl]
forall a b. (a -> b) -> a -> b
$ \case
    -- if it's box shaped, there's no need to test for intersection as we already know it intersects based on broadphase
    SuperOwl
sowl | SuperOwl -> Bool
isboxshaped SuperOwl
sowl -> Bool
True
    SuperOwl
sowl -> OwlTree -> RenderCache -> LBox -> SuperOwl -> Bool
doesOwlSubItemIntersectBox (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) RenderCache
rcache LBox
selectBox SuperOwl
sowl

  -- remove lock and hidden stuff
  selectedsowls' :: [SuperOwl]
selectedsowls' = ((SuperOwl -> Bool) -> [SuperOwl] -> [SuperOwl])
-> [SuperOwl] -> (SuperOwl -> Bool) -> [SuperOwl]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SuperOwl -> Bool) -> [SuperOwl] -> [SuperOwl]
forall a. (a -> Bool) -> [a] -> [a]
filter [SuperOwl]
selectedsowls'' ((SuperOwl -> Bool) -> [SuperOwl])
-> (SuperOwl -> Bool) -> [SuperOwl]
forall a b. (a -> b) -> a -> b
$ \SuperOwl
sowl -> Bool -> Bool
not (OwlTree -> Int -> LayerMetaMap -> Bool
layerMetaMap_isInheritHiddenOrLocked (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) (SuperOwl -> Int
_superOwl_id SuperOwl
sowl) LayerMetaMap
lmm)

  -- TODO consider using makeSortedSuperOwlParliament instead (prob a little faster?)
  selectedsowls :: [SuperOwl]
selectedsowls = if Bool
singleClick
    -- single click, select top elt only
    then case [SuperOwl]
selectedsowls' of
      [] -> []
      [SuperOwl]
_ ->  [(SuperOwl -> SuperOwl -> Ordering) -> [SuperOwl] -> SuperOwl
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (\SuperOwl
s1 SuperOwl
s2 -> OwlTree -> SuperOwl -> SuperOwl -> Ordering
owlTree_superOwl_comparePosition (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) SuperOwl
s2 SuperOwl
s1) [SuperOwl]
selectedsowls']
    -- otherwise select everything
    else [SuperOwl]
selectedsowls'

  r :: Selection
r = OwlTree -> Seq SuperOwl -> Selection
makeSortedSuperOwlParliament (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) (Seq SuperOwl -> Selection) -> Seq SuperOwl -> Selection
forall a b. (a -> b) -> a -> b
$ [SuperOwl] -> Seq SuperOwl
forall a. [a] -> Seq a
Seq.fromList [SuperOwl]
selectedsowls


data SelectHandler = SelectHandler {
    SelectHandler -> LBox
_selectHandler_selectArea :: LBox
  }

instance Default SelectHandler where
  def :: SelectHandler
def = SelectHandler {
      _selectHandler_selectArea :: LBox
_selectHandler_selectArea = XY -> XY -> LBox
LBox XY
0 XY
0
    }

instance PotatoHandler SelectHandler where
  pHandlerName :: SelectHandler -> Text
pHandlerName SelectHandler
_ = Text
handlerName_select
  pHandleMouse :: SelectHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse SelectHandler
sh phi :: PotatoHandlerInput
phi@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
..} 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
..}) = PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a. a -> Maybe a
Just (PotatoHandlerOutput -> Maybe PotatoHandlerOutput)
-> PotatoHandlerOutput -> Maybe PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ case MouseDragState
_mouseDrag_state of
    MouseDragState
MouseDragState_Down -> PotatoHandlerOutput
r where

      nextSelection :: Selection
nextSelection@(SuperOwlParliament Seq SuperOwl
sowls) = OwlPFState
-> RenderCache
-> LayerMetaMap
-> BroadPhaseState
-> RelMouseDrag
-> Selection
selectMagic OwlPFState
_potatoHandlerInput_pFState RenderCache
_potatoHandlerInput_renderCache (LayersState -> LayerMetaMap
_layersState_meta LayersState
_potatoHandlerInput_layersState) BroadPhaseState
_potatoHandlerInput_broadPhase RelMouseDrag
rmd
      -- since selection came from canvas, it's definitely a valid CanvasSelection, no need to convert
      nextCanvasSelection :: CanvasSelection
nextCanvasSelection = Seq SuperOwl -> CanvasSelection
CanvasSelection Seq SuperOwl
sowls
      shiftClick :: Bool
shiftClick = Maybe KeyModifier -> Bool
forall a. Maybe a -> Bool
isJust (Maybe KeyModifier -> Bool) -> Maybe KeyModifier -> Bool
forall a b. (a -> b) -> a -> b
$ (KeyModifier -> Bool) -> [KeyModifier] -> Maybe KeyModifier
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (KeyModifier -> KeyModifier -> Bool
forall a. Eq a => a -> a -> Bool
==KeyModifier
KeyModifier_Shift) [KeyModifier]
_mouseDrag_modifiers

      r :: PotatoHandlerOutput
r = if Selection -> Bool
forall a. IsParliament a => a -> Bool
isParliament_null Selection
nextSelection Bool -> Bool -> Bool
|| Bool
shiftClick
        then SelectHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
captureWithNoChange SelectHandler
sh

        -- special select+drag case, override the selection
        -- NOTE BoxHandler here is used to move all SElt types, upon release, it will either return the correct handler type or not capture the input in which case Goat will set the correct handler type
        else case BoxHandler
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
forall h.
PotatoHandler h =>
h
-> PotatoHandlerInput -> RelMouseDrag -> Maybe PotatoHandlerOutput
pHandleMouse (BoxHandler
forall a. Default a => a
def { _boxHandler_creation = BoxCreationType_DragSelect }) (PotatoHandlerInput
phi { _potatoHandlerInput_selection = nextSelection, _potatoHandlerInput_canvasSelection = nextCanvasSelection }) RelMouseDrag
rmd of
          -- force the selection from outside the handler and ignore the new selection results returned by pho (which should always be Nothing)
          Just PotatoHandlerOutput
pho -> Bool -> PotatoHandlerOutput -> PotatoHandlerOutput
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool)
-> (HandlerOutputAction -> Bool) -> HandlerOutputAction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandlerOutputAction -> Bool
handlerOutputAction_isSelect (HandlerOutputAction -> Bool) -> HandlerOutputAction -> Bool
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput -> HandlerOutputAction
_potatoHandlerOutput_action PotatoHandlerOutput
pho)
            (PotatoHandlerOutput -> PotatoHandlerOutput)
-> PotatoHandlerOutput -> PotatoHandlerOutput
forall a b. (a -> b) -> a -> b
$ PotatoHandlerOutput
pho { _potatoHandlerOutput_action = HOA_Select False nextSelection }
          Maybe PotatoHandlerOutput
Nothing -> Text -> PotatoHandlerOutput
forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"handler was expected to capture this mouse state"


    MouseDragState
MouseDragState_Dragging -> SelectHandler -> PotatoHandlerOutput
forall h. PotatoHandler h => h -> PotatoHandlerOutput
setHandlerOnly SelectHandler
sh {
        _selectHandler_selectArea = selectBoxFromRelMouseDrag rmd
      }
    MouseDragState
MouseDragState_Up -> PotatoHandlerOutput
forall a. Default a => a
def { _potatoHandlerOutput_action = HOA_Select shiftClick newSelection }  where
      shiftClick :: Bool
shiftClick = Maybe KeyModifier -> Bool
forall a. Maybe a -> Bool
isJust (Maybe KeyModifier -> Bool) -> Maybe KeyModifier -> Bool
forall a b. (a -> b) -> a -> b
$ (KeyModifier -> Bool) -> [KeyModifier] -> Maybe KeyModifier
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (KeyModifier -> KeyModifier -> Bool
forall a. Eq a => a -> a -> Bool
==KeyModifier
KeyModifier_Shift) ([KeyModifier]
_mouseDrag_modifiers)
      newSelection :: Selection
newSelection = OwlPFState
-> RenderCache
-> LayerMetaMap
-> BroadPhaseState
-> RelMouseDrag
-> Selection
selectMagic OwlPFState
_potatoHandlerInput_pFState RenderCache
_potatoHandlerInput_renderCache (LayersState -> LayerMetaMap
_layersState_meta LayersState
_potatoHandlerInput_layersState) BroadPhaseState
_potatoHandlerInput_broadPhase RelMouseDrag
rmd
    MouseDragState
MouseDragState_Cancelled -> PotatoHandlerOutput
forall a. Default a => a
def
  pHandleKeyboard :: SelectHandler
-> PotatoHandlerInput -> KeyboardData -> Maybe PotatoHandlerOutput
pHandleKeyboard SelectHandler
_ 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
_ = Maybe PotatoHandlerOutput
forall a. Maybe a
Nothing
  pRenderHandler :: SelectHandler -> PotatoHandlerInput -> HandlerRenderOutput
pRenderHandler SelectHandler
sh 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
..} = [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] -> [RenderHandle]) -> [LBox] -> [RenderHandle]
forall a b. (a -> b) -> a -> b
$ LBox -> LBox -> [LBox]
substract_lBox LBox
full LBox
inside) where
    full :: LBox
full@(LBox (V2 Int
x Int
y) (V2 Int
w Int
h)) = SelectHandler -> LBox
_selectHandler_selectArea SelectHandler
sh
    inside :: LBox
inside = if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
      then 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
1) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2))
      else XY -> XY -> LBox
LBox XY
0 XY
0
  pIsHandlerActive :: SelectHandler -> HandlerActiveState
pIsHandlerActive SelectHandler
_ = HandlerActiveState
HAS_Active_Mouse
  pHandlerTool :: SelectHandler -> Maybe Tool
pHandlerTool SelectHandler
_ = Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
Tool_Select