{-# 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.SElts
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionManipulatorType] -> ShowS
$cshowList :: [SelectionManipulatorType] -> ShowS
show :: SelectionManipulatorType -> String
$cshow :: SelectionManipulatorType -> String
showsPrec :: Int -> SelectionManipulatorType -> ShowS
$cshowsPrec :: Int -> SelectionManipulatorType -> ShowS
Show, SelectionManipulatorType -> SelectionManipulatorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionManipulatorType -> SelectionManipulatorType -> Bool
$c/= :: SelectionManipulatorType -> SelectionManipulatorType -> Bool
== :: SelectionManipulatorType -> SelectionManipulatorType -> Bool
$c== :: SelectionManipulatorType -> SelectionManipulatorType -> Bool
Eq)

computeSelectionType :: CanvasSelection -> SelectionManipulatorType
computeSelectionType :: CanvasSelection -> SelectionManipulatorType
computeSelectionType (CanvasSelection Seq SuperOwl
selection)= 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 -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen by assumption of CanvasSelection type"
      SElt
SEltFolderEnd -> forall a t. (HasCallStack, IsText t) => t -> a
error Text
"this should never happen by assumption of CanvasSelection type"
      --SEltNone -> SMTNone
      SElt
_            -> SelectionManipulatorType
SMTBoundingBox
    SelectionManipulatorType
_ -> SelectionManipulatorType
SMTBoundingBox

restrict4 :: XY -> XY
restrict4 :: XY -> XY
restrict4 (V2 Int
x Int
y) = if forall a. Num a => a -> a
abs Int
x forall a. Ord a => a -> a -> Bool
> forall a. Num a => a -> a
abs Int
y then forall a. a -> a -> V2 a
V2 Int
x Int
0 else 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 = forall a. Num a => a -> a
abs Int
x
  normy :: Int
normy = forall a. Num a => a -> a
abs Int
y
  r :: XY
r = if Int
normx forall a. Ord a => a -> a -> Bool
> Int
normy
    then if Int
normxforall a. Num a => a -> a -> a
*Int
2 forall a. Ord a => a -> a -> Bool
> Int
normy
      then (forall a. a -> a -> V2 a
V2 Int
x Int
0)
      else (forall a. a -> a -> V2 a
V2 Int
x Int
y)
    else if Int
normyforall a. Num a => a -> a -> a
*Int
2 forall a. Ord a => a -> a -> Bool
> Int
normx
      then (forall a. a -> a -> V2 a
V2 Int
0 Int
y)
      else (forall a. a -> a -> V2 a
V2 Int
x Int
y)

selectionToSuperOwl :: (HasCallStack) => CanvasSelection -> SuperOwl
selectionToSuperOwl :: HasCallStack => CanvasSelection -> SuperOwl
selectionToSuperOwl (CanvasSelection Seq SuperOwl
selection) = forall a b. (HasCallStack, Show a) => a -> Bool -> b -> b
assertShowAndDump Seq SuperOwl
selection (forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection forall a. Eq a => a -> a -> Bool
== Int
1) forall a b. (a -> b) -> a -> b
$ 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) = 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) = forall a b. (HasCallStack, Show a) => a -> Bool -> b -> b
assertShowAndDump Seq SuperOwl
selection (forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection forall a. Ord a => a -> a -> Bool
<= Int
1) forall a b. (a -> b) -> a -> b
$ 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) = forall a b. (HasCallStack, Show a) => a -> Bool -> b -> b
assertShowAndDump Seq SuperOwl
selection (forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
Seq.index Seq SuperOwl
selection Int
0

-- NOTE if the only thing in selection is a folder, then this will put the item INSIDE the folder
lastPositionInSelection :: OwlTree -> Selection -> OwlSpot
lastPositionInSelection :: OwlTree -> Selection -> OwlSpot
lastPositionInSelection OwlTree
ot (SuperOwlParliament Seq SuperOwl
selection) = OwlSpot
r where
  r :: OwlSpot
r = case forall a. Int -> Seq a -> Maybe a
Seq.lookup (forall a. Seq a -> Int
Seq.length Seq SuperOwl
selection forall a. Num a => a -> a -> a
- Int
1) Seq SuperOwl
selection of
    Maybe SuperOwl
Nothing -> OwlSpot
topSpot
    Just SuperOwl
x -> if forall o. HasOwlItem o => o -> Bool
hasOwlItem_isFolder SuperOwl
x 
      then OwlSpot {
          _owlSpot_parent :: Int
_owlSpot_parent = SuperOwl -> Int
_superOwl_id SuperOwl
x
          -- put it at the top of the folder, on top of everything
          , _owlSpot_leftSibling :: Maybe Int
_owlSpot_leftSibling = forall a. Maybe a
Nothing
        }
      else OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
ot (SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
x)