module Nes.APU.State.DMC (
    DMC (..),
    newDMC,
    tickDMC,
    getPeriodValue,

    -- * Actions
    restartSample,
    loadSampleBuffer,

    -- * Output
    getDMCOutput,
) where

import Data.Array
import Data.Bits
import Data.List ((!?))
import Data.Maybe (fromMaybe, isNothing)
import Nes.Interrupt
import Nes.Memory

data DMC = MkDMC
    { DMC -> Bool
interruptFlag :: {-# UNPACK #-} !Bool
    , DMC -> Bool
loopFlag :: {-# UNPACK #-} !Bool
    , DMC -> Int
period :: {-# UNPACK #-} !Int
    , DMC -> Int
timer :: {-# UNPACK #-} !Int
    , DMC -> Addr
sampleOgAddr :: {-# UNPACK #-} !Addr
    , DMC -> Int
sampleOgLength :: {-# UNPACK #-} !Int
    , DMC -> Addr
sampleBufferAddr :: {-# UNPACK #-} !Addr -- Addr in memory of the sample buffer's byte
    , DMC -> Int
sampleBytesRemaining :: {-# UNPACK #-} !Int
    , DMC -> Maybe Byte
sampleBuffer :: !(Maybe Byte)
    , DMC -> Int
outputLevel :: {-# UNPACK #-} !Int
    , DMC -> Bool
enableChannel :: {-# UNPACK #-} !Bool
    , DMC -> Bool
shouldClock :: {-# UNPACK #-} !Bool
    , DMC -> Int
sleepingCycles :: {-# UNPACK #-} !Int
    , DMC -> Byte
shiftRegister :: {-# UNPACK #-} !Byte
    , DMC -> Byte
remainingBits :: {-# UNPACK #-} !Byte
    , DMC -> Bool
silentFlag :: {-# UNPACK #-} !Bool
    }

newDMC :: DMC
newDMC :: DMC
newDMC = MkDMC{Bool
Int
Maybe Byte
Addr
Byte
forall {a}. Maybe a
interruptFlag :: Bool
loopFlag :: Bool
period :: Int
timer :: Int
sampleOgAddr :: Addr
sampleOgLength :: Int
sampleBufferAddr :: Addr
sampleBytesRemaining :: Int
sampleBuffer :: Maybe Byte
outputLevel :: Int
enableChannel :: Bool
shouldClock :: Bool
sleepingCycles :: Int
shiftRegister :: Byte
remainingBits :: Byte
silentFlag :: Bool
interruptFlag :: Bool
loopFlag :: Bool
period :: Int
timer :: Int
sampleOgAddr :: Addr
sampleOgLength :: Int
sampleBufferAddr :: Addr
sampleBytesRemaining :: Int
remainingBits :: Byte
shiftRegister :: Byte
silentFlag :: Bool
sampleBuffer :: forall {a}. Maybe a
enableChannel :: Bool
outputLevel :: Int
shouldClock :: Bool
sleepingCycles :: Int
..}
  where
    interruptFlag :: Bool
interruptFlag = Bool
False
    loopFlag :: Bool
loopFlag = Bool
False
    period :: Int
period = Int
0
    timer :: Int
timer = Int
0
    sampleOgAddr :: Addr
sampleOgAddr = Addr
0
    sampleOgLength :: Int
sampleOgLength = Int
0
    sampleBufferAddr :: Addr
sampleBufferAddr = Addr
0
    sampleBytesRemaining :: Int
sampleBytesRemaining = Int
0
    remainingBits :: Byte
remainingBits = Byte
0
    shiftRegister :: Byte
shiftRegister = Byte
0
    silentFlag :: Bool
silentFlag = Bool
False
    sampleBuffer :: Maybe a
sampleBuffer = Maybe a
forall {a}. Maybe a
Nothing
    enableChannel :: Bool
enableChannel = Bool
True
    outputLevel :: Int
outputLevel = Int
0
    shouldClock :: Bool
shouldClock = Bool
False
    sleepingCycles :: Int
sleepingCycles = Int
0

periodTable :: [Int]
periodTable :: [Int]
periodTable = [Int
428, Int
380, Int
340, Int
320, Int
286, Int
254, Int
226, Int
214, Int
190, Int
160, Int
142, Int
128, Int
106, Int
84, Int
72, Int
54]

getPeriodValue :: Int -> Int
getPeriodValue :: Int -> Int
getPeriodValue Int
idx = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
428 ([Int]
periodTable [Int] -> Int -> Maybe Int
forall a. [a] -> Int -> Maybe a
!? Int
idx)

-- | When a sample is (re)started, the current address is set to the sample address, and bytes remaining is set to the sample length.
restartSample :: DMC -> DMC
restartSample :: DMC -> DMC
restartSample DMC
dmc =
    DMC
dmc
        { sampleBufferAddr = sampleOgAddr dmc
        , sampleBytesRemaining = sampleOgLength dmc
        , shouldClock = sampleOgLength dmc > 0
        }

{-# INLINE getDMCOutput #-}
getDMCOutput :: DMC -> Int
getDMCOutput :: DMC -> Int
getDMCOutput DMC
dmc = if DMC -> Bool
silentFlag DMC
dmc then Int
0 else DMC -> Int
outputLevel DMC
dmc

tickDMC :: DMC -> InterruptStatus -> (DMC, InterruptStatus)
tickDMC :: DMC -> InterruptStatus -> (DMC, InterruptStatus)
tickDMC DMC
dmc InterruptStatus
s =
    (if Bool
clocks then (DMC -> InterruptStatus -> (DMC, InterruptStatus)
`tickOutputUnit` InterruptStatus
s) else (,InterruptStatus
s))
        DMC
dmc
            { timer = newTimer
            , outputLevel = newOutputLevel
            , shiftRegister = newShiftRegister
            }
  where
    clocks :: Bool
clocks = DMC -> Int
timer DMC
dmc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    newTimer :: Int
newTimer = if DMC -> Int
timer DMC
dmc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then DMC -> Int
period DMC
dmc else DMC -> Int
timer DMC
dmc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    newShiftRegister :: Byte
newShiftRegister = if Bool
clocks then DMC -> Byte
shiftRegister DMC
dmc Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
`shiftR` Int
1 else DMC -> Byte
shiftRegister DMC
dmc
    newOutputLevel :: Int
newOutputLevel =
        if Bool
clocks Bool -> Bool -> Bool
&& Bool -> Bool
not (DMC -> Bool
silentFlag DMC
dmc)
            then
                let delta :: Int
delta = if DMC -> Byte
shiftRegister DMC
dmc Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
0 then Int
2 else (-Int
2)
                    tmpOutLevel :: Int
tmpOutLevel = DMC -> Int
outputLevel DMC
dmc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
                 in if (Int
0, Int
127) (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
`inRange` Int
tmpOutLevel then Int
tmpOutLevel else DMC -> Int
outputLevel DMC
dmc
            else DMC -> Int
outputLevel DMC
dmc

tickOutputUnit :: DMC -> InterruptStatus -> (DMC, InterruptStatus)
tickOutputUnit :: DMC -> InterruptStatus -> (DMC, InterruptStatus)
tickOutputUnit DMC
dmc InterruptStatus
s =
    if Bool
isEndOfOutputCycle
        then DMC -> InterruptStatus -> (DMC, InterruptStatus)
onOutputCycleEnd DMC
dmc1 InterruptStatus
s
        else (DMC
dmc1, InterruptStatus
s)
  where
    newRemainingBits :: Byte
newRemainingBits = Byte -> Byte -> Byte
forall a. Ord a => a -> a -> a
max Byte
0 (DMC -> Byte
remainingBits DMC
dmc Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
- Byte
1)
    isEndOfOutputCycle :: Bool
isEndOfOutputCycle = Byte
newRemainingBits Byte -> Byte -> Bool
forall a. Eq a => a -> a -> Bool
== Byte
0
    dmc1 :: DMC
dmc1 = DMC
dmc{remainingBits = newRemainingBits}

onOutputCycleEnd :: DMC -> InterruptStatus -> (DMC, InterruptStatus)
onOutputCycleEnd :: DMC -> InterruptStatus -> (DMC, InterruptStatus)
onOutputCycleEnd DMC
dmc InterruptStatus
interr = (DMC
dmc1, InterruptStatus
interr')
  where
    dmc0 :: DMC
dmc0 = DMC
dmc{remainingBits = 8}
    dmc1 :: DMC
dmc1 = case DMC -> Maybe Byte
sampleBuffer DMC
dmc0 of
        Maybe Byte
Nothing -> DMC
dmc0{silentFlag = True}
        Just Byte
b -> DMC
dmc0{shiftRegister = b, sampleBuffer = Nothing}
    interr' :: InterruptStatus
interr' =
        if Maybe Byte -> Bool
forall a. Maybe a -> Bool
isNothing (DMC -> Maybe Byte
sampleBuffer DMC
dmc1) Bool -> Bool -> Bool
&& DMC -> Int
sampleBytesRemaining DMC
dmc1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            then InterruptStatus
interr{irq = Just DMC}
            else InterruptStatus
interr

-- | Loads the byte into the sample buffer and shift the sample buffer-related values
loadSampleBuffer :: Byte -> DMC -> InterruptStatus -> (DMC, InterruptStatus)
loadSampleBuffer :: Byte -> DMC -> InterruptStatus -> (DMC, InterruptStatus)
loadSampleBuffer Byte
byte DMC
dmc InterruptStatus
s =
    let
        newSampleBufferAddr :: Addr
newSampleBufferAddr = let addr :: Addr
addr = DMC -> Addr
sampleBufferAddr DMC
dmc Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
+ Addr
1 in if Addr
addr Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
>= Addr
0xffff then Addr
addr Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x8000 else Addr
addr
        newRemainingLength :: Int
newRemainingLength = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (DMC -> Int
sampleBytesRemaining DMC
dmc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        dmc1 :: DMC
dmc1 =
            DMC
dmc
                { sampleBuffer = Just byte
                , sampleBytesRemaining = newRemainingLength
                , sampleBufferAddr = newSampleBufferAddr
                , shouldClock = newRemainingLength > 0
                }
        shouldRestartSample :: Bool
shouldRestartSample = Int
newRemainingLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& DMC -> Bool
loopFlag DMC
dmc
        shouldIRQ :: Bool
shouldIRQ = Int
newRemainingLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& DMC -> Bool
interruptFlag DMC
dmc
     in
        if Bool
shouldRestartSample
            then (DMC -> DMC
restartSample DMC
dmc1, InterruptStatus
s)
            else (DMC
dmc1, if Bool
shouldIRQ then InterruptStatus
s{irq = Just DMC} else InterruptStatus
s)