module Nes.APU.BusInterface.Noise (write400C, write400E, write400F) where

import Data.Bits
import Nes.APU.Monad
import Nes.APU.State
import Nes.APU.State.Envelope
import Nes.APU.State.LengthCounter
import Nes.APU.State.Noise
import Nes.Internal.MonadState
import Nes.Memory

{-# INLINE write400C #-}
write400C :: Byte -> APU r ()
write400C :: forall r. Byte -> APU r ()
write400C Byte
byte = do
    let haltLC :: Bool
haltLC = Byte
byte Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
5
        constVol :: Bool
constVol = Byte
byte Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
4
        vol :: Byte
vol = Byte
byte Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
0b1111
    (Noise -> Identity Noise) -> APUState -> Identity APUState
Lens' APUState Noise
noise ((Noise -> Identity Noise) -> APUState -> Identity APUState)
-> (Noise -> Noise) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (Envelope -> Envelope) -> Noise -> Noise
forall a. HasEnvelope a => (Envelope -> Envelope) -> a -> a
withEnvelope (\Envelope
e -> Envelope
e{constantVolume = byteToInt vol, useConstantVolume = constVol, loopFlag = haltLC})
    (Noise -> Identity Noise) -> APUState -> Identity APUState
Lens' APUState Noise
noise ((Noise -> Identity Noise) -> APUState -> Identity APUState)
-> (Noise -> Noise) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (LengthCounter -> LengthCounter) -> Noise -> Noise
forall a.
HasLengthCounter a =>
(LengthCounter -> LengthCounter) -> a -> a
withLengthCounter (\LengthCounter
lc -> LengthCounter
lc{isHalted = haltLC})

{-# INLINE write400E #-}
write400E :: Byte -> APU r ()
write400E :: forall r. Byte -> APU r ()
write400E Byte
byte = do
    let modeFlag :: Bool
modeFlag = Byte
byte Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
        periodIndex :: Int
periodIndex = Byte -> Int
byteToInt (Byte -> Int) -> Byte -> Int
forall a b. (a -> b) -> a -> b
$ Byte
byte Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
0b1111
    (Noise -> Identity Noise) -> APUState -> Identity APUState
Lens' APUState Noise
noise ((Noise -> Identity Noise) -> APUState -> Identity APUState)
-> (Noise -> Noise) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= \Noise
t -> Noise
t{period = getPeriodValue periodIndex, useBit6ForFeedback = modeFlag}

{-# INLINE write400F #-}
write400F :: Byte -> APU r ()
write400F :: forall r. Byte -> APU r ()
write400F Byte
byte = do
    let newLCLoad :: Int
newLCLoad = Byte -> Int
byteToInt (Byte -> Int) -> Byte -> Int
forall a b. (a -> b) -> a -> b
$ Byte
byte Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
    (Noise -> Identity Noise) -> APUState -> Identity APUState
Lens' APUState Noise
noise
        ((Noise -> Identity Noise) -> APUState -> Identity APUState)
-> (Noise -> Noise) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= ( (LengthCounter -> LengthCounter) -> Noise -> Noise
forall a.
HasLengthCounter a =>
(LengthCounter -> LengthCounter) -> a -> a
withLengthCounter (Int -> LengthCounter -> LengthCounter
loadLengthCounter Int
newLCLoad)
                (Noise -> Noise) -> (Noise -> Noise) -> Noise -> Noise
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Envelope -> Envelope) -> Noise -> Noise
forall a. HasEnvelope a => (Envelope -> Envelope) -> a -> a
withEnvelope (\Envelope
e -> Envelope
e{startFlag = True})
           )