-- 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.SEltMethods
import           Potato.Flow.SElts
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 REltId
_pFState_layers      :: Seq REltId
  , PFState -> REltIdMap SEltLabel
_pFState_directory :: REltIdMap SEltLabel
  , PFState -> SCanvas
_pFState_canvas    :: SCanvas
} deriving (PFState -> PFState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFState -> PFState -> Bool
$c/= :: PFState -> PFState -> Bool
== :: PFState -> PFState -> Bool
$c== :: PFState -> PFState -> Bool
Eq, REltId -> PFState -> ShowS
[PFState] -> ShowS
PFState -> String
forall a.
(REltId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFState] -> ShowS
$cshowList :: [PFState] -> ShowS
show :: PFState -> String
$cshow :: PFState -> String
showsPrec :: REltId -> PFState -> ShowS
$cshowsPrec :: REltId -> PFState -> ShowS
Show, 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
$cto :: forall x. Rep PFState x -> PFState
$cfrom :: forall x. PFState -> Rep PFState x
Generic)

instance FromJSON PFState
instance ToJSON PFState
instance NFData PFState

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

pFState_isValid :: PFState -> Bool
pFState_isValid :: PFState -> Bool
pFState_isValid pfs :: PFState
pfs@PFState {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} = PFState -> [REltId] -> Bool
pFState_selectionIsValid PFState
pfs ([REltId
0..forall a. Seq a -> REltId
Seq.length Seq REltId
_pFState_layers forall a. Num a => a -> a -> a
- REltId
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 -> [REltId] -> Bool
pFState_selectionIsValid PFState {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} [REltId]
lps = Bool
validElts Bool -> Bool -> Bool
&& Bool
validScope Bool -> Bool -> Bool
&& Bool
sorted where
  validElts :: Bool
validElts = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a. IntMap a -> REltId -> Maybe a
(IM.!?) REltIdMap SEltLabel
_pFState_directory) Seq REltId
_pFState_layers
  validScope :: Bool
validScope = forall a. (a -> Maybe Bool) -> Seq a -> [REltId] -> Bool
selectionHasScopingProperty REltId -> Maybe Bool
scopeFn Seq REltId
_pFState_layers [REltId]
lps
  sorted :: Bool
sorted = forall a. Ord a => [a] -> Bool
isSorted [REltId]
lps
  scopeFn :: REltId -> Maybe Bool
scopeFn REltId
x = case forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
x REltIdMap SEltLabel
_pFState_directory of
    Maybe SEltLabel
Nothing                            -> 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) -> forall a. a -> Maybe a
Just Bool
True
    Just (SEltLabel Text
_ SElt
SEltFolderEnd)   -> forall a. a -> Maybe a
Just Bool
False
    Maybe SEltLabel
_                                  -> forall a. Maybe a
Nothing

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

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

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

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

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

emptyPFState :: PFState
emptyPFState :: PFState
emptyPFState = Seq REltId -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState forall a. Seq a
Seq.empty 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_sEltTree :: SPotatoFlow -> SEltTree
_sPotatoFlow_sCanvas :: SPotatoFlow -> SCanvas
_sPotatoFlow_sEltTree :: SEltTree
_sPotatoFlow_sCanvas :: SCanvas
..} = PFState
r where
  elts :: SEltTree
elts = SEltTree
_sPotatoFlow_sEltTree
  dir :: REltIdMap SEltLabel
dir = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(REltId
rid, SEltLabel
e) REltIdMap SEltLabel
acc -> forall a. REltId -> a -> IntMap a -> IntMap a
IM.insert REltId
rid SEltLabel
e REltIdMap SEltLabel
acc) forall a. IntMap a
IM.empty SEltTree
elts
  layers :: Seq REltId
layers = forall a. [a] -> Seq a
Seq.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst SEltTree
elts)
  r :: PFState
r = Seq REltId -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState Seq REltId
layers REltIdMap SEltLabel
dir SCanvas
_sPotatoFlow_sCanvas

pFState_to_sPotatoFlow :: PFState -> SPotatoFlow
pFState_to_sPotatoFlow :: PFState -> SPotatoFlow
pFState_to_sPotatoFlow PFState {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} = SPotatoFlow
r where
  selttree :: SEltTree
