{-# LANGUAGE RecordWildCards #-}
module Potato.Flow.Controller.Manipulator.Common (
SelectionManipulatorType(..)
, computeSelectionType
, restrict4
, restrict8
, selectionToSuperOwl
, selectionToMaybeSuperOwl
, selectionToFirstSuperOwl
, selectionToMaybeFirstSuperOwl
, lastPositionInSelection
) where
import Relude
import Potato.Flow.Controller.Types
import Potato.Flow.Math
import Potato.Flow.Serialization.Snake
import Potato.Flow.OwlItem
import Potato.Flow.Owl
import Potato.Flow.DebugHelpers
import qualified Data.Sequence as Seq
data SelectionManipulatorType = SMTNone | SMTBox | SMTBoxText | SMTLine | SMTTextArea | SMTBoundingBox deriving (Int -> SelectionManipulatorType -> ShowS
[SelectionManipulatorType] -> ShowS
SelectionManipulatorType -> String
(Int -> SelectionManipulatorType -> ShowS)
-> (SelectionManipulatorType -> String)
-> ([SelectionManipulatorType] -> ShowS)
-> Show SelectionManipulatorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectionManipulatorType -> ShowS
showsPrec :: Int -> SelectionManipulatorType -> ShowS
$cshow :: SelectionManipulatorType -> String
show :: SelectionManipulatorType -> String
$cshowList :: [SelectionManipulatorType] -> ShowS
showList :: [SelectionManipulatorType] -> ShowS
Show, SelectionManipulatorType -> SelectionManipulatorType -> Bool
(SelectionManipulatorType -> SelectionManipulatorType -> Bool)
-> (SelectionManipulatorType -> SelectionManipulatorType -> Bool)
-> Eq SelectionManipulatorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectionManipulatorType -> SelectionManipulatorType -> Bool
== :: SelectionManipulatorType -> SelectionManipulatorType -> Bool
$c/= :: SelectionManipulatorType -> SelectionManipulatorType -> Bool
/= :: SelectionManipulatorType -> SelectionManipulatorType -> Bool
Eq)
computeSelectionType :: CanvasSelection -> SelectionManipulatorType
computeSelectionType :: CanvasSelection -> SelectionManipulatorType
computeSelectionType (CanvasSelection Seq SuperOwl
selection)= (SelectionManipulatorType -> SuperOwl -> SelectionManipulatorType)
-> SelectionManipulatorType
-> Seq SuperOwl
-> SelectionManipulatorType
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SelectionManipulatorType -> SuperOwl -> SelectionManipulatorType
foldfn SelectionManipulatorType
SMTNone Seq SuperOwl
selection where
foldfn :: SelectionManipulatorType -> SuperOwl -> SelectionManipulatorType
foldfn SelectionManipulatorType
accType SuperOwl
sowl = case SelectionManipulatorType
accType of
SelectionManipulatorType
SMTNone -> case SuperOwl -> SElt
superOwl_toSElt_hack SuperOwl
sowl of
SEltBox SBox
sbox -> if SBoxType -> Bool
sBoxType_isText (SBox -> SBoxType
_sBox_boxType SBox
sbox) then SelectionManipulatorType
SMTBoxText else SelectionManipulatorType
SMTBox
SEltLine SAutoLine
_ -> SelectionManipulatorType
SMTLine
SEltTextArea STextArea
_ -> SelectionManipulatorType
SMTTextArea
SElt
SEltFolderStart -> Text -> SelectionManipulatorType
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen by assumption of CanvasSelection type"
SElt
SEltFolderEnd -> Text -> SelectionManipulatorType
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen by assumption of CanvasSelection type"
SElt
_ -> SelectionManipulatorType
SMTBoundingBox
SelectionManipulatorType
_ -> SelectionManipulatorType
SMTBoundingBox
restrict4 :: XY -> XY
restrict4 :: XY -> XY
restrict4 (V2 Int
x Int
y) = if Int -> Int
forall a. Num a => a -> a
abs Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a. Num a => a -> a
abs Int
y then Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
0 else Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
y
restrict8 :: XY -> XY
restrict8 :: XY -> XY
restrict8 (V2 Int
x Int
y) = XY
r where
normx :: Int
normx = Int -> Int
forall a. Num a => a -> a
abs Int
x
normy :: Int
normy = Int -> Int
forall a. Num a => a -> a
abs Int
y
r :: XY
r = if Int
normx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
normy
then if Int
normxInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
normy
then (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
0)
else (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
y)
else if Int
normyInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
normx
then (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
0 Int
y)
else (Int -> Int -> XY
forall a. a -> a -> V2 a
V2 Int
x Int
y)
selectionToSuperOwl :: (HasCallStack) => CanvasSelection -> SuperOwl
selectionToSuperOwl :: HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl (CanvasSelection Seq SuperOwl
selection) = Seq SuperOwl -> Bool -> SuperOwl -> SuperOwl
forall a b. (HasCallStack, Show a) => a -> Bool -> b -> b
assertShowAndDump Seq SuperOwl
selection (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) (SuperOwl -> SuperOwl) -> SuperOwl -> SuperOwl
forall a b. (a -> b) -> a -> b
$ Seq SuperOwl -> Int -> SuperOwl
forall a. Seq a -> Int -> a
Seq.index Seq SuperOwl
selection Int
0
selectionToMaybeFirstSuperOwl :: (HasCallStack) => CanvasSelection -> Maybe SuperOwl
selectionToMaybeFirstSuperOwl :: HasCallStack => CanvasSelection -> Maybe SuperOwl
selectionToMaybeFirstSuperOwl (CanvasSelection Seq SuperOwl
selection) = Int -> Seq SuperOwl -> Maybe SuperOwl
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq SuperOwl
selection
selectionToMaybeSuperOwl :: (HasCallStack) => CanvasSelection -> Maybe SuperOwl
selectionToMaybeSuperOwl :: HasCallStack => CanvasSelection -> Maybe SuperOwl
selectionToMaybeSuperOwl (CanvasSelection Seq SuperOwl
selection) = Seq SuperOwl -> Bool -> Maybe SuperOwl -> Maybe SuperOwl
forall a b. (HasCallStack, Show a) => a -> Bool -> b -> b
assertShowAndDump Seq SuperOwl
selection (Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1) (Maybe SuperOwl -> Maybe SuperOwl)
-> Maybe SuperOwl -> Maybe SuperOwl
forall a b. (a -> b) -> a -> b
$ Int -> Seq SuperOwl -> Maybe SuperOwl
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
0 Seq SuperOwl
selection
selectionToFirstSuperOwl :: (HasCallStack) => CanvasSelection -> SuperOwl
selectionToFirstSuperOwl :: HasCallStack => CanvasSelection -> SuperOwl
selectionToFirstSuperOwl (CanvasSelection Seq SuperOwl
selection) = Seq SuperOwl -> Bool -> SuperOwl -> SuperOwl
forall a b. (HasCallStack, Show a) => a -> Bool -> b -> b
assertShowAndDump Seq SuperOwl
selection (Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (SuperOwl -> SuperOwl) -> SuperOwl -> SuperOwl
forall a b. (a -> b) -> a -> b
$ Seq SuperOwl -> Int -> SuperOwl
forall a. Seq a -> Int -> a
Seq.index Seq SuperOwl
selection Int
0
lastPositionInSelection :: OwlTree -> Selection -> OwlSpot
lastPositionInSelection :: OwlTree -> Selection -> OwlSpot
lastPositionInSelection OwlTree
ot (SuperOwlParliament Seq SuperOwl
selection) = OwlSpot
r where
r :: OwlSpot
r = case Int -> Seq SuperOwl -> Maybe SuperOwl
forall a. Int -> Seq a -> Maybe a
Seq.lookup (Seq SuperOwl -> Int
forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq SuperOwl
selection of
Maybe SuperOwl
Nothing -> OwlSpot
topSpot
Just SuperOwl
x -> if SuperOwl -> Bool
forall o. HasOwlItem o => o -> Bool
hasOwlItem_isFolder SuperOwl
x
then OwlSpot {
_owlSpot_parent :: Int
_owlSpot_parent = SuperOwl -> Int
_superOwl_id SuperOwl
x
, _owlSpot_leftSibling :: Maybe Int
_owlSpot_leftSibling = Maybe Int
forall a. Maybe a
Nothing
}
else OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
ot (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
x)