{-# LANGUAGE RankNTypes #-}

module Nes.APU.BusInterface.Pulse (
    -- * Pulse 1
    write4000,
    write4001,
    write4002,
    write4003,

    -- * Pulse 2
    write4004,
    write4005,
    write4006,
    write4007,
) where

import Control.Lens (Lens')
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.Pulse
import Nes.Internal.MonadState
import Nes.Memory

{-# INLINE write4000 #-}
write4000 :: Byte -> APU r ()
write4000 :: forall r. Byte -> APU r ()
write4000 = Lens' APUState Pulse -> Byte -> APU r ()
forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseFirstByte (Pulse -> f Pulse) -> APUState -> f APUState
Lens' APUState Pulse
pulse1

{-# INLINE write4004 #-}
write4004 :: Byte -> APU r ()
write4004 :: forall r. Byte -> APU r ()
write4004 = Lens' APUState Pulse -> Byte -> APU r ()
forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseFirstByte (Pulse -> f Pulse) -> APUState -> f APUState
Lens' APUState Pulse
pulse2

{-# INLINE writePulseFirstByte #-}
writePulseFirstByte :: Lens' APUState Pulse -> Byte -> APU r ()
writePulseFirstByte :: forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseFirstByte Lens' APUState Pulse
l Byte
byte = do
    let duty :: Byte
duty = Byte
byte Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
`shiftR` Int
6
        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
    (Pulse -> Identity Pulse) -> APUState -> Identity APUState
Lens' APUState Pulse
l
        ((Pulse -> Identity Pulse) -> APUState -> Identity APUState)
-> (Pulse -> Pulse) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (Envelope -> Envelope) -> Pulse -> Pulse
forall a. HasEnvelope a => (Envelope -> Envelope) -> a -> a
withEnvelope
            ( \Envelope
e ->
                Envelope
e
                    { constantVolume = byteToInt vol
                    , useConstantVolume = constVol
                    , loopFlag = haltLC
                    }
            )
    (Pulse -> Identity Pulse) -> APUState -> Identity APUState
Lens' APUState Pulse
l ((Pulse -> Identity Pulse) -> APUState -> Identity APUState)
-> (Pulse -> Pulse) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (LengthCounter -> LengthCounter) -> Pulse -> Pulse
forall a.
HasLengthCounter a =>
(LengthCounter -> LengthCounter) -> a -> a
withLengthCounter (\LengthCounter
lc -> LengthCounter
lc{isHalted = haltLC})
    (Pulse -> Identity Pulse) -> APUState -> Identity APUState
Lens' APUState Pulse
l ((Pulse -> Identity Pulse) -> APUState -> Identity APUState)
-> (Pulse -> Pulse) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= \Pulse
p -> Pulse
p{dutyIndex = fromIntegral $ unByte duty}

{-# INLINE write4001 #-}
write4001 :: Byte -> APU r ()
write4001 :: forall r. Byte -> APU r ()
write4001 = Lens' APUState Pulse -> Byte -> APU r ()
forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseSecondByte (Pulse -> f Pulse) -> APUState -> f APUState
Lens' APUState Pulse
pulse1

{-# INLINE write4005 #-}
write4005 :: Byte -> APU r ()
write4005 :: forall r. Byte -> APU r ()
write4005 = Lens' APUState Pulse -> Byte -> APU r ()
forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseSecondByte (Pulse -> f Pulse) -> APUState -> f APUState
Lens' APUState Pulse
pulse2

{-# INLINE writePulseSecondByte #-}
writePulseSecondByte :: Lens' APUState Pulse -> Byte -> APU r ()
writePulseSecondByte :: forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseSecondByte Lens' APUState Pulse
l Byte
byte = do
    let enabledFlag :: Bool
enabledFlag = Byte
byte Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
        divPeriod :: Byte
divPeriod = Byte
1 Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ ((Byte
byte Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
0b111)
        negateFlag :: Bool
negateFlag = Byte
byte Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
3
        shiftC :: Byte
shiftC = Byte
byte Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
0b111
        sweepIsEnabled :: Bool
sweepIsEnabled = Bool
enabledFlag Bool -> Bool -> Bool
&& Byte
shiftC Byte -> Byte -> Bool
forall a. Ord a => a -> a -> Bool
> Byte
0
    (Pulse -> Identity Pulse) -> APUState -> Identity APUState
Lens' APUState Pulse
l
        ((Pulse -> Identity Pulse) -> APUState -> Identity APUState)
-> (Pulse -> Pulse) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (SweepUnit -> SweepUnit) -> Pulse -> Pulse
modifySweep
            ( \SweepUnit
s ->
                SweepUnit
s
                    { reloadFlag = True
                    , enabled = sweepIsEnabled
                    , dividerPeriod = byteToInt divPeriod
                    , negateDelta = negateFlag
                    , shiftCount = byteToInt shiftC
                    }
            )
    (Pulse -> Identity Pulse) -> APUState -> Identity APUState
Lens' APUState Pulse
l ((Pulse -> Identity Pulse) -> APUState -> Identity APUState)
-> (Pulse -> Pulse) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Pulse -> Pulse
updateTargetPeriod

{-# INLINE write4002 #-}
write4002 :: Byte -> APU r ()
write4002 :: forall r. Byte -> APU r ()
write4002 = Lens' APUState Pulse -> Byte -> APU r ()
forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseThirdByte (Pulse -> f Pulse) -> APUState -> f APUState
Lens' APUState Pulse
pulse1

{-# INLINE write4006 #-}
write4006 :: Byte -> APU r ()
write4006 :: forall r. Byte -> APU r ()
write4006 = Lens' APUState Pulse -> Byte -> APU r ()
forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseThirdByte (Pulse -> f Pulse) -> APUState -> f APUState
Lens' APUState Pulse
pulse2

{-# INLINE writePulseThirdByte #-}
writePulseThirdByte :: Lens' APUState Pulse -> Byte -> APU r ()
writePulseThirdByte :: forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseThirdByte Lens' APUState Pulse
l Byte
byte =
    (Pulse -> Identity Pulse) -> APUState -> Identity APUState
Lens' APUState Pulse
l ((Pulse -> Identity Pulse) -> APUState -> Identity APUState)
-> (Pulse -> Pulse) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= \Pulse
p ->
        let newPeriod :: Int
newPeriod = (Pulse -> Int
period Pulse
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0b11100000000) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Byte -> Int
byteToInt Byte
byte
         in Pulse -> Pulse
updateTargetPeriod (Pulse -> Pulse) -> Pulse -> Pulse
forall a b. (a -> b) -> a -> b
$ Pulse
p{period = newPeriod}

{-# INLINE write4003 #-}
write4003 :: Byte -> APU r ()
write4003 :: forall r. Byte -> APU r ()
write4003 = Lens' APUState Pulse -> Byte -> APU r ()
forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseFourthByte (Pulse -> f Pulse) -> APUState -> f APUState
Lens' APUState Pulse
pulse1

{-# INLINE write4007 #-}
write4007 :: Byte -> APU r ()
write4007 :: forall r. Byte -> APU r ()
write4007 = Lens' APUState Pulse -> Byte -> APU r ()
forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseFourthByte (Pulse -> f Pulse) -> APUState -> f APUState
Lens' APUState Pulse
pulse2

{-# INLINE writePulseFourthByte #-}
writePulseFourthByte :: Lens' APUState Pulse -> Byte -> APU r ()
writePulseFourthByte :: forall r. Lens' APUState Pulse -> Byte -> APU r ()
writePulseFourthByte Lens' APUState Pulse
l Byte
byte =
    (Pulse -> Identity Pulse) -> APUState -> Identity APUState
Lens' APUState Pulse
l ((Pulse -> Identity Pulse) -> APUState -> Identity APUState)
-> (Pulse -> Pulse) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= \Pulse
p ->
        let newPeriod :: Int
newPeriod = ((Byte -> Int
byteToInt Byte
byte Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0b111) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Pulse -> Int
period Pulse
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0b11111111)
            newLCLoad :: Int
newLCLoad = Byte -> Int
byteToInt Byte
byte Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
         in Pulse -> Pulse
updateTargetPeriod (Pulse -> Pulse) -> Pulse -> Pulse
forall a b. (a -> b) -> a -> b
$
                (Envelope -> Envelope) -> Pulse -> Pulse
forall a. HasEnvelope a => (Envelope -> Envelope) -> a -> a
withEnvelope (\Envelope
e -> Envelope
e{startFlag = True}) (Pulse -> Pulse) -> Pulse -> Pulse
forall a b. (a -> b) -> a -> b
$
                    (LengthCounter -> LengthCounter) -> Pulse -> Pulse
forall a.
HasLengthCounter a =>
(LengthCounter -> LengthCounter) -> a -> a
withLengthCounter
                        (Int -> LengthCounter -> LengthCounter
loadLengthCounter Int
newLCLoad)
                        Pulse
p
                            { period = newPeriod
                            , dutyStep = 0
                            }