-- DEPRECATED
-- keeping around because we use the types for testing

{-# LANGUAGE RecordWildCards #-}

module Potato.Flow.Deprecated.State (
  PFState(..)
  , debugPrintPFState
  , pFState_isValid
  , pFState_selectionIsValid
  , pFState_copyElts
  , pFState_getSuperSEltByPos
  , pFState_getSEltLabels
  , pFState_maxID
  , pFState_getLayerPosMap
  , sPotatoFlow_to_pFState
  , pFState_to_sPotatoFlow
  , pFState_toCanvasCoordinates
  , pfState_layerPos_to_superSEltLabel
  , pFState_to_superSEltLabelSeq

  , emptyPFState
  , do_newElts
  , undo_newElts
  , do_deleteElts
  , undo_deleteElts

  -- TODO test
  , do_move
  , undo_move

  , do_resizeCanvas
  , undo_resizeCanvas
  , do_manipulate
  , undo_manipulate
) where

import           Relude


import           Potato.Flow.Deprecated.Layers
import           Potato.Flow.Math
import           Potato.Flow.Methods.SEltMethods
import           Potato.Flow.Serialization.Snake
import           Potato.Flow.Types

import           Control.Exception       (assert)
import           Data.Aeson
import qualified Data.IntMap.Strict      as IM
import           Data.List.Ordered       (isSorted)
import           Data.Maybe
import qualified Data.Sequence           as Seq


data PFState = PFState {
  -- TODO someday change this to bimap so that we can get rid of _pfo_layerPosMap
  PFState -> Seq Int
_pFState_layers      :: Seq REltId
  , PFState -> REltIdMap SEltLabel
_pFState_directory :: REltIdMap SEltLabel
  , PFState -> SCanvas
_pFState_canvas    :: SCanvas
} deriving (PFState -> PFState -> Bool
(PFState -> PFState -> Bool)
-> (PFState -> PFState -> Bool) -> Eq PFState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PFState -> PFState -> Bool
== :: PFState -> PFState -> Bool
$c/= :: PFState -> PFState -> Bool
/= :: PFState -> PFState -> Bool
Eq, Int -> PFState -> ShowS
[PFState] -> ShowS
PFState -> String
(Int -> PFState -> ShowS)
-> (PFState -> String) -> ([PFState] -> ShowS) -> Show PFState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PFState -> ShowS
showsPrec :: Int -> PFState -> ShowS
$cshow :: PFState -> String
show :: PFState -> String
$cshowList :: [PFState] -> ShowS
showList :: [PFState] -> ShowS
Show, (forall x. PFState -> Rep PFState x)
-> (forall x. Rep PFState x -> PFState) -> Generic PFState
forall x. Rep PFState x -> PFState
forall x. PFState -> Rep PFState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PFState -> Rep PFState x
from :: forall x. PFState -> Rep PFState x
$cto :: forall x. Rep PFState x -> PFState
to :: forall x. Rep PFState x -> PFState
Generic)

instance FromJSON PFState
instance ToJSON PFState
instance NFData PFState

debugPrintPFState :: (IsString a) => PFState -> a
debugPrintPFState :: forall a. IsString a => PFState -> a
debugPrintPFState PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"PFState:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Seq Int -> String
forall b a. (Show a, IsString b) => a -> b
show Seq Int
_pFState_layers String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Int] -> String
forall b a. (Show a, IsString b) => a -> b
show (REltIdMap SEltLabel -> [Int]
forall a. IntMap a -> [Int]
IM.keys REltIdMap SEltLabel
_pFState_directory) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"

pFState_isValid :: PFState -> Bool
pFState_isValid :: PFState -> Bool
pFState_isValid pfs :: PFState
pfs@PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} = PFState -> [Int] -> Bool
pFState_selectionIsValid PFState
pfs ([Int
0..Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
_pFState_layers Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])
{-validElts && validScope where
  validElts = all isJust . toList $ fmap ((IM.!?) _pFState_directory) _pFState_layers
  validScope = hasScopingProperty scopeFn _pFState_layers
  scopeFn x = case IM.lookup x _pFState_directory of
    Nothing                            -> Nothing -- this will fail in vaildElts case so it doesn't matter what we do here
    Just (SEltLabel _ SEltFolderStart) -> Just True
    Just (SEltLabel _ SEltFolderEnd)   -> Just False
    _                                  -> Nothing
-}