selttree = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\REltId
rid -> (REltId
rid, REltIdMap SEltLabel
_pFState_directory forall a. IntMap a -> REltId -> a
IM.! REltId
rid)) forall a b. (a -> b) -> a -> b
$ Seq REltId
_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 {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} (V2 REltId
x REltId
y) = forall a. a -> a -> V2 a
V2 (REltId
xforall a. Num a => a -> a -> a
-REltId
sx) (REltId
yforall a. Num a => a -> a -> a
-REltId
sy) where
  LBox (V2 REltId
sx REltId
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 -> REltId -> SuperSEltLabel
pfState_layerPos_to_superSEltLabel PFState {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} REltId
lp = (REltId
rid, REltId
lp, SEltLabel
seltl) where
  rid :: REltId
rid = forall a. Seq a -> REltId -> a
Seq.index Seq REltId
_pFState_layers REltId
lp
  seltl :: SEltLabel
seltl = forall a. IntMap a -> REltId -> a
(IM.!) REltIdMap SEltLabel
_pFState_directory REltId
rid

-- i.e. select all
pFState_to_superSEltLabelSeq :: PFState -> Seq SuperSEltLabel
pFState_to_superSEltLabelSeq :: PFState -> Seq SuperSEltLabel
pFState_to_superSEltLabelSeq PFState {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} = forall a b. (REltId -> a -> b) -> Seq a -> Seq b
Seq.mapWithIndex (\REltId
lp REltId
rid -> (REltId
rid, REltId
lp, forall a. (?callStack::CallStack) => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. REltId -> IntMap a -> Maybe a
IM.lookup REltId
rid REltIdMap SEltLabel
_pFState_directory)) forall a b. (a -> b) -> a -> b
$ Seq REltId
_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 {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} = (PFState
r, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just REltIdMap SEltLabel
changes) where
  poss :: [(REltId, REltId)]
poss = forall a b. (a -> b) -> [a] -> [b]
map (\(REltId
x,REltId
y,SEltLabel
_) -> (REltId
y,REltId
x)) [SuperSEltLabel]
seltls
  els :: SEltTree
els = forall a b. (a -> b) -> [a] -> [b]
map (\(REltId
x,REltId
_,SEltLabel
z) -> (REltId
x,SEltLabel
z)) [SuperSEltLabel]
seltls
  changes :: REltIdMap SEltLabel
changes = forall a. [(REltId, a)] -> IntMap a
IM.fromList SEltTree
els
  newLayers :: Seq REltId
newLayers = forall a. [(REltId, a)] -> Seq a -> Seq a
insertEltList_indexAfterInsertion [(REltId, REltId)]
poss Seq REltId
_pFState_layers
  newDir :: REltIdMap SEltLabel
newDir = REltIdMap SEltLabel
changes forall a. IntMap a -> IntMap a -> IntMap a
`IM.union` REltIdMap SEltLabel
_pFState_directory
  r :: PFState
r = Seq REltId -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState Seq REltId
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 {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} = (PFState
r, REltIdMap (Maybe SEltLabel)
changes) where
  poss :: [REltId]
poss = forall a b. (a -> b) -> [a] -> [b]
map (\(REltId
_,REltId
y,SEltLabel
_) -> REltId
y) [SuperSEltLabel]
seltls
  els :: SEltTree
els = forall a b. (a -> b) -> [a] -> [b]
map (\(REltId
x,REltId
_,SEltLabel
z) -> (REltId
x,SEltLabel
z)) [SuperSEltLabel]
seltls
  newLayers :: Seq REltId
newLayers = forall a. [REltId] -> Seq a -> Seq a
removeEltList [REltId]
poss Seq REltId
_pFState_layers
  newDir :: REltIdMap SEltLabel
newDir = REltIdMap SEltLabel
_pFState_directory forall a b. IntMap a -> IntMap b -> IntMap a
`IM.difference` forall a. [(REltId, a)] -> IntMap a
IM.fromList SEltTree
els
  r :: PFState
r = Seq REltId -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState Seq REltId
newLayers REltIdMap SEltLabel
newDir SCanvas
_pFState_canvas
  changes :: REltIdMap (Maybe SEltLabel)
changes = forall a. [(REltId, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(REltId
x,SEltLabel
y)->(REltId
x,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 :: ([REltId], REltId)
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
do_move ([REltId]
lps, REltId
dst) pfs :: PFState
pfs@PFState {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (PFState -> [REltId] -> Bool
pFState_selectionIsValid PFState
pfs [REltId]
lps) (PFState
r, REltIdMap (Maybe SEltLabel)
changes) where
  -- TODO something like this
  --lps' = addChildren lps pfs
  r :: PFState
r = Seq REltId -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState (forall a. [REltId] -> REltId -> Seq a -> Seq a
moveEltList [REltId]
lps REltId
dst Seq REltId
_pFState_layers) REltIdMap SEltLabel
_pFState_directory SCanvas
_pFState_canvas
  changes :: REltIdMap (Maybe SEltLabel)
changes = PFState -> [REltId] -> REltIdMap (Maybe SEltLabel)
pFState_getSEltLabels PFState
pfs (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Seq a -> REltId -> a
Seq.index Seq REltId
_pFState_layers) [REltId]
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 :: ([REltId], REltId)
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
undo_move ([REltId]
lps, REltId
dst) pfs :: PFState
pfs@PFState {REltIdMap SEltLabel
Seq REltId
SCanvas
_pFState_canvas :: SCanvas
_pFState_directory :: REltIdMap SEltLabel
_pFState_layers :: Seq REltId
_pFState_canvas :: PFState -> SCanvas
_pFState_directory :: PFState -> REltIdMap SEltLabel
_pFState_layers :: PFState -> Seq REltId
..} =  (PFState
r, REltIdMap (Maybe SEltLabel)
changes) where
  -- TODO something like this
  --lps' = addChildren lps pfs
  r :: PFState
r = Seq REltId -> REltIdMap SEltLabel -> SCanvas -> PFState
PFState (forall a. [REltId] -> REltId -> Seq a -> Seq a
undoMoveEltList [REltId]
lps REltId
dst Seq REltId
_pFState_layers) REltIdMap SEltLabel
_pFState_directory SCanvas
_pFState_canvas
  changes :: REltIdMap (Maybe SEltLabel)
changes = PFState -> [REltId] -> REltIdMap (Maybe SEltLabel)
pFState_getSEltLabels PFState
pfs (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Seq a -> REltId -> a
Seq.index Seq REltId
_pFState_layers) [REltId]
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 REltId
w REltId
h))) = XY
p forall a. Eq a => a -> a -> Bool
== XY
0 Bool -> Bool -> Bool
&& REltId
w forall a. Ord a => a -> a -> Bool
> REltId
0 Bool -> Bool -> Bool
&& REltId
h forall a. Ord a => a -> a -> Bool
> REltId
0

do_resizeCanvas :: DeltaLBox -> PFState -> PFState
do_resizeCanvas :: DeltaLBox -> PFState -> PFState
do_resizeCanvas DeltaLBox
d PFState
pfs = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (SCanvas -> Bool
isValidCanvas SCanvas
newCanvas) forall a b. (a -> b) -> a -> b
$ PFState
pfs { _pFState_canvas :: SCanvas
_pFState_canvas = SCanvas
newCanvas } where
  newCanvas :: SCanvas
newCanvas = LBox -> SCanvas
SCanvas forall a b. (a -> b) -> a -> b
$ 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 = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (SCanvas -> Bool
isValidCanvas SCanvas
newCanvas) forall a b. (a -> b) -> a -> b
$ PFState
pfs { _pFState_canvas :: SCanvas
_pFState_canvas = SCanvas
newCanvas } where
  newCanvas :: SCanvas
newCanvas = LBox -> SCanvas
SCanvas forall a b. (a -> b) -> a -> b
$ 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, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 = 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 = forall a. IntMap a -> IntMap a -> IntMap a
IM.union REltIdMap SEltLabel
changes REltIdMap SEltLabel
dir
  r :: PFState
r = PFState
pfs { _pFState_directory :: REltIdMap SEltLabel
_pFState_directory = REltIdMap SEltLabel
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