{-# 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
, 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 {
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])
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
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
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
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
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
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
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
do_deleteElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
do_deleteElts :: [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
do_deleteElts = [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
undo_newElts
undo_deleteElts :: [SuperSEltLabel] -> PFState -> (PFState, SEltLabelChanges)
undo_deleteElts :: [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
undo_deleteElts = [SuperSEltLabel]
-> PFState -> (PFState, REltIdMap (Maybe SEltLabel))
do_newElts
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
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)
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
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)
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