pFState_selectionIsValid :: PFState -> [LayerPos] -> Bool
pFState_selectionIsValid :: PFState -> [Int] -> Bool
pFState_selectionIsValid PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} [Int]
lps = Bool
validElts Bool -> Bool -> Bool
&& Bool
validScope Bool -> Bool -> Bool
&& Bool
sorted where
  validElts :: Bool
validElts = (Maybe SEltLabel -> Bool) -> [Maybe SEltLabel] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe SEltLabel -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe SEltLabel] -> Bool)
-> (Seq (Maybe SEltLabel) -> [Maybe SEltLabel])
-> Seq (Maybe SEltLabel)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Maybe SEltLabel) -> [Maybe SEltLabel]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Maybe SEltLabel) -> Bool) -> Seq (Maybe SEltLabel) -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Maybe SEltLabel) -> Seq Int -> Seq (Maybe SEltLabel)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (REltIdMap SEltLabel -> Int -> Maybe SEltLabel
forall a. IntMap a -> Int -> Maybe a
(IM.!?) REltIdMap SEltLabel
_pFState_directory) Seq Int
_pFState_layers
  validScope :: Bool
validScope = (Int -> Maybe Bool) -> Seq Int -> [Int] -> Bool
forall a. (a -> Maybe Bool) -> Seq a -> [Int] -> Bool
selectionHasScopingProperty Int -> Maybe Bool
scopeFn Seq Int
_pFState_layers [Int]
lps
  sorted :: Bool
sorted = [Int] -> Bool
forall a. Ord a => [a] -> Bool
isSorted [Int]
lps
  scopeFn :: Int -> Maybe Bool
scopeFn Int
x = case Int -> REltIdMap SEltLabel -> Maybe SEltLabel
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
x REltIdMap SEltLabel
_pFState_directory of
    Maybe SEltLabel
Nothing                            -> Maybe Bool
forall a. Maybe a
Nothing -- this will fail in vaildElts case so it doesn't matter what we do here
    Just (SEltLabel Text
_ SElt
SEltFolderStart) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    Just (SEltLabel Text
_ SElt
SEltFolderEnd)   -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    Maybe SEltLabel
_                                  -> Maybe Bool
forall a. Maybe a
Nothing

-- TODO SOMETHING BROKEN HERE
-- lps must be valid
pFState_copyElts :: PFState -> [LayerPos] -> [SEltLabel]
pFState_copyElts :: PFState -> [Int] -> [SEltLabel]
pFState_copyElts PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} [Int]
lps = [SEltLabel]
r where
  ridfn :: Int -> Int
ridfn Int
lp = Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
Seq.index Seq Int
_pFState_layers Int
lp
  seltlfn :: Int -> SEltLabel
seltlfn Int
rid = Maybe SEltLabel -> SEltLabel
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust (Maybe SEltLabel -> SEltLabel) -> Maybe SEltLabel -> SEltLabel
forall a b. (a -> b) -> a -> b
$ Int -> REltIdMap SEltLabel -> Maybe SEltLabel
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid REltIdMap SEltLabel
_pFState_directory
  r :: [SEltLabel]
r = (Int -> SEltLabel) -> [Int] -> [SEltLabel]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> SEltLabel
seltlfn (Int -> SEltLabel) -> (Int -> Int) -> Int -> SEltLabel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
ridfn) [Int]
lps

pFState_getSuperSEltByPos :: PFState -> LayerPos -> Maybe SuperSEltLabel
pFState_getSuperSEltByPos :: PFState -> Int -> Maybe SuperSEltLabel
pFState_getSuperSEltByPos PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} Int
lp = do
  Int
rid <- Int -> Seq Int -> Maybe Int
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
lp Seq Int
_pFState_layers
  SEltLabel
