module Gamgine.State.StateTree where
import qualified Data.List as L
import qualified Graphics.UI.GLFW as GLFW
import qualified Gamgine.State.State as S
import qualified Gamgine.State.InputInfo as II
import qualified Gamgine.State.MouseInfo as MI
import qualified Gamgine.State.KeyInfo as KI

-- | the tree of application states and how they entered and leaved
data StateTree a = Branch {
   forall a. StateTree a -> State a
state     :: S.State a,
   forall a. StateTree a -> StateTransition
enterWhen :: StateTransition,
   forall a. StateTree a -> StateTransition
leaveWhen :: StateTransition,
   forall a. StateTree a -> [StateTree a]
adjacents :: [StateTree a]
   }

-- | at which event the next state should be entered
type EnterWhen = StateTransition

-- | at which event the current state should be leaved
type LeaveWhen = StateTransition

-- | when a state should be entered or leaved
data StateTransition = ByKey GLFW.Key II.InputState
                     | ByKeyWithMod GLFW.Key II.InputState II.Modifier
                     | ByMouse GLFW.MouseButton II.InputState
                     | ByMouseWithMod GLFW.MouseButton II.InputState II.Modifier
                     | NoTransition
                     deriving (StateTransition -> StateTransition -> Bool
(StateTransition -> StateTransition -> Bool)
-> (StateTransition -> StateTransition -> Bool)
-> Eq StateTransition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateTransition -> StateTransition -> Bool
== :: StateTransition -> StateTransition -> Bool
$c/= :: StateTransition -> StateTransition -> Bool
/= :: StateTransition -> StateTransition -> Bool
Eq, Eq StateTransition
Eq StateTransition =>
(StateTransition -> StateTransition -> Ordering)
-> (StateTransition -> StateTransition -> Bool)
-> (StateTransition -> StateTransition -> Bool)
-> (StateTransition -> StateTransition -> Bool)
-> (StateTransition -> StateTransition -> Bool)
-> (StateTransition -> StateTransition -> StateTransition)
-> (StateTransition -> StateTransition -> StateTransition)
-> Ord StateTransition
StateTransition -> StateTransition -> Bool
StateTransition -> StateTransition -> Ordering
StateTransition -> StateTransition -> StateTransition
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StateTransition -> StateTransition -> Ordering
compare :: StateTransition -> StateTransition -> Ordering
$c< :: StateTransition -> StateTransition -> Bool
< :: StateTransition -> StateTransition -> Bool
$c<= :: StateTransition -> StateTransition -> Bool
<= :: StateTransition -> StateTransition -> Bool
$c> :: StateTransition -> StateTransition -> Bool
> :: StateTransition -> StateTransition -> Bool
$c>= :: StateTransition -> StateTransition -> Bool
>= :: StateTransition -> StateTransition -> Bool
$cmax :: StateTransition -> StateTransition -> StateTransition
max :: StateTransition -> StateTransition -> StateTransition
$cmin :: StateTransition -> StateTransition -> StateTransition
min :: StateTransition -> StateTransition -> StateTransition
Ord)

root :: S.State a -> [StateTree a] -> StateTree a
root :: forall a. State a -> [StateTree a] -> StateTree a
root State a
s [StateTree a]
as = State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
forall a.
State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
Branch State a
s StateTransition
NoTransition StateTransition
NoTransition [StateTree a]
as


enterState :: II.MousePos -> a -> StateTree a -> Maybe (a, StateTree a)
enterState :: forall a. MousePos -> a -> StateTree a -> Maybe (a, StateTree a)
enterState MousePos
mp a
a st :: StateTree a
st@(Branch State a
s StateTransition
e StateTransition
l [StateTree a]
as) =
   case (State a -> MousePos -> a -> Maybe (a, State a)
forall a. State a -> MousePos -> a -> Maybe (a, State a)
S.enter State a
s) MousePos
mp a
a of
        Just (a
a', State a
s') -> (a, StateTree a) -> Maybe (a, StateTree a)
forall a. a -> Maybe a
Just (a
a', State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
forall a.
State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
Branch State a
s' StateTransition
e StateTransition
l [StateTree a]
as)
        Maybe (a, State a)
_             -> Maybe (a, StateTree a)
forall a. Maybe a
Nothing


leaveState :: a -> StateTree a -> (a, StateTree a)
leaveState :: forall a. a -> StateTree a -> (a, StateTree a)
leaveState a
a (Branch State a
s StateTransition
e StateTransition
l [StateTree a]
as) =
   let (a
a', State a
s') = State a -> a -> (a, State a)
forall a. State a -> a -> (a, State a)
S.leave State a
s (a -> (a, State a)) -> a -> (a, State a)
forall a b. (a -> b) -> a -> b
$ a
a in (a
a', State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
forall a.
State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
Branch State a
s' StateTransition
e StateTransition
l [StateTree a]
as)


handleKeyEvent :: KI.KeyInfo -> a -> StateTree a -> (a, StateTree a)
handleKeyEvent :: forall a. KeyInfo -> a -> StateTree a -> (a, StateTree a)
handleKeyEvent KeyInfo
ki a
a (Branch State a
s StateTransition
e StateTransition
l [StateTree a]
as) =
   let (a
a', State a
s') = (State a -> KeyInfo -> a -> (a, State a)
forall a. State a -> KeyInfo -> a -> (a, State a)
S.keyEvent State a
s) KeyInfo
ki a
a in (a
a', State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
forall a.
State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
Branch State a
s' StateTransition
e StateTransition
l [StateTree a]
as)


handleMouseEvent :: MI.MouseInfo -> a -> StateTree a -> (a, StateTree a)
handleMouseEvent :: forall a. MouseInfo -> a -> StateTree a -> (a, StateTree a)
handleMouseEvent MouseInfo
mi a
a (Branch State a
s StateTransition
e StateTransition
l [StateTree a]
as) =
   let (a
a', State a
s') = (State a -> MouseInfo -> a -> (a, State a)
forall a. State a -> MouseInfo -> a -> (a, State a)
S.mouseEvent State a
s) MouseInfo
mi a
a in (a
a', State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
forall a.
State a
-> StateTransition
-> StateTransition
-> [StateTree a]
-> StateTree a
Branch State a
s' StateTransition
e StateTransition
l [StateTree a]
as)