module TimerF(timerF,Tick(..)) where
import Fudget
import FudgetIO
import FRequest
import Srequest(sIO,sIOsucc,select)
import NullF
import Sockets
import DialogueIO hiding (IOError)
data Tick = Tick deriving (Int -> Tick -> ShowS
[Tick] -> ShowS
Tick -> String
(Int -> Tick -> ShowS)
-> (Tick -> String) -> ([Tick] -> ShowS) -> Show Tick
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tick] -> ShowS
$cshowList :: [Tick] -> ShowS
show :: Tick -> String
$cshow :: Tick -> String
showsPrec :: Int -> Tick -> ShowS
$cshowsPrec :: Int -> Tick -> ShowS
Show,Tick -> Tick -> Bool
(Tick -> Tick -> Bool) -> (Tick -> Tick -> Bool) -> Eq Tick
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tick -> Tick -> Bool
$c/= :: Tick -> Tick -> Bool
== :: Tick -> Tick -> Bool
$c== :: Tick -> Tick -> Bool
Eq)
timerF :: F (Maybe (Int, Int)) Tick
timerF = Maybe Timer -> F (Maybe (Int, Int)) Tick
f Maybe Timer
forall a. Maybe a
Nothing
where
f :: Maybe Timer -> F (Maybe (Int, Int)) Tick
f Maybe Timer
oTno =
Cont (F (Maybe (Int, Int)) Tick) (KEvent (Maybe (Int, Int)))
forall a b. Cont (F a b) (KEvent a)
getMessageFu Cont (F (Maybe (Int, Int)) Tick) (KEvent (Maybe (Int, Int)))
-> Cont (F (Maybe (Int, Int)) Tick) (KEvent (Maybe (Int, Int)))
forall a b. (a -> b) -> a -> b
$ \ KEvent (Maybe (Int, Int))
msg ->
let same :: F (Maybe (Int, Int)) Tick
same = Maybe Timer -> F (Maybe (Int, Int)) Tick
f Maybe Timer
oTno
settimer :: Int -> Int -> F (Maybe (Int, Int)) Tick
settimer Int
int Int
first = case Maybe Timer
oTno of
Just _ -> F (Maybe (Int, Int)) Tick
same
Maybe Timer
Nothing ->
SocketRequest
-> (SocketResponse -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
SocketRequest -> (SocketResponse -> f b ho) -> f b ho
sIO (Int -> Int -> SocketRequest
CreateTimer Int
int Int
first) ((SocketResponse -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick)
-> (SocketResponse -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$ \ (Timer Timer
tno) ->
[Descriptor]
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
[Descriptor] -> f hi ho -> f hi ho
select [Timer -> Descriptor
TimerDe Timer
tno] (F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$
Maybe Timer -> F (Maybe (Int, Int)) Tick
f (Timer -> Maybe Timer
forall a. a -> Maybe a
Just Timer
tno)
removetimer :: F (Maybe (Int, Int)) Tick
removetimer = case Maybe Timer
oTno of
Just tno -> SocketRequest
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) b ho.
FudgetIO f =>
SocketRequest -> f b ho -> f b ho
sIOsucc (Timer -> SocketRequest
DestroyTimer Timer
tno) (F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$
[Descriptor]
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
[Descriptor] -> f hi ho -> f hi ho
select [] (F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$
Maybe Timer -> F (Maybe (Int, Int)) Tick
f Maybe Timer
forall a. Maybe a
Nothing
Maybe Timer
Nothing -> F (Maybe (Int, Int)) Tick
same
in case KEvent (Maybe (Int, Int))
msg of
High (Just (Int
interval, Int
first)) -> Int -> Int -> F (Maybe (Int, Int)) Tick
settimer Int
interval Int
first
High Maybe (Int, Int)
Nothing -> F (Maybe (Int, Int)) Tick
removetimer
Low (DResp (AsyncInput (Descriptor
_, AEvent
TimerAlarm))) ->
Tick -> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh Tick
Tick (F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick)
-> F (Maybe (Int, Int)) Tick -> F (Maybe (Int, Int)) Tick
forall a b. (a -> b) -> a -> b
$
F (Maybe (Int, Int)) Tick
same