seltl <- Int -> REltIdMap SEltLabel -> Maybe SEltLabel
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid REltIdMap SEltLabel
_pFState_directory
  return (Int
rid, Int
lp, SEltLabel
seltl)

pFState_getSEltLabels :: PFState -> [REltId] -> REltIdMap (Maybe SEltLabel)
pFState_getSEltLabels :: PFState -> [Int] -> REltIdMap (Maybe SEltLabel)
pFState_getSEltLabels PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} [Int]
rids = (Int -> REltIdMap (Maybe SEltLabel) -> REltIdMap (Maybe SEltLabel))
-> REltIdMap (Maybe SEltLabel)
-> [Int]
-> REltIdMap (Maybe SEltLabel)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
rid REltIdMap (Maybe SEltLabel)
acc -> Int
-> Maybe SEltLabel
-> REltIdMap (Maybe SEltLabel)
-> REltIdMap (Maybe SEltLabel)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid (Int -> REltIdMap SEltLabel -> Maybe SEltLabel
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid REltIdMap SEltLabel
_pFState_directory) REltIdMap (Maybe SEltLabel)
acc) REltIdMap (Maybe SEltLabel)
forall a. IntMap a
IM.empty [Int]
rids

pFState_maxID :: PFState -> REltId
pFState_maxID :: PFState -> Int
pFState_maxID PFState
s = Int -> ((Int, SEltLabel) -> Int) -> Maybe (Int, SEltLabel) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, SEltLabel) -> Int
forall a b. (a, b) -> a
fst (REltIdMap SEltLabel -> Maybe (Int, SEltLabel)
forall a. IntMap a -> Maybe (Int, a)
IM.lookupMax (PFState -> REltIdMap SEltLabel
_pFState_directory PFState
s))

pFState_getLayerPosMap :: PFState -> LayerPosMap
pFState_getLayerPosMap :: PFState -> LayerPosMap
pFState_getLayerPosMap PFState
pfs = (Int -> Int -> LayerPosMap -> LayerPosMap)
-> LayerPosMap -> Seq Int -> LayerPosMap
forall a b. (Int -> a -> b -> b) -> b -> Seq a -> b
Seq.foldrWithIndex (\Int
lp Int
rid LayerPosMap
acc -> Int -> Int -> LayerPosMap -> LayerPosMap
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid Int
lp LayerPosMap
acc) LayerPosMap
forall a. IntMap a
IM.empty (PFState -> Seq Int
_pFState_layers PFState
pfs)

emptyPFState :: PFState
emptyPFState :: PFState
emptyPFState = Seq Int -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState Seq Int
forall a. Seq a
Seq.empty REltIdMap SEltLabel
forall a. IntMap a
IM.empty (LBox -> SCanvas
SCanvas (XY -> XY -> LBox
LBox XY
0 XY
0))

sPotatoFlow_to_pFState :: SPotatoFlow -> PFState
sPotatoFlow_to_pFState :: SPotatoFlow -> PFState
sPotatoFlow_to_pFState SPotatoFlow {SEltTree
SCanvas
_sPotatoFlow_sCanvas :: SCanvas
_sPotatoFlow_sEltTree :: SEltTree
_sPotatoFlow_sCanvas :: SPotatoFlow -> SCanvas
_sPotatoFlow_sEltTree :: SPotatoFlow -> SEltTree
..} = PFState
r where
  elts :: SEltTree
elts = SEltTree
_sPotatoFlow_sEltTree
  dir :: REltIdMap SEltLabel
dir = ((Int, SEltLabel) -> REltIdMap SEltLabel -> REltIdMap SEltLabel)
-> REltIdMap SEltLabel -> SEltTree -> REltIdMap SEltLabel
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
rid, SEltLabel
e) REltIdMap SEltLabel
acc -> Int -> SEltLabel -> REltIdMap SEltLabel -> REltIdMap SEltLabel
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid SEltLabel
e REltIdMap SEltLabel
acc) REltIdMap SEltLabel
forall a. IntMap a
IM.empty SEltTree
elts
  layers :: Seq Int
layers = [Int] -> Seq Int
forall a. [a] -> Seq a
Seq.fromList (((Int, SEltLabel) -> Int) -> SEltTree -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SEltLabel) -> Int
forall a b. (a, b) -> a
fst SEltTree
elts)
  r :: PFState
r = Seq Int -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState Seq Int
layers REltIdMap SEltLabel
dir SCanvas
_sPotatoFlow_sCanvas

pFState_to_sPotatoFlow :: PFState -> SPotatoFlow
pFState_to_sPotatoFlow :: PFState -> SPotatoFlow
pFState_to_sPotatoFlow PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} = SPotatoFlow
r where
  selttree :: SEltTree
selttree = Seq (Int, SEltLabel) -> SEltTree
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Int, SEltLabel) -> SEltTree)
-> (Seq Int -> Seq (Int, SEltLabel)) -> Seq Int -> SEltTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Int, SEltLabel)) -> Seq Int -> Seq (Int, SEltLabel)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
rid -> (Int
rid, REltIdMap SEltLabel
_pFState_directory REltIdMap SEltLabel -> Int -> SEltLabel
forall a. IntMap a -> Int -> a
IM.! Int
rid)) (Seq Int -> SEltTree) -> Seq Int -> SEltTree
forall a b. (a -> b) -> a -> b
$ Seq Int
_pFState_layers
  r :: SPotatoFlow
r = SCanvas -> SEltTree -> SPotatoFlow
SPotatoFlow SCanvas
_pFState_canvas SEltTree
selttree

pFState_toCanvasCoordinates :: PFState -> XY -> XY
pFState_toCanvasCoordinates :: PFState -> XY -> XY
pFState_toCanvasCoordinates PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} (V2 Int
x Int
y) = Int -> Int -> XY
forall a. a -> a -> V2 a
V2 (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sx) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
sy) where
  LBox (V2 Int
sx Int
sy) XY
_ = SCanvas -> LBox
_sCanvas_box SCanvas
_pFState_canvas

-- expects LayerPos to be valid in PFState
pfState_layerPos_to_superSEltLabel :: PFState -> LayerPos -> SuperSEltLabel
pfState_layerPos_to_superSEltLabel :: PFState -> Int -> SuperSEltLabel
pfState_layerPos_to_superSEltLabel PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} Int
lp = (Int
rid, Int
lp, SEltLabel
seltl) where
  rid :: Int
rid = Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
Seq.index Seq Int
_pFState_layers Int
lp
  seltl :: SEltLabel
seltl = REltIdMap SEltLabel -> Int -> SEltLabel
forall a. IntMap a -> Int -> a
(IM.!) REltIdMap SEltLabel
_pFState_directory Int
rid

-- i.e. select all
pFState_to_superSEltLabelSeq :: PFState -> Seq SuperSEltLabel
pFState_to_superSEltLabelSeq :: PFState -> Seq SuperSEltLabel
pFState_to_superSEltLabelSeq PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} = (Int -> Int -> SuperSEltLabel) -> Seq Int -> Seq SuperSEltLabel
forall a b. (Int -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex (\Int
lp Int
rid -> (Int
rid, Int
lp, Maybe SEltLabel -> SEltLabel
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust (Maybe SEltLabel -> SEltLabel) -> Maybe SEltLabel -> SEltLabel
forall a b. (a -> b) -> a -> b
$ Int -> REltIdMap SEltLabel -> Maybe SEltLabel
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
rid REltIdMap SEltLabel
_pFState_directory)) (Seq Int -> Seq SuperSEltLabel) -> Seq Int -> Seq SuperSEltLabel
forall a b. (a -> b) -> a -> b
$ Seq Int
_pFState_layers

-- CHANGE [SuperOwl] -> PFState -> (PFState, SEltLabelChanges)
do_newElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
do_newElts :: [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
do_newElts [SuperSEltLabel]
seltls PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} = (PFState
r, (SEltLabel -> Maybe SEltLabel)
-> REltIdMap SEltLabel -> REltIdMap (Maybe SEltLabel)
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SEltLabel -> Maybe SEltLabel
forall a. a -> Maybe a
Just REltIdMap SEltLabel
changes) where
  poss :: [(Int, Int)]
poss = (SuperSEltLabel -> (Int, Int)) -> [SuperSEltLabel] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
y,SEltLabel
_) -> (Int
y,Int
x)) [SuperSEltLabel]
seltls
  els :: SEltTree
