module Nes.APU.BusInterface.FrameCounter (write4017) where
import Control.Monad
import Data.Bits
import Nes.APU.Monad
import Nes.APU.State
import Nes.APU.State.FrameCounter
import Nes.APU.Tick
import Nes.Internal.MonadState
import Nes.Memory
{-# INLINE write4017 #-}
write4017 :: Byte -> APU r ()
write4017 :: forall r. Byte -> APU r ()
write4017 Byte
byte = do
Int
c <- Getting Int APUState Int -> APU r Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int APUState Int
Lens' APUState Int
Nes.APU.State.cycle
let seqMode :: SequenceMode
seqMode = Bool -> SequenceMode
sequenceModeFromBool (Bool -> SequenceMode) -> Bool -> SequenceMode
forall a b. (a -> b) -> a -> b
$ Byte
byte Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
inhibit :: Bool
inhibit = Byte
byte Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
6
delay :: Int
delay = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
c then Int
4 else Int
3
(FrameCounter -> Identity FrameCounter)
-> APUState -> Identity APUState
Lens' APUState FrameCounter
frameCounter ((FrameCounter -> Identity FrameCounter)
-> APUState -> Identity APUState)
-> (FrameCounter -> FrameCounter) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= \FrameCounter
fc' -> FrameCounter
fc'{sequenceMode = seqMode, inhibitInterrupt = inhibit, delayedWriteSideEffectCycle = Just delay}
Bool -> APU r () -> APU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SequenceMode
seqMode SequenceMode -> SequenceMode -> Bool
forall a. Eq a => a -> a -> Bool
== SequenceMode
FiveStep) (APU r () -> APU r ()) -> APU r () -> APU r ()
forall a b. (a -> b) -> a -> b
$ do
APU r ()
forall r. APU r ()
runQuarterFrameEvent
APU r ()
forall r. APU r ()
runHalfFrameEvent
Bool -> APU r () -> APU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
inhibit (APU r () -> APU r ()) -> APU r () -> APU r ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> APU r ()
forall r. Bool -> APU r ()
setFrameInterruptFlag Bool
False