{-# LANGUAGE RecordWildCards #-}
module Potato.Flow.OwlState where
import Relude
import Potato.Flow.Owl
import Potato.Flow.Attachments
import Potato.Flow.OwlItem
import Potato.Flow.Math
import Potato.Flow.SElts
import Potato.Flow.SEltMethods
import Potato.Flow.Types
import Potato.Flow.DebugHelpers
import Control.Exception (assert)
import qualified Data.IntMap.Strict as IM
import Data.List.Ordered (isSortedBy)
import Data.Maybe
import qualified Data.Text as T
maybeGetAttachmentPosition :: (HasCallStack) => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition :: HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetBorder OwlPFState
pfs Attachment
a = do
SuperOwl
target <- forall o. HasOwlTree o => o -> Int -> Maybe SuperOwl
hasOwlTree_findSuperOwl OwlPFState
pfs (Attachment -> Int
_attachment_target Attachment
a)
return $ case forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem SuperOwl
target of
OwlItem OwlInfo
_ (OwlSubItemBox SBox
sbox) -> Bool -> BoxWithAttachmentLocation -> XY
attachLocationFromLBox Bool
offsetBorder (SBox -> LBox
_sBox_box SBox
sbox, Attachment -> AttachmentLocation
_attachment_location Attachment
a, Attachment -> AttachmentOffsetRatio
_attachment_offset_rel Attachment
a)
OwlItem
x -> forall a t. (HasCallStack, IsText t) => t -> a
error (Text
"expecteed OwlSubItemBox, got: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show OwlItem
x)
maybeGetAttachmentBox :: Bool -> OwlPFState -> Attachment -> Maybe LBox
maybeGetAttachmentBox :: Bool -> OwlPFState -> Attachment -> Maybe LBox
maybeGetAttachmentBox Bool
offsetBorder OwlPFState
pfs Attachment
a = do
SuperOwl
target <- forall o. HasOwlTree o => o -> Int -> Maybe SuperOwl
hasOwlTree_findSuperOwl OwlPFState
pfs (Attachment -> Int
_attachment_target Attachment
a)
return $ case forall o. HasOwlItem o => o -> OwlItem
hasOwlItem_owlItem SuperOwl
target of
OwlItem OwlInfo
_ (OwlSubItemBox SBox
sbox) -> if Bool
offsetBorder then LBox -> (Int, Int, Int, Int) -> LBox
lBox_expand (SBox -> LBox
_sBox_box SBox
sbox) (Int
1,Int
1,Int
1,Int
1) else SBox -> LBox
_sBox_box SBox
sbox
OwlItem
x -> forall a t. (HasCallStack, IsText t) => t -> a
error (Text
"expecteed OwlSubItemBox, got: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show OwlItem
x)
maybeLookupAttachment :: (HasCallStack) => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment :: HasCallStack => Bool -> OwlPFState -> Maybe Attachment -> Maybe XY
maybeLookupAttachment Bool
offsetBorder OwlPFState
pfs Maybe Attachment
matt = HasCallStack => Bool -> OwlPFState -> Attachment -> Maybe XY
maybeGetAttachmentPosition Bool
offsetBorder OwlPFState
pfs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Attachment
matt
data OwlPFState = OwlPFState {
OwlPFState -> OwlTree
_owlPFState_owlTree :: OwlTree
, OwlPFState -> SCanvas
_owlPFState_canvas :: SCanvas
} deriving (Int -> OwlPFState -> ShowS
[OwlPFState] -> ShowS
OwlPFState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OwlPFState] -> ShowS
$cshowList :: [OwlPFState] -> ShowS
show :: OwlPFState -> String
$cshow :: OwlPFState -> String
showsPrec :: Int -> OwlPFState -> ShowS
$cshowsPrec :: Int -> OwlPFState -> ShowS
Show, OwlPFState -> OwlPFState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OwlPFState -> OwlPFState -> Bool
$c/= :: OwlPFState -> OwlPFState -> Bool
== :: OwlPFState -> OwlPFState -> Bool
$c== :: OwlPFState -> OwlPFState -> Bool
Eq, forall x. Rep OwlPFState x -> OwlPFState
forall x. OwlPFState -> Rep OwlPFState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OwlPFState x -> OwlPFState
$cfrom :: forall x. OwlPFState -> Rep OwlPFState x
Generic)
instance HasOwlTree OwlPFState where
hasOwlTree_owlTree :: OwlPFState -> OwlTree
hasOwlTree_owlTree = OwlPFState -> OwlTree
_owlPFState_owlTree
owlPFState_prettyPrintForDebugging :: OwlPFState -> Text
owlPFState_prettyPrintForDebugging :: OwlPFState -> Text
owlPFState_prettyPrintForDebugging OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = forall a. PotatoShow a => a -> Text
potatoShow OwlTree
_owlPFState_owlTree forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show SCanvas
_owlPFState_canvas
instance PotatoShow OwlPFState where
potatoShow :: OwlPFState -> Text
potatoShow = OwlPFState -> Text
owlPFState_prettyPrintForDebugging
instance NFData OwlPFState
owlPFState_nextId :: OwlPFState -> REltId
owlPFState_nextId :: OwlPFState -> Int
owlPFState_nextId OwlPFState
pfs = (forall a. Num a => a -> a -> a
+Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> Int
owlTree_maxId forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs
owlPFState_lastId :: OwlPFState -> REltId
owlPFState_lastId :: OwlPFState -> Int
owlPFState_lastId OwlPFState
pfs = OwlTree -> Int
owlTree_maxId forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs
owlPFState_numElts :: OwlPFState -> Int
owlPFState_numElts :: OwlPFState -> Int
owlPFState_numElts OwlPFState
pfs = forall a. IntMap a -> Int
IM.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs
debugPrintOwlPFState :: (IsString a) => OwlPFState -> a
debugPrintOwlPFState :: forall a. IsString a => OwlPFState -> a
debugPrintOwlPFState OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ forall a. PotatoShow a => a -> Text
potatoShow OwlTree
_owlPFState_owlTree
owlPFState_isValid :: OwlPFState -> Bool
owlPFState_isValid :: OwlPFState -> Bool
owlPFState_isValid OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = Bool
True
owlPFState_selectionIsValid :: OwlPFState -> OwlParliament -> Bool
owlPFState_selectionIsValid :: OwlPFState -> OwlParliament -> Bool
owlPFState_selectionIsValid OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} (OwlParliament Seq Int
op) = Bool
validElts where
OwlTree {IntMap (OwlItemMeta, OwlItem)
Seq Int
_owlTree_topOwls :: OwlTree -> Seq Int
_owlTree_topOwls :: Seq Int
_owlTree_mapping :: IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping :: OwlTree -> IntMap (OwlItemMeta, OwlItem)
..} = OwlTree
_owlPFState_owlTree
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 -> Int -> Maybe a
(IM.!?) IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping) Seq Int
op
owlPFState_copyElts :: OwlPFState -> OwlParliament -> [SEltLabel]
owlPFState_copyElts :: OwlPFState -> OwlParliament -> [SEltLabel]
owlPFState_copyElts OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} OwlParliament
op = [SEltLabel]
r where
sop :: SuperOwlParliament
sop = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
_owlPFState_owlTree OwlParliament
op
r :: [SEltLabel]
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ OwlTree -> SuperOwlParliament -> SEltTree
superOwlParliament_toSEltTree OwlTree
_owlPFState_owlTree SuperOwlParliament
sop
owlPFState_getSuperOwls :: OwlPFState -> [REltId] -> REltIdMap (Maybe SuperOwl)
owlPFState_getSuperOwls :: OwlPFState -> [Int] -> REltIdMap (Maybe SuperOwl)
owlPFState_getSuperOwls OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} [Int]
rids = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
rid REltIdMap (Maybe SuperOwl)
acc -> forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
rid (OwlTree -> Int -> Maybe SuperOwl
owlTree_findSuperOwl OwlTree
_owlPFState_owlTree Int
rid) REltIdMap (Maybe SuperOwl)
acc) forall a. IntMap a
IM.empty [Int]
rids
emptyOwlPFState :: OwlPFState
emptyOwlPFState :: OwlPFState
emptyOwlPFState = OwlTree -> SCanvas -> OwlPFState
OwlPFState OwlTree
emptyOwlTree (LBox -> SCanvas
SCanvas (XY -> XY -> LBox
LBox XY
0 XY
1))
sPotatoFlow_to_owlPFState :: SPotatoFlow -> OwlPFState
sPotatoFlow_to_owlPFState :: SPotatoFlow -> OwlPFState
sPotatoFlow_to_owlPFState SPotatoFlow {SEltTree
SCanvas
_sPotatoFlow_sEltTree :: SPotatoFlow -> SEltTree
_sPotatoFlow_sCanvas :: SPotatoFlow -> SCanvas
_sPotatoFlow_sEltTree :: SEltTree
_sPotatoFlow_sCanvas :: SCanvas
..} = OwlPFState
r where
r :: OwlPFState
r = OwlTree -> SCanvas -> OwlPFState
OwlPFState (SEltTree -> OwlTree
owlTree_fromSEltTree SEltTree
_sPotatoFlow_sEltTree) SCanvas
_sPotatoFlow_sCanvas
owlPFState_to_sPotatoFlow :: OwlPFState -> SPotatoFlow
owlPFState_to_sPotatoFlow :: OwlPFState -> SPotatoFlow
owlPFState_to_sPotatoFlow OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = SPotatoFlow
r where
selttree :: SEltTree
selttree = OwlTree -> SEltTree
owlTree_toSEltTree OwlTree
_owlPFState_owlTree
r :: SPotatoFlow
r = SCanvas -> SEltTree -> SPotatoFlow
SPotatoFlow SCanvas
_owlPFState_canvas SEltTree
selttree
owlPFState_toCanvasCoordinates :: OwlPFState -> XY -> XY
owlPFState_toCanvasCoordinates :: OwlPFState -> XY -> XY
owlPFState_toCanvasCoordinates OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} (V2 Int
x Int
y) = forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
-Int
sx) (Int
yforall a. Num a => a -> a -> a
-Int
sy) where
LBox (V2 Int
sx Int
sy) XY
_ = SCanvas -> LBox
_sCanvas_box SCanvas
_owlPFState_canvas
owlPFState_fromCanvasCoordinates :: OwlPFState -> XY -> XY
owlPFState_fromCanvasCoordinates :: OwlPFState -> XY -> XY
owlPFState_fromCanvasCoordinates OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} (V2 Int
x Int
y) = forall a. a -> a -> V2 a
V2 (Int
xforall a. Num a => a -> a -> a
+Int
sx) (Int
yforall a. Num a => a -> a -> a
+Int
sy) where
LBox (V2 Int
sx Int
sy) XY
_ = SCanvas -> LBox
_sCanvas_box SCanvas
_owlPFState_canvas
owlPFState_to_SuperOwlParliament :: OwlPFState -> SuperOwlParliament
owlPFState_to_SuperOwlParliament :: OwlPFState -> SuperOwlParliament
owlPFState_to_SuperOwlParliament OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = OwlTree -> OwlParliament -> SuperOwlParliament
owlParliament_toSuperOwlParliament OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ Seq Int -> OwlParliament
OwlParliament forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq Int
_owlTree_topOwls OwlTree
_owlPFState_owlTree
do_newElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_newElts :: [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_newElts [(Int, OwlSpot, OwlItem)]
seltls pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
(OwlTree
newot, [SuperOwl]
changes') = [(Int, OwlSpot, OwlItem)] -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addOwlItemList [(Int, OwlSpot, OwlItem)]
seltls OwlTree
_owlPFState_owlTree
changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. a -> Maybe a
Just SuperOwl
sowl)) [SuperOwl]
changes'
r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)
undo_newElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_newElts :: [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_newElts [(Int, OwlSpot, OwlItem)]
seltls pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
foldfn :: (Int, b, c) -> OwlTree -> OwlTree
foldfn (Int
rid,b
_,c
_) OwlTree
od = Int -> OwlTree -> OwlTree
owlTree_removeREltId Int
rid OwlTree
od
newot :: OwlTree
newot = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b} {c}. (Int, b, c) -> OwlTree -> OwlTree
foldfn OwlTree
_owlPFState_owlTree [(Int, OwlSpot, OwlItem)]
seltls
changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
rid,OwlSpot
_,OwlItem
_) -> (Int
rid, forall a. Maybe a
Nothing)) [(Int, OwlSpot, OwlItem)]
seltls
r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)
do_deleteElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_deleteElts :: [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_deleteElts = [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_newElts
undo_deleteElts :: [(REltId, OwlSpot, OwlItem)] -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_deleteElts :: [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_deleteElts = [(Int, OwlSpot, OwlItem)]
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_newElts
do_newMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_newMiniOwlTree :: (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_newMiniOwlTree (OwlTree
mot, OwlSpot
ospot) pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
(OwlTree
newot, [SuperOwl]
changes') = OwlSpot -> OwlTree -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_addMiniOwlTree OwlSpot
ospot OwlTree
mot OwlTree
_owlPFState_owlTree
changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. a -> Maybe a
Just SuperOwl
sowl)) [SuperOwl]
changes'
r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)
undo_newMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_newMiniOwlTree :: (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_newMiniOwlTree (OwlTree
mot, OwlSpot
_) pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
foldfn :: Int -> OwlTree -> OwlTree
foldfn Int
rid OwlTree
od = Int -> OwlTree -> OwlTree
owlTree_removeREltId Int
rid OwlTree
od
newot :: OwlTree
newot = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> OwlTree -> OwlTree
foldfn OwlTree
_owlPFState_owlTree (OwlTree -> Seq Int
_owlTree_topOwls OwlTree
mot)
changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. Maybe a
Nothing)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ OwlTree -> Seq SuperOwl
owliterateall OwlTree
mot
r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)
do_deleteMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_deleteMiniOwlTree :: (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_deleteMiniOwlTree = (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_newMiniOwlTree
undo_deleteMiniOwlTree :: (MiniOwlTree, OwlSpot) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_deleteMiniOwlTree :: (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_deleteMiniOwlTree = (OwlTree, OwlSpot)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_newMiniOwlTree
isSuperOwlParliamentUndoFriendly :: SuperOwlParliament -> Bool
isSuperOwlParliamentUndoFriendly :: SuperOwlParliament -> Bool
isSuperOwlParliamentUndoFriendly SuperOwlParliament
sop = Bool
r where
rp :: SuperOwl -> Int
rp = OwlItemMeta -> Int
_owlItemMeta_position forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwl -> OwlItemMeta
_superOwl_meta
sameparent :: SuperOwl -> SuperOwl -> Bool
sameparent SuperOwl
sowl1 SuperOwl
sowl2 = OwlItemMeta -> Int
_owlItemMeta_parent ( SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl1) forall a. Eq a => a -> a -> Bool
== OwlItemMeta -> Int
_owlItemMeta_parent ( SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
sowl2)
r :: Bool
r = forall a. (a -> a -> Bool) -> [a] -> Bool
isSortedBy (\SuperOwl
sowl1 SuperOwl
sowl2 -> if SuperOwl -> SuperOwl -> Bool
sameparent SuperOwl
sowl1 SuperOwl
sowl2 then (SuperOwl -> Int
rp SuperOwl
sowl1) forall a. Ord a => a -> a -> Bool
< (SuperOwl -> Int
rp SuperOwl
sowl2) else Bool
True) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament forall a b. (a -> b) -> a -> b
$ SuperOwlParliament
sop
do_move :: (OwlSpot, SuperOwlParliament) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_move :: (OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_move (OwlSpot
os, SuperOwlParliament
sop) pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = forall a. HasCallStack => Bool -> a -> a
assert Bool
isUndoFriendly (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
isUndoFriendly :: Bool
isUndoFriendly = SuperOwlParliament -> Bool
isSuperOwlParliamentUndoFriendly SuperOwlParliament
sop
op :: OwlParliament
op = SuperOwlParliament -> OwlParliament
superOwlParliament_toOwlParliament SuperOwlParliament
sop
(OwlTree
newot, [SuperOwl]
changes') = OwlParliament -> OwlSpot -> OwlTree -> (OwlTree, [SuperOwl])
owlTree_moveOwlParliament OwlParliament
op OwlSpot
os OwlTree
_owlPFState_owlTree
changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. a -> Maybe a
Just SuperOwl
sowl)) [SuperOwl]
changes'
r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
newot}, REltIdMap (Maybe SuperOwl)
changes)
undo_move :: (OwlSpot, SuperOwlParliament) -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_move :: (OwlSpot, SuperOwlParliament)
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_move (OwlSpot
_, SuperOwlParliament
sop) pfs :: OwlPFState
pfs@OwlPFState {SCanvas
OwlTree
_owlPFState_canvas :: SCanvas
_owlPFState_owlTree :: OwlTree
_owlPFState_canvas :: OwlPFState -> SCanvas
_owlPFState_owlTree :: OwlPFState -> OwlTree
..} = forall a. HasCallStack => Bool -> a -> a
assert Bool
isUndoFriendly (OwlPFState, REltIdMap (Maybe SuperOwl))
r where
isUndoFriendly :: Bool
isUndoFriendly = SuperOwlParliament -> Bool
isSuperOwlParliamentUndoFriendly SuperOwlParliament
sop
removefoldfn :: OwlTree -> SuperOwl -> OwlTree
removefoldfn OwlTree
tree' SuperOwl
so = Int -> OwlTree -> OwlTree
owlTree_removeREltId (SuperOwl -> Int
_superOwl_id SuperOwl
so) OwlTree
tree'
removedTree :: OwlTree
removedTree = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' OwlTree -> SuperOwl -> OwlTree
removefoldfn OwlTree
_owlPFState_owlTree (SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament SuperOwlParliament
sop)
addmapaccumlfn :: OwlTree -> SuperOwl -> (OwlTree, SuperOwl)
addmapaccumlfn OwlTree
tree' SuperOwl
so = OwlSpot -> Int -> OwlItem -> OwlTree -> (OwlTree, SuperOwl)
owlTree_addOwlItem OwlSpot
ospot (SuperOwl -> Int
_superOwl_id SuperOwl
so) (SuperOwl -> OwlItem
_superOwl_elt SuperOwl
so) OwlTree
tree' where
ospot :: OwlSpot
ospot = OwlTree -> OwlItemMeta -> OwlSpot
owlTree_owlItemMeta_toOwlSpot OwlTree
tree' forall a b. (a -> b) -> a -> b
$ SuperOwl -> OwlItemMeta
_superOwl_meta SuperOwl
so
(OwlTree
addedTree, Seq SuperOwl
changes') = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL OwlTree -> SuperOwl -> (OwlTree, SuperOwl)
addmapaccumlfn OwlTree
removedTree (SuperOwlParliament -> Seq SuperOwl
unSuperOwlParliament SuperOwlParliament
sop)
changes :: REltIdMap (Maybe SuperOwl)
changes = forall a. [(Int, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SuperOwl
sowl -> (SuperOwl -> Int
_superOwl_id SuperOwl
sowl, forall a. a -> Maybe a
Just SuperOwl
sowl)) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq SuperOwl
changes')
r :: (OwlPFState, REltIdMap (Maybe SuperOwl))
r = (OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = OwlTree
addedTree}, REltIdMap (Maybe SuperOwl)
changes)
updateFnFromControllerOwl :: Bool -> Controller -> ((OwlItemMeta, OwlItem)->(OwlItemMeta, OwlItem))
updateFnFromControllerOwl :: Bool
-> Controller -> (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
updateFnFromControllerOwl Bool
isDo Controller
controller = (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
r where
f :: SEltLabel -> SEltLabel
f = Bool -> Controller -> SEltLabel -> SEltLabel
updateFnFromController Bool
isDo Controller
controller
rewrap :: a -> Maybe (Seq Int) -> SEltLabel -> (a, OwlItem)
rewrap a
oem Maybe (Seq Int)
mkiddos (SEltLabel Text
name SElt
elt) = case SElt
elt of
SElt
SEltFolderStart -> (a
oem, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (Seq Int -> OwlSubItem
OwlSubItemFolder (forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Int)
mkiddos)))
SElt
s -> (a
oem, OwlInfo -> OwlSubItem -> OwlItem
OwlItem (Text -> OwlInfo
OwlInfo Text
name) (SElt -> OwlSubItem
sElt_to_owlSubItem SElt
s))
r :: (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
r (OwlItemMeta
oem, OwlItem
oitem) = case OwlItem -> OwlSubItem
_owlItem_subItem OwlItem
oitem of
OwlSubItemFolder Seq Int
kiddos -> forall {a}. a -> Maybe (Seq Int) -> SEltLabel -> (a, OwlItem)
rewrap OwlItemMeta
oem (forall a. a -> Maybe a
Just Seq Int
kiddos) forall a b. (a -> b) -> a -> b
$ SEltLabel -> SEltLabel
f (Text -> SElt -> SEltLabel
SEltLabel (OwlItem -> Text
owlItem_name OwlItem
oitem) SElt
SEltFolderStart)
OwlSubItem
_ -> forall {a}. a -> Maybe (Seq Int) -> SEltLabel -> (a, OwlItem)
rewrap OwlItemMeta
oem forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ SEltLabel -> SEltLabel
f (forall o. HasOwlItem o => o -> SEltLabel
hasOwlItem_toSEltLabel_hack OwlItem
oitem)
manipulate :: Bool -> ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
manipulate :: Bool
-> ControllersWithId
-> OwlPFState
-> (OwlPFState, REltIdMap (Maybe SuperOwl))
manipulate Bool
isDo ControllersWithId
cs OwlPFState
pfs = (OwlPFState
r, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IntMap SuperOwl
changes) where
mapping :: IntMap (OwlItemMeta, OwlItem)
mapping = OwlTree -> IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwlPFState -> OwlTree
_owlPFState_owlTree forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs
changes' :: IntMap (OwlItemMeta, OwlItem)
changes' = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (Bool
-> Controller -> (OwlItemMeta, OwlItem) -> (OwlItemMeta, OwlItem)
updateFnFromControllerOwl Bool
isDo) ControllersWithId
cs IntMap (OwlItemMeta, OwlItem)
mapping
newMapping :: IntMap (OwlItemMeta, OwlItem)
newMapping = forall a. IntMap a -> IntMap a -> IntMap a
IM.union IntMap (OwlItemMeta, OwlItem)
changes' IntMap (OwlItemMeta, OwlItem)
mapping
changes :: IntMap SuperOwl
changes = forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
IM.mapWithKey (\Int
k (OwlItemMeta
oem, OwlItem
oe) -> Int -> OwlItemMeta -> OwlItem -> SuperOwl
SuperOwl Int
k OwlItemMeta
oem OwlItem
oe) IntMap (OwlItemMeta, OwlItem)
changes'
r :: OwlPFState
r = OwlPFState
pfs { _owlPFState_owlTree :: OwlTree
_owlPFState_owlTree = (OwlPFState -> OwlTree
_owlPFState_owlTree OwlPFState
pfs) { _owlTree_mapping :: IntMap (OwlItemMeta, OwlItem)
_owlTree_mapping = IntMap (OwlItemMeta, OwlItem)
newMapping } }
do_manipulate :: ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
do_manipulate :: ControllersWithId
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
do_manipulate = Bool
-> ControllersWithId
-> OwlPFState
-> (OwlPFState, REltIdMap (Maybe SuperOwl))
manipulate Bool
True
undo_manipulate :: ControllersWithId -> OwlPFState -> (OwlPFState, SuperOwlChanges)
undo_manipulate :: ControllersWithId
-> OwlPFState -> (OwlPFState, REltIdMap (Maybe SuperOwl))
undo_manipulate = Bool
-> ControllersWithId
-> OwlPFState
-> (OwlPFState, REltIdMap (Maybe SuperOwl))
manipulate Bool
False
isValidCanvas :: SCanvas -> Bool
isValidCanvas :: SCanvas -> Bool
isValidCanvas (SCanvas (LBox XY
p (V2 Int
w Int
h))) = XY
p forall a. Eq a => a -> a -> Bool
== XY
0 Bool -> Bool -> Bool
&& Int
w forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
h forall a. Ord a => a -> a -> Bool
> Int
0
do_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState
do_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState
do_resizeCanvas DeltaLBox
d OwlPFState
pfs = forall a. HasCallStack => Bool -> a -> a
assert (SCanvas -> Bool
isValidCanvas SCanvas
newCanvas) forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs { _owlPFState_canvas :: SCanvas
_owlPFState_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 (OwlPFState -> SCanvas
_owlPFState_canvas OwlPFState
pfs)) DeltaLBox
d
undo_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState
undo_resizeCanvas :: DeltaLBox -> OwlPFState -> OwlPFState
undo_resizeCanvas DeltaLBox
d OwlPFState
pfs = forall a. HasCallStack => Bool -> a -> a
assert (SCanvas -> Bool
isValidCanvas SCanvas
newCanvas) forall a b. (a -> b) -> a -> b
$ OwlPFState
pfs { _owlPFState_canvas :: SCanvas
_owlPFState_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 (OwlPFState -> SCanvas
_owlPFState_canvas OwlPFState
pfs)) DeltaLBox
d