els = (SuperSEltLabel -> (Int, SEltLabel))
-> [SuperSEltLabel] -> SEltTree
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
_,SEltLabel
z) -> (Int
x,SEltLabel
z)) [SuperSEltLabel]
seltls
  changes :: REltIdMap SEltLabel
changes = SEltTree -> REltIdMap SEltLabel
forall a. [(Int, a)] -> IntMap a
IM.fromList SEltTree
els
  newLayers :: Seq Int
newLayers = [(Int, Int)] -> Seq Int -> Seq Int
forall a. [(Int, a)] -> Seq a -> Seq a
insertEltList_indexAfterInsertion [(Int, Int)]
poss Seq Int
_pFState_layers
  newDir :: REltIdMap SEltLabel
newDir = REltIdMap SEltLabel
changes REltIdMap SEltLabel -> REltIdMap SEltLabel -> REltIdMap SEltLabel
forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` REltIdMap SEltLabel
_pFState_directory
  r :: PFState
r = Seq Int -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState Seq Int
newLayers REltIdMap SEltLabel
newDir SCanvas
_pFState_canvas

-- CHANGE [SuperOwl] -> PFState -> (PFState, SEltLabelChanges)
undo_newElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
undo_newElts :: [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
undo_newElts [SuperSEltLabel]
seltls PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} = (PFState
r, REltIdMap (Maybe SEltLabel)
changes) where
  poss :: [Int]
poss = (SuperSEltLabel -> Int) -> [SuperSEltLabel] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_,Int
y,SEltLabel
_) -> Int
y) [SuperSEltLabel]
seltls
  els :: SEltTree
els = (SuperSEltLabel -> (Int, SEltLabel))
-> [SuperSEltLabel] -> SEltTree
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,Int
_,SEltLabel
z) -> (Int
x,SEltLabel
z)) [SuperSEltLabel]
seltls
  newLayers :: Seq Int
newLayers = [Int] -> Seq Int -> Seq Int
forall a. [Int] -> Seq a -> Seq a
removeEltList [Int]
poss Seq Int
_pFState_layers
  newDir :: REltIdMap SEltLabel
newDir = REltIdMap SEltLabel
_pFState_directory REltIdMap SEltLabel -> REltIdMap SEltLabel -> REltIdMap SEltLabel
forall a b. IntMap a -> IntMap b -> IntMap a
`IM.difference` SEltTree -> REltIdMap SEltLabel
forall a. [(Int, a)] -> IntMap a
IM.fromList SEltTree
els
  r :: PFState
r = Seq Int -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState Seq Int
newLayers REltIdMap SEltLabel
newDir SCanvas
_pFState_canvas
  changes :: REltIdMap (Maybe SEltLabel)
changes = [(Int, Maybe SEltLabel)] -> REltIdMap (Maybe SEltLabel)
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Maybe SEltLabel)] -> REltIdMap (Maybe SEltLabel))
-> [(Int, Maybe SEltLabel)] -> REltIdMap (Maybe SEltLabel)
forall a b. (a -> b) -> a -> b
$ ((Int, SEltLabel) -> (Int, Maybe SEltLabel))
-> SEltTree -> [(Int, Maybe SEltLabel)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x,SEltLabel
_)->(Int
x,Maybe SEltLabel
forall a. Maybe a
Nothing)) SEltTree
els

-- CHANGE [SuperOwl] -> PFState -> (PFState, SEltLabelChanges)
do_deleteElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
do_deleteElts :: [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
do_deleteElts = [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
undo_newElts

-- CHANGE [SuperOwl] -> PFState -> (PFState, SEltLabelChanges)
undo_deleteElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
undo_deleteElts :: [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
undo_deleteElts = [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
do_newElts

--
-- CHANGE
-- | (list of parents (assert no repeats), target (placed after or as first child if top owl (no parent)))
--do_move :: ([REltId], Maybe REltId) -> PFState  -> (PFState, SEltLabelChanges)
-- TODO assert selection has all children
do_move :: ([LayerPos], LayerPos) -> PFState -> (PFState, SEltLabelChanges)
do_move :: ([Int], Int) -> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
do_move ([Int]
lps, Int
dst) pfs :: PFState
pfs@PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} = Bool
-> (PFState, REltIdMap (Maybe SEltLabel))
-> (PFState, REltIdMap (Maybe SEltLabel))
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PFState -> [Int] -> Bool
pFState_selectionIsValid PFState
pfs [Int]
lps) (PFState
r, REltIdMap (Maybe SEltLabel)
changes) where
  -- TODO something like this
  --lps' = addChildren lps pfs
  r :: PFState
r = Seq Int -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState ([Int] -> Int -> Seq Int -> Seq Int
forall a. [Int] -> Int -> Seq a -> Seq a
moveEltList [Int]
lps Int
dst Seq Int
_pFState_layers) REltIdMap SEltLabel
_pFState_directory SCanvas
_pFState_canvas
  changes :: REltIdMap (Maybe SEltLabel)
changes = PFState -> [Int] -> REltIdMap (Maybe SEltLabel)
pFState_getSEltLabels PFState
pfs ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
Seq.index Seq Int
_pFState_layers) [Int]
lps)
{--
  rids = foldr (\l acc -> Seq.index _pFState_layers l : acc) [] lps
  newLayers' = assert (isSorted lps) $ foldr (\l acc -> Seq.deleteAt l acc) _pFState_layers lps
  moveToIndex = dst - (length (takeWhile (\x -> x < dst) lps))
  (leftL, rightL) = Seq.splitAt moveToIndex newLayers'
  newLayers = leftL >< fromList rids >< rightL
  r = PFState newLayers _pFState_directory _pFState_canvas
--}

undo_move :: ([LayerPos], LayerPos) -> PFState -> (PFState, SEltLabelChanges)
undo_move :: ([Int], Int) -> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
undo_move ([Int]
lps, Int
dst) pfs :: PFState
pfs@PFState {Seq Int
REltIdMap SEltLabel
SCanvas
_pFState_layers :: PFState -> Seq Int
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_canvas :: PFState -> SCanvas
_pFState_layers :: Seq Int
_pFState_directory :: REltIdMap SEltLabel
_pFState_canvas :: SCanvas
..} =  (PFState
r, REltIdMap (Maybe SEltLabel)
changes) where
  -- TODO something like this
  --lps' = addChildren lps pfs
  r :: PFState
r = Seq Int -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState ([Int] -> Int -> Seq Int -> Seq Int
forall a. [Int] -> Int -> Seq a -> Seq a
undoMoveEltList [Int]
lps Int
dst Seq Int
_pFState_layers) REltIdMap SEltLabel
_pFState_directory SCanvas
_pFState_canvas
  changes :: REltIdMap (Maybe SEltLabel)
changes = PFState -> [Int] -> REltIdMap (Maybe SEltLabel)
pFState_getSEltLabels PFState
pfs ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq Int -> Int -> Int
forall a. Seq a -> Int -> a
Seq.index Seq Int
_pFState_layers) [Int]
lps)
{--
  --assert (isSorted lps)
  nMoved = length lps
  moveToIndex = dst - (length (takeWhile (\x -> x < dst) lps))
  (leftL,rightL') = Seq.splitAt moveToIndex _pFState_layers
  (toMove,rightL) = Seq.splitAt nMoved rightL'
  newLayers' = leftL >< rightL
  newLayers = insertEltList (zip lps (toList toMove)) newLayers'
  r = PFState newLayers _pFState_directory _pFState_canvas
--}

-- | check if the SCanvas is valid or not
-- for now, canvas offset must always be 0, I forget why it's even an option to offset the SCanvas, probably potatoes.
isValidCanvas :: SCanvas -> Bool
isValidCanvas :: SCanvas -> Bool
isValidCanvas (SCanvas (LBox XY
p (V2 Int
w Int
h))) = XY
p XY -> XY -> Bool
forall a. Eq a => a -> a -> Bool
== XY
0 Bool -> Bool -> Bool
&& Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

do_resizeCanvas :: DeltaLBox -> PFState -> PFState
do_resizeCanvas :: DeltaLBox -> PFState -> PFState
do_resizeCanvas DeltaLBox
d PFState
pfs = Bool -> PFState -> PFState
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (SCanvas -> Bool
isValidCanvas SCanvas
newCanvas) (PFState -> PFState) -> PFState -> PFState
forall a b. (a -> b) -> a -> b
$ PFState
pfs { _pFState_canvas = newCanvas } where
  newCanvas :: SCanvas
newCanvas = LBox -> SCanvas
SCanvas (LBox -> SCanvas) -> LBox -> SCanvas
forall a b. (a -> b) -> a -> b
$ LBox -> DeltaLBox -> LBox
forall x dx. Delta x dx => x -> dx -> x
plusDelta (SCanvas -> LBox
_sCanvas_box (PFState -> SCanvas
_pFState_canvas PFState
pfs)) DeltaLBox
d

undo_resizeCanvas :: DeltaLBox -> PFState -> PFState
undo_resizeCanvas :: DeltaLBox -> PFState -> PFState
undo_resizeCanvas DeltaLBox
d PFState
pfs = Bool -> PFState -> PFState
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (SCanvas -> Bool
isValidCanvas SCanvas
newCanvas) (PFState -> PFState) -> PFState -> PFState
forall a b. (a -> b) -> a -> b
$ PFState
pfs { _pFState_canvas = newCanvas } where
  newCanvas :: SCanvas
newCanvas = LBox -> SCanvas
SCanvas (LBox -> SCanvas) -> LBox -> SCanvas
forall a b. (a -> b) -> a -> b
$ LBox -> DeltaLBox -> LBox
forall x dx. Delta x dx => x -> dx -> x
minusDelta (SCanvas -> LBox
_sCanvas_box (PFState -> SCanvas
_pFState_canvas PFState
pfs)) DeltaLBox
d

manipulate :: Bool -> ControllersWithId -> PFState -> (PFState, SEltLabelChanges)
manipulate :: Bool
-> ControllersWithId
-> PFState
-> (PFState, REltIdMap (Maybe SEltLabel))
manipulate Bool
isDo ControllersWithId
cs PFState
pfs = (PFState
r, (SEltLabel -> Maybe SEltLabel)
-> REltIdMap SEltLabel -> REltIdMap (Maybe SEltLabel)
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SEltLabel -> Maybe SEltLabel
forall a. a -> Maybe a
Just REltIdMap SEltLabel
changes) where
  dir :: REltIdMap SEltLabel
dir = PFState -> REltIdMap SEltLabel
_pFState_directory PFState
pfs
  changes :: REltIdMap SEltLabel
changes = (Controller -> SEltLabel -> SEltLabel)
-> ControllersWithId -> REltIdMap SEltLabel -> REltIdMap SEltLabel
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (Bool -> Controller -> SEltLabel -> SEltLabel
updateFnFromController Bool
isDo) ControllersWithId
cs REltIdMap SEltLabel
dir
  newDir :: REltIdMap SEltLabel
newDir = REltIdMap SEltLabel -> REltIdMap SEltLabel -> REltIdMap SEltLabel
forall a. IntMap a -> IntMap a -> IntMap a
IM.union REltIdMap SEltLabel
changes REltIdMap SEltLabel
dir
  r :: PFState
r = PFState
pfs { _pFState_directory = newDir }

do_manipulate :: ControllersWithId -> PFState -> (PFState, SEltLabelChanges)
do_manipulate :: ControllersWithId
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
do_manipulate = Bool
-> ControllersWithId
-> PFState
-> (PFState, REltIdMap (Maybe SEltLabel))
manipulate Bool
True

undo_manipulate :: ControllersWithId -> PFState -> (PFState, SEltLabelChanges)
undo_manipulate :: ControllersWithId
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
undo_manipulate = Bool
-> ControllersWithId
-> PFState
-> (PFState, REltIdMap (Maybe SEltLabel))
manipulate Bool
False