From 05aa5c3cbcbeeea0cadd3714bb4fd6b3295e7d83 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 7 Nov 2025 08:57:22 +0000
Subject: [PATCH 01/37] APU: Define State, Monad, tick function and link to Bus

---
 funes.cabal          |  3 +++
 src/Nes/APU/Monad.hs | 50 ++++++++++++++++++++++++++++++++++++++
 src/Nes/APU/State.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++
 src/Nes/APU/Tick.hs  | 31 +++++++++++++++++++++++
 src/Nes/Bus.hs       |  4 +++
 src/Nes/Bus/Monad.hs | 24 +++++++++++++++---
 6 files changed, 166 insertions(+), 4 deletions(-)
 create mode 100644 src/Nes/APU/Monad.hs
 create mode 100644 src/Nes/APU/State.hs
 create mode 100644 src/Nes/APU/Tick.hs

diff --git a/funes.cabal b/funes.cabal
index 1d34038..b6528d7 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -24,6 +24,9 @@ source-repository head
 
 library
   exposed-modules:
+      Nes.APU.Monad
+      Nes.APU.State
+      Nes.APU.Tick
       Nes.Bus
       Nes.Bus.Constants
       Nes.Bus.Monad
diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
new file mode 100644
index 0000000..8c71c6a
--- /dev/null
+++ b/src/Nes/APU/Monad.hs
@@ -0,0 +1,50 @@
+module Nes.APU.Monad (
+    APU (..),
+    runAPU,
+    modifyAPUState,
+    withAPUState,
+) where
+
+import Control.Monad.IO.Class
+import Nes.APU.State
+
+newtype APU r a = MkAPU
+    { unAPU :: APUState -> (APUState -> a -> IO r) -> IO r
+    -- TODO Not sure IO is needed here
+    }
+    deriving (Functor)
+
+instance Applicative (APU r) where
+    {-# INLINE pure #-}
+    pure a = MkAPU $ \st cont -> cont st a
+
+    {-# INLINE liftA2 #-}
+    liftA2 f (MkAPU a) (MkAPU b) = MkAPU $ \st cont ->
+        a st $ \st' a' -> b st' $ \st'' b' -> cont st'' (f a' b')
+
+instance Monad (APU r) where
+    {-# INLINE (>>=) #-}
+    (MkAPU a) >>= next = MkAPU $ \st cont ->
+        a st $ \st' a' -> unAPU (next a') st' $ \st'' res -> cont st'' res
+
+instance MonadIO (APU r) where
+    {-# INLINE liftIO #-}
+    liftIO io = MkAPU $ \st cont -> io >>= cont st
+
+instance MonadFail (APU r) where
+    {-# INLINE fail #-}
+    fail = liftIO . fail
+
+{-# INLINE runAPU #-}
+runAPU :: APUState -> APU (a, APUState) a -> IO (a, APUState)
+runAPU st f = unAPU op st $ \_ a -> return a
+  where
+    op = f >>= \a -> withAPUState (a,)
+
+{-# INLINE modifyAPUState #-}
+modifyAPUState :: (APUState -> APUState) -> APU r ()
+modifyAPUState f = MkAPU $ \st cont -> cont (f st) ()
+
+{-# INLINE withAPUState #-}
+withAPUState :: (APUState -> a) -> APU r a
+withAPUState f = MkAPU $ \st cont -> cont st (f st)
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
new file mode 100644
index 0000000..7ec070f
--- /dev/null
+++ b/src/Nes/APU/State.hs
@@ -0,0 +1,58 @@
+module Nes.APU.State (
+    -- * Definition
+    APUState (..),
+    newAPUState,
+) where
+
+data APUState = MkAPUState
+
+-- { pulse1 :: Pulse
+-- , pulse2 :: Pulse
+-- , triangle :: Triangle
+-- , noise :: Noise
+-- , dmc :: DMC
+-- , status :: StatusRegister
+-- , frameCounter :: FrameCounter
+-- }
+
+newAPUState :: APUState
+newAPUState =
+    MkAPUState
+
+-- { pulse1 = mkChannel 0 0 0 0
+-- , pulse2 = mkChannel 0 0 0 0
+-- , triangle = mkChannel 0 0 0 0
+-- , noise = mkChannel 0 0 0 0
+-- , dmc = mkChannel 0 0 0 0
+-- , status = MkSR 0
+-- , frameCounter = MkFC 0
+-- }
+-- mkChannel b1 b2 b3 b4 = fromChannel $ MkChannel b1 b2 b3 b4
+
+-- {-# INLINE modifyPulse1 #-}
+-- modifyPulse1 :: (Pulse -> Pulse) -> APUState -> APUState
+-- modifyPulse1 f st = st{pulse1 = f (pulse1 st)}
+--
+-- {-# INLINE modifyPulse2 #-}
+-- modifyPulse2 :: (Pulse -> Pulse) -> APUState -> APUState
+-- modifyPulse2 f st = st{pulse2 = f (pulse2 st)}
+--
+-- {-# INLINE modifyTriangle #-}
+-- modifyTriangle :: (Triangle -> Triangle) -> APUState -> APUState
+-- modifyTriangle f st = st{triangle = f (triangle st)}
+--
+-- {-# INLINE modifyNoise #-}
+-- modifyNoise :: (Noise -> Noise) -> APUState -> APUState
+-- modifyNoise f st = st{noise = f (noise st)}
+--
+-- {-# INLINE modifyDMC #-}
+-- modifyDMC :: (DMC -> DMC) -> APUState -> APUState
+-- modifyDMC f st = st{dmc = f (dmc st)}
+--
+-- {-# INLINE modifyStatus #-}
+-- modifyStatus :: (StatusRegister -> StatusRegister) -> APUState -> APUState
+-- modifyStatus f st = st{status = f (status st)}
+--
+-- {-# INLINE modifyFrameCounter #-}
+-- modifyFrameCounter :: (FrameCounter -> FrameCounter) -> APUState -> APUState
+-- modifyFrameCounter f st = st{frameCounter = f (frameCounter st)}
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
new file mode 100644
index 0000000..0ea5431
--- /dev/null
+++ b/src/Nes/APU/Tick.hs
@@ -0,0 +1,31 @@
+module Nes.APU.Tick (
+    -- * Semantic of a tick
+    -- $semantic
+    tick,
+    tickOnce,
+    IsAPUCycle,
+) where
+
+import Control.Monad
+import Nes.APU.Monad
+
+-- $use
+--     The APU being a part of the CPU, they both tick at the same time. However, some clocks are updated every other CPU cycles.
+--     Here the 'tick' function should be called every CPU tick, and pass as parameter whether the tick is on an even CPU cycle or not.
+--     Same goes for 'tickMany'.
+
+type IsAPUCycle = Bool
+
+-- | Calls 'tick' n amount of time
+--
+-- the first parameter says whether the first tick is an APU cycle or not
+tick :: IsAPUCycle -> Int -> APU r ()
+tick _ 0 = return ()
+tick b n = tickOnce b >> tick (not b) (n - 1)
+
+tickOnce :: IsAPUCycle -> APU r ()
+tickOnce isAPUCycle = do
+    -- TODO Ticks and clocks
+    when isAPUCycle $ do
+        return () -- TODO Do things and stuff
+    return ()
diff --git a/src/Nes/Bus.hs b/src/Nes/Bus.hs
index 9839534..701fb11 100644
--- a/src/Nes/Bus.hs
+++ b/src/Nes/Bus.hs
@@ -10,6 +10,7 @@ module Nes.Bus (
     newBus,
 ) where
 
+import Nes.APU.State (APUState, newAPUState)
 import Nes.Controller
 import Nes.Internal
 import Nes.Memory
@@ -40,6 +41,8 @@ data Bus = Bus
     -- ^ Memory dedicated to PPU
     , onNewFrame :: Bus -> IO Bus
     , lastReadByte :: Byte
+    -- ^ For open bus behaviour. Can be seen as data bus
+    , apuState :: !APUState
     }
 
 newBus :: Rom -> (Bus -> IO Bus) -> (Double -> Int -> IO (Double, Int)) -> IO Bus
@@ -60,3 +63,4 @@ newBus rom_ onNewFrame_ tickCallback_ = do
             ppuPtrs
             onNewFrame_
             0
+            newAPUState
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index a51f995..7f6bf52 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
-module Nes.Bus.Monad (BusM (..), runBusM, tick, withBus, withPPU, withController) where
+module Nes.Bus.Monad (BusM (..), runBusM, tick, withBus, withPPU, withAPU, withController) where
 
 import Control.Monad
 import Control.Monad.IO.Class
@@ -9,6 +9,9 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Internal as BS
 import Data.Ix
 import Foreign
+import Nes.APU.Monad
+import Nes.APU.State
+import qualified Nes.APU.Tick as APU
 import Nes.Bus
 import Nes.Bus.Constants
 import Nes.Controller
@@ -17,7 +20,7 @@ import Nes.Memory
 import Nes.PPU.Constants (oamDataSize)
 import Nes.PPU.Monad hiding (tick)
 import qualified Nes.PPU.Monad as PPUM
-import Nes.PPU.State
+import Nes.PPU.State hiding (cycles)
 import Nes.Rom
 
 newtype BusM r a = MkBusM {unBusM :: Bus -> (Bus -> a -> IO r) -> IO r} deriving (Functor)
@@ -61,6 +64,12 @@ withPPU f = MkBusM $ \bus cont -> do
     (res, ppuSt) <- runPPU (ppuState bus) (ppuPointers bus) (cartridge bus) f
     cont (bus{ppuState = ppuSt}) res
 
+{-# INLINE withAPU #-}
+withAPU :: APU (a, APUState) a -> BusM r a
+withAPU f = MkBusM $ \bus cont -> do
+    (res, apuSt) <- runAPU (apuState bus) f
+    cont (bus{apuState = apuSt}) res
+
 {-# INLINE withController #-}
 withController :: ControllerM (a, Controller) a -> BusM r a
 withController f = MkBusM $ \bus cont ->
@@ -79,8 +88,15 @@ tick n = MkBusM $ \bus cont -> do
         isNewFrame <- PPUM.tick (n * 3)
         after <- withPPUState nmiInterrupt
         return (isNewFrame, before, after)
-
-    let bus' = bus{unsleptCycles = newUnsleptCycles, ppuState = ppuSt, Nes.Bus.cycles = fromIntegral n + Nes.Bus.cycles bus, lastSleepTime = newLastSleepTime}
+    ((), apuSt) <- runAPU (apuState bus) $ APU.tick (odd (Nes.Bus.cycles bus)) n
+    let bus' =
+            bus
+                { unsleptCycles = newUnsleptCycles
+                , ppuState = ppuSt
+                , apuState = apuSt
+                , cycles = fromIntegral n + cycles bus
+                , lastSleepTime = newLastSleepTime
+                }
     if not nmiBefore && nmiAfter
         then onNewFrame bus' bus' >>= flip cont ()
         else

From 7d526d0dc1d7d3ad502479a3627d842fb93d23ad Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 7 Nov 2025 10:51:07 +0000
Subject: [PATCH 02/37] APU: Setup Frame Counter

---
 funes.cabal                       |  3 ++
 src/Nes/APU/BusInterface.hs       | 24 +++++++++++++
 src/Nes/APU/Monad/FrameCounter.hs | 59 +++++++++++++++++++++++++++++++
 src/Nes/APU/State.hs              | 15 +++++---
 src/Nes/APU/State/FrameCounter.hs | 41 +++++++++++++++++++++
 src/Nes/APU/Tick.hs               |  4 +--
 src/Nes/Bus/Monad.hs              |  4 ++-
 7 files changed, 142 insertions(+), 8 deletions(-)
 create mode 100644 src/Nes/APU/BusInterface.hs
 create mode 100644 src/Nes/APU/Monad/FrameCounter.hs
 create mode 100644 src/Nes/APU/State/FrameCounter.hs

diff --git a/funes.cabal b/funes.cabal
index b6528d7..036133a 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -24,8 +24,11 @@ source-repository head
 
 library
   exposed-modules:
+      Nes.APU.BusInterface
       Nes.APU.Monad
+      Nes.APU.Monad.FrameCounter
       Nes.APU.State
+      Nes.APU.State.FrameCounter
       Nes.APU.Tick
       Nes.Bus
       Nes.Bus.Constants
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
new file mode 100644
index 0000000..f243c01
--- /dev/null
+++ b/src/Nes/APU/BusInterface.hs
@@ -0,0 +1,24 @@
+module Nes.APU.BusInterface (write4017) where
+
+import Control.Monad
+import Data.Bits
+import Nes.APU.Monad
+import Nes.APU.Monad.FrameCounter
+import Nes.APU.State
+import Nes.APU.State.FrameCounter
+import Nes.Memory (Byte)
+
+-- | Callback when a byte is written to 0x4017 through the Bus
+write4017 :: Byte -> APU r ()
+write4017 byte = do
+    let seqMode = sequenceModeFromBool $ byte `testBit` 7
+        inhibit = byte `testBit` 6
+    modifyAPUState $
+        modifyFrameCounter $
+            \fc -> fc{sequenceMode = seqMode, inhibitInterrupt = inhibit}
+    -- If the mode flag is set, then both "quarter frame" and "half frame" signals are also generated
+    when (seqMode == FiveStep) $ do
+        runQuarterFrameEvent
+        runHalfFrameEvent
+    when inhibit $ do
+        setFrameInterruptFlag False
diff --git a/src/Nes/APU/Monad/FrameCounter.hs b/src/Nes/APU/Monad/FrameCounter.hs
new file mode 100644
index 0000000..8a3dea4
--- /dev/null
+++ b/src/Nes/APU/Monad/FrameCounter.hs
@@ -0,0 +1,59 @@
+module Nes.APU.Monad.FrameCounter (
+    -- * Clocking
+    clockFrameCounter,
+
+    -- * Events
+    runQuarterFrameEvent,
+    runHalfFrameEvent,
+
+    -- * statful setters
+    setFrameInterruptFlag,
+) where
+
+import Control.Monad
+import Nes.APU.Monad
+import Nes.APU.State
+import Nes.APU.State.FrameCounter
+
+-- | Tells the frame counter to clock channels
+--
+-- Source: https://www.nesdev.org/wiki/APU_Frame_Counter
+clockFrameCounter :: APU r ()
+clockFrameCounter = do
+    seqMode <- withAPUState $ sequenceMode . frameCounter
+    case seqMode of
+        FourStep -> clockFrameCounterFourStep
+        FiveStep -> clockFrameCounterFiveStep
+    modifyAPUState $ modifyFrameCounter incrementSequenceStep
+
+clockFrameCounterFourStep :: APU r ()
+clockFrameCounterFourStep = do
+    step <- withAPUState $ sequenceStep . frameCounter
+    inhibitFrameInterrupt <- withAPUState $ inhibitInterrupt . frameCounter
+
+    when (step < 4) runHalfFrameEvent
+    when (step == 1 || step == 3) runHalfFrameEvent
+    when (step == 3 && not inhibitFrameInterrupt) $
+        setFrameInterruptFlag True
+
+clockFrameCounterFiveStep :: APU r ()
+clockFrameCounterFiveStep = do
+    step <- withAPUState $ sequenceStep . frameCounter
+    when (step < 5) runQuarterFrameEvent
+    when (step == 1 || step == 4) runHalfFrameEvent
+
+runQuarterFrameEvent :: APU r ()
+-- TODO clock all envelopes and triangle counter
+runQuarterFrameEvent = return ()
+
+runHalfFrameEvent :: APU r ()
+-- TODO clock all lengthcounters and sweep units
+runHalfFrameEvent = return ()
+
+-- | Set the Frame Counter's Frame flag
+setFrameInterruptFlag :: Bool -> APU r ()
+setFrameInterruptFlag b = do
+    -- TODO Connect to CPU 's IRQ
+    modifyAPUState $
+        modifyFrameCounter $
+            \fc -> fc{frameInterruptFlag = b}
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index 7ec070f..e7539d4 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -2,9 +2,14 @@ module Nes.APU.State (
     -- * Definition
     APUState (..),
     newAPUState,
+
+    -- * Setters
+    modifyFrameCounter,
 ) where
 
-data APUState = MkAPUState
+import Nes.APU.State.FrameCounter
+
+data APUState = MkAPUState {frameCounter :: FrameCounter}
 
 -- { pulse1 :: Pulse
 -- , pulse2 :: Pulse
@@ -17,7 +22,7 @@ data APUState = MkAPUState
 
 newAPUState :: APUState
 newAPUState =
-    MkAPUState
+    MkAPUState newFrameCounter
 
 -- { pulse1 = mkChannel 0 0 0 0
 -- , pulse2 = mkChannel 0 0 0 0
@@ -53,6 +58,6 @@ newAPUState =
 -- modifyStatus :: (StatusRegister -> StatusRegister) -> APUState -> APUState
 -- modifyStatus f st = st{status = f (status st)}
 --
--- {-# INLINE modifyFrameCounter #-}
--- modifyFrameCounter :: (FrameCounter -> FrameCounter) -> APUState -> APUState
--- modifyFrameCounter f st = st{frameCounter = f (frameCounter st)}
+{-# INLINE modifyFrameCounter #-}
+modifyFrameCounter :: (FrameCounter -> FrameCounter) -> APUState -> APUState
+modifyFrameCounter f st = st{frameCounter = f (frameCounter st)}
diff --git a/src/Nes/APU/State/FrameCounter.hs b/src/Nes/APU/State/FrameCounter.hs
new file mode 100644
index 0000000..4e00c4f
--- /dev/null
+++ b/src/Nes/APU/State/FrameCounter.hs
@@ -0,0 +1,41 @@
+module Nes.APU.State.FrameCounter (
+    FrameCounter (..),
+    newFrameCounter,
+
+    -- * Sequence mode
+    SequenceMode (..),
+    sequenceModeFromBool,
+
+    -- * Sequence step
+    incrementSequenceStep,
+) where
+
+data SequenceMode = FourStep | FiveStep deriving (Eq, Show, Enum)
+
+sequenceModeFromBool :: Bool -> SequenceMode
+sequenceModeFromBool = toEnum . fromEnum
+
+sequenceModeStepCount :: SequenceMode -> Int
+sequenceModeStepCount = \case
+    FourStep -> 4
+    FiveStep -> 5
+
+data FrameCounter = MkFC
+    { sequenceMode :: SequenceMode
+    , frameInterruptFlag :: Bool
+    , inhibitInterrupt :: Bool
+    , sequenceStep :: Int
+    }
+
+newFrameCounter :: FrameCounter
+newFrameCounter = MkFC FourStep False False 0
+
+-- | Increment 'sequenceStep', or set to zero when sequence ends
+incrementSequenceStep :: FrameCounter -> FrameCounter
+incrementSequenceStep fc =
+    fc
+        { sequenceStep = nextStep `mod` maxStep
+        }
+  where
+    nextStep = sequenceStep fc + 1
+    maxStep = sequenceModeStepCount (sequenceMode fc)
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index 0ea5431..e4cc753 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -8,6 +8,7 @@ module Nes.APU.Tick (
 
 import Control.Monad
 import Nes.APU.Monad
+import Nes.APU.Monad.FrameCounter (clockFrameCounter)
 
 -- $use
 --     The APU being a part of the CPU, they both tick at the same time. However, some clocks are updated every other CPU cycles.
@@ -27,5 +28,4 @@ tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
     -- TODO Ticks and clocks
     when isAPUCycle $ do
-        return () -- TODO Do things and stuff
-    return ()
+        clockFrameCounter
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index 7f6bf52..eca605a 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -9,6 +9,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Internal as BS
 import Data.Ix
 import Foreign
+import Nes.APU.BusInterface
 import Nes.APU.Monad
 import Nes.APU.State
 import qualified Nes.APU.Tick as APU
@@ -184,7 +185,8 @@ instance MemoryInterface () (BusM r) where
                 -- TODO 2) Not sure about about the tick count
                 tick (513 + fromEnum (odd cycles_))
             | idx == 0x4016 = withController $ setStrobe byte
-            | idx == 0x4017 = pure () -- Second joypad, ignore
+            -- APU
+            | idx == 0x4017 = withAPU $ write4017 byte
             | otherwise = pure () -- liftIO $ printf "Ignoring write at %4x\n" $ unAddr idx
     readAddr idx () = do
         low <- readByte idx ()

From 4e9e026fff102ec5d4dfa948953c8cc7e266e6e2 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 7 Nov 2025 11:21:16 +0000
Subject: [PATCH 03/37] APU: Define Length Counter

---
 funes.cabal                        |  1 +
 src/Nes/APU/BusInterface.hs        | 10 ++++
 src/Nes/APU/State/LengthCounter.hs | 81 ++++++++++++++++++++++++++++++
 3 files changed, 92 insertions(+)
 create mode 100644 src/Nes/APU/State/LengthCounter.hs

diff --git a/funes.cabal b/funes.cabal
index 036133a..4d7d641 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -29,6 +29,7 @@ library
       Nes.APU.Monad.FrameCounter
       Nes.APU.State
       Nes.APU.State.FrameCounter
+      Nes.APU.State.LengthCounter
       Nes.APU.Tick
       Nes.Bus
       Nes.Bus.Constants
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index f243c01..8fb5d90 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -22,3 +22,13 @@ write4017 byte = do
         runHalfFrameEvent
     when inhibit $ do
         setFrameInterruptFlag False
+
+write4015 :: Byte -> APU r ()
+write4015 byte = do
+    let enablePulse1Lc = byte `testBit` 0
+        enablePulse2Lc = byte `testBit` 1
+        enableTriangeLc = byte `testBit` 2
+        enableNoiseLc = byte `testBit` 3
+        enableDmc = byte `testBit` 4
+    -- TODO: For each LC: If enable is false, call 'clearRemainingLength'
+    return ()
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
new file mode 100644
index 0000000..a1e650b
--- /dev/null
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -0,0 +1,81 @@
+module Nes.APU.State.LengthCounter (
+    LengthCounter (..),
+    clockLengthCounter,
+    loadLengthCounter,
+    clearLength,
+
+    -- * Class
+    HasLengthCounter (..),
+    withLengthCounter,
+    isSilencedByLengthCounter,
+) where
+
+import Data.List ((!?))
+
+data LengthCounter = MkLC {remainingLength :: Int, isHalted :: Bool, tableIndex :: Int}
+
+clockLengthCounter :: LengthCounter -> LengthCounter
+clockLengthCounter lc =
+    if remainingLength lc > 0 && not (isHalted lc)
+        then lc{remainingLength = remainingLength lc - 1}
+        else lc
+
+-- | Set 'remainingLength' to 0
+clearLength :: LengthCounter -> LengthCounter
+clearLength lc = lc{remainingLength = 0}
+
+-- | Load Length using the argument a an index in the length table
+--
+-- Note: It must not be done when the enabled bit (4015) is clear
+loadLengthCounter :: Int -> LengthCounter -> LengthCounter
+loadLengthCounter idx lc = case lengthTable !? idx of
+    Just l -> lc{remainingLength = l, tableIndex = idx}
+    Nothing -> lc -- Index is invalid
+
+-- TODO When enabled bit is cleared (via $4015), set length counter to 0
+
+class HasLengthCounter a where
+    getLengthCounter :: a -> LengthCounter
+    setLengthCounter :: LengthCounter -> a -> a
+
+withLengthCounter :: (HasLengthCounter a) => (LengthCounter -> LengthCounter) -> a -> a
+withLengthCounter f a = setLengthCounter (f $ getLengthCounter a) a
+
+isSilencedByLengthCounter :: (HasLengthCounter a) => a -> Bool
+isSilencedByLengthCounter = (== 0) . remainingLength . getLengthCounter
+
+lengthTable :: [Int]
+lengthTable =
+    [ 10
+    , 254
+    , 20
+    , 2
+    , 40
+    , 4
+    , 80
+    , 6
+    , 160
+    , 8
+    , 60
+    , 10
+    , 14
+    , 12
+    , 26
+    , 14
+    , 12
+    , 16
+    , 24
+    , 18
+    , 48
+    , 20
+    , 96
+    , 22
+    , 192
+    , 24
+    , 72
+    , 26
+    , 16
+    , 28
+    , 32
+    , 30
+    ]

From 0ec74a67a56022bcd111b453e55a2166f4fc35fe Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 7 Nov 2025 14:30:14 +0000
Subject: [PATCH 04/37] APU: Add Pulse channels

---
 funes.cabal                        |  1 +
 src/Nes/APU/BusInterface.hs        | 95 +++++++++++++++++++++++++++++-
 src/Nes/APU/State.hs               | 27 +++++----
 src/Nes/APU/State/LengthCounter.hs |  4 ++
 src/Nes/APU/State/Pulse.hs         | 51 ++++++++++++++++
 src/Nes/APU/Tick.hs                |  4 ++
 6 files changed, 169 insertions(+), 13 deletions(-)
 create mode 100644 src/Nes/APU/State/Pulse.hs

diff --git a/funes.cabal b/funes.cabal
index 4d7d641..045e8a3 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -30,6 +30,7 @@ library
       Nes.APU.State
       Nes.APU.State.FrameCounter
       Nes.APU.State.LengthCounter
+      Nes.APU.State.Pulse
       Nes.APU.Tick
       Nes.Bus
       Nes.Bus.Constants
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index 8fb5d90..cb2f334 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -1,4 +1,22 @@
-module Nes.APU.BusInterface (write4017) where
+module Nes.APU.BusInterface (
+    -- * Pulse 1
+    write4000,
+    write4001,
+    write4002,
+    write4003,
+
+    -- * Pulse 2
+    write4004,
+    write4005,
+    write4006,
+    write4007,
+
+    -- * Status register
+    write4015,
+
+    -- * Frame counter
+    write4017,
+) where
 
 import Control.Monad
 import Data.Bits
@@ -6,7 +24,9 @@ import Nes.APU.Monad
 import Nes.APU.Monad.FrameCounter
 import Nes.APU.State
 import Nes.APU.State.FrameCounter
-import Nes.Memory (Byte)
+import Nes.APU.State.LengthCounter
+import Nes.APU.State.Pulse
+import Nes.Memory (Byte (..), byteToInt)
 
 -- | Callback when a byte is written to 0x4017 through the Bus
 write4017 :: Byte -> APU r ()
@@ -31,4 +51,73 @@ write4015 byte = do
         enableNoiseLc = byte `testBit` 3
         enableDmc = byte `testBit` 4
     -- TODO: For each LC: If enable is false, call 'clearRemainingLength'
-    return ()
+    unless enablePulse1Lc $
+        modifyAPUState $
+            modifyPulse1 $
+                withLengthCounter clockLengthCounter
+
+    unless enablePulse2Lc $
+        modifyAPUState $
+            modifyPulse2 $
+                withLengthCounter clockLengthCounter
+
+write4000 :: Byte -> APU r ()
+write4000 = writePulseFirstByte modifyPulse1
+
+write4004 :: Byte -> APU r ()
+write4004 = writePulseFirstByte modifyPulse2
+
+{-# INLINE writePulseFirstByte #-}
+writePulseFirstByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseFirstByte setter byte = do
+    let duty = byte `shiftR` 6
+        haltLC = byte `testBit` 5
+        constVol = byte `testBit` 4
+        vol = byte .&. 0b1111
+    modifyAPUState $ setter $ \p ->
+        withLengthCounter (\lc -> lc{isHalted = haltLC}) $
+            p
+                { dutyIndex = fromIntegral $ unByte duty
+                , volume = fromIntegral $ unByte vol
+                , volumeIsConstant = constVol
+                }
+
+write4001 :: Byte -> APU r ()
+write4001 = writePulseSecondByte modifyPulse1
+
+write4005 :: Byte -> APU r ()
+write4005 = writePulseSecondByte modifyPulse2
+
+{-# INLINE writePulseSecondByte #-}
+writePulseSecondByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseSecondByte setter byte = return () -- TODO Sweep Unit
+
+write4002 :: Byte -> APU r ()
+write4002 = writePulseThirdByte modifyPulse1
+
+write4006 :: Byte -> APU r ()
+write4006 = writePulseThirdByte modifyPulse2
+
+{-# INLINE writePulseThirdByte #-}
+writePulseThirdByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseThirdByte setter byte = modifyAPUState $ setter $ \p ->
+    let newPeriod = (period p .&. 0b11100000000) .|. byteToInt byte
+     in p{period = newPeriod}
+
+write4003 :: Byte -> APU r ()
+write4003 = writePulseFourByte modifyPulse1
+
+write4007 :: Byte -> APU r ()
+write4007 = writePulseFourByte modifyPulse2
+
+{-# INLINE writePulseFourByte #-}
+writePulseFourByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseFourByte setter byte = modifyAPUState $ setter $ \p ->
+    let newPeriod = ((byteToInt byte .&. 0b111) `shiftL` 8) .|. (period p .&. 0b11111111)
+        newLCLoad = byteToInt byte `shiftR` 3
+     in withLengthCounter
+            (loadLengthCounter newLCLoad)
+            p
+                { period = newPeriod
+                , dutyStep = 0 -- TODO Not sure
+                }
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index e7539d4..19a9fdc 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -5,11 +5,18 @@ module Nes.APU.State (
 
     -- * Setters
     modifyFrameCounter,
+    modifyPulse1,
+    modifyPulse2,
 ) where
 
 import Nes.APU.State.FrameCounter
+import Nes.APU.State.Pulse
 
-data APUState = MkAPUState {frameCounter :: FrameCounter}
+data APUState = MkAPUState
+    { frameCounter :: FrameCounter
+    , pulse1 :: Pulse
+    , pulse2 :: Pulse
+    }
 
 -- { pulse1 :: Pulse
 -- , pulse2 :: Pulse
@@ -22,7 +29,7 @@ data APUState = MkAPUState {frameCounter :: FrameCounter}
 
 newAPUState :: APUState
 newAPUState =
-    MkAPUState newFrameCounter
+    MkAPUState newFrameCounter newPulse newPulse
 
 -- { pulse1 = mkChannel 0 0 0 0
 -- , pulse2 = mkChannel 0 0 0 0
@@ -34,14 +41,14 @@ newAPUState =
 -- }
 -- mkChannel b1 b2 b3 b4 = fromChannel $ MkChannel b1 b2 b3 b4
 
--- {-# INLINE modifyPulse1 #-}
--- modifyPulse1 :: (Pulse -> Pulse) -> APUState -> APUState
--- modifyPulse1 f st = st{pulse1 = f (pulse1 st)}
---
--- {-# INLINE modifyPulse2 #-}
--- modifyPulse2 :: (Pulse -> Pulse) -> APUState -> APUState
--- modifyPulse2 f st = st{pulse2 = f (pulse2 st)}
---
+{-# INLINE modifyPulse1 #-}
+modifyPulse1 :: (Pulse -> Pulse) -> APUState -> APUState
+modifyPulse1 f st = st{pulse1 = f (pulse1 st)}
+
+{-# INLINE modifyPulse2 #-}
+modifyPulse2 :: (Pulse -> Pulse) -> APUState -> APUState
+modifyPulse2 f st = st{pulse2 = f (pulse2 st)}
+
 -- {-# INLINE modifyTriangle #-}
 -- modifyTriangle :: (Triangle -> Triangle) -> APUState -> APUState
 -- modifyTriangle f st = st{triangle = f (triangle st)}
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
index a1e650b..d455cc8 100644
--- a/src/Nes/APU/State/LengthCounter.hs
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -1,5 +1,6 @@
 module Nes.APU.State.LengthCounter (
     LengthCounter (..),
+    newLengthCounter,
     clockLengthCounter,
     loadLengthCounter,
     clearLength,
@@ -14,6 +15,9 @@ import Data.List ((!?))
 
 data LengthCounter = MkLC {remainingLength :: Int, isHalted :: Bool, tableIndex :: Int}
 
+newLengthCounter :: LengthCounter
+newLengthCounter = MkLC 0 False 0
+
 clockLengthCounter :: LengthCounter -> LengthCounter
 clockLengthCounter lc =
     if remainingLength lc > 0 && not (isHalted lc)
diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
new file mode 100644
index 0000000..deb659d
--- /dev/null
+++ b/src/Nes/APU/State/Pulse.hs
@@ -0,0 +1,51 @@
+module Nes.APU.State.Pulse (Pulse (..), newPulse, clockPulse, getOutput) where
+
+import Data.List ((!?))
+import Data.Maybe (fromMaybe)
+import Nes.APU.State.LengthCounter
+
+data Pulse = MkP
+    { dutyIndex :: Int
+    -- ^ Index for the 'dutySequences' table
+    , dutyStep :: Int
+    -- ^ Index for a row's element in the 'dutySequences' table
+    , lengthCounter :: LengthCounter
+    , period :: Int
+    -- ^ Max value of the timer
+    , timer :: Int
+    -- ^ Decreases each tick, from 'period' to 0 and loops
+    , volume :: Int
+    , volumeIsConstant :: Bool
+    }
+
+-- TODO Sweep unit
+
+newPulse :: Pulse
+newPulse = MkP 0 0 newLengthCounter 0 0 0 False
+
+clockPulse :: Pulse -> Pulse
+clockPulse p = p{dutyStep = newDutyStep, timer = newTimer}
+  where
+    newDutyStep = if timer p == 0 then (dutyStep p + 1) `mod` 8 else dutyStep p
+    newTimer = if timer p == 0 then period p else timer p - 1
+
+instance HasLengthCounter Pulse where
+    getLengthCounter = lengthCounter
+    setLengthCounter lc a = a{lengthCounter = lc}
+
+getOutput :: Pulse -> Int
+getOutput p =
+    let dutyValue = fromMaybe 0 ((dutySequences !? dutyIndex p) >>= (!? dutyStep p))
+        isSilenced = isSilencedByLengthCounter p || (period p < 8) || dutyValue == 0
+     in -- TODO return 0 if overflow from the sweep unit's adder is silencing the channel
+        if isSilenced
+            then 0
+            else volume p
+
+dutySequences :: [[Int]]
+dutySequences =
+    [ [0, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 1, 1, 0, 0, 0, 0, 0]
+    , [0, 1, 1, 1, 0, 0, 0, 0]
+    , [1, 0, 0, 1, 1, 1, 1, 1]
+    ]
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index e4cc753..ad5d36a 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -9,6 +9,8 @@ module Nes.APU.Tick (
 import Control.Monad
 import Nes.APU.Monad
 import Nes.APU.Monad.FrameCounter (clockFrameCounter)
+import Nes.APU.State (modifyPulse1, modifyPulse2)
+import Nes.APU.State.Pulse (clockPulse)
 
 -- $use
 --     The APU being a part of the CPU, they both tick at the same time. However, some clocks are updated every other CPU cycles.
@@ -28,4 +30,6 @@ tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
     -- TODO Ticks and clocks
     when isAPUCycle $ do
+        modifyAPUState $ modifyPulse1 clockPulse
+        modifyAPUState $ modifyPulse2 clockPulse
         clockFrameCounter

From 311a22ade9a4ccbfac37f744d2f52a345ffd3467 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 7 Nov 2025 18:02:24 +0000
Subject: [PATCH 05/37] APU: Add Sweep units

---
 src/Nes/APU/BusInterface.hs        | 51 +++++++++++-----
 src/Nes/APU/Monad/FrameCounter.hs  |  9 ++-
 src/Nes/APU/State.hs               |  2 +-
 src/Nes/APU/State/LengthCounter.hs |  6 +-
 src/Nes/APU/State/Pulse.hs         | 97 +++++++++++++++++++++++++++---
 5 files changed, 137 insertions(+), 28 deletions(-)

diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index cb2f334..71ad70c 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -54,12 +54,12 @@ write4015 byte = do
     unless enablePulse1Lc $
         modifyAPUState $
             modifyPulse1 $
-                withLengthCounter clockLengthCounter
+                withLengthCounter clearLengthCounter
 
     unless enablePulse2Lc $
         modifyAPUState $
             modifyPulse2 $
-                withLengthCounter clockLengthCounter
+                withLengthCounter clearLengthCounter
 
 write4000 :: Byte -> APU r ()
 write4000 = writePulseFirstByte modifyPulse1
@@ -90,7 +90,25 @@ write4005 = writePulseSecondByte modifyPulse2
 
 {-# INLINE writePulseSecondByte #-}
 writePulseSecondByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
-writePulseSecondByte setter byte = return () -- TODO Sweep Unit
+writePulseSecondByte setter byte = do
+    let enabledFlag = byte `testBit` 7
+        divPeriod = (byte `shiftR` 4) .&. 0b111
+        negateFlag = byte `testBit` 3
+        shiftC = byte .&. 0b111
+        sweepIsEnabled = enabledFlag && shiftC > 0
+    modifyAPUState $
+        setter $
+            updateTargetPeriod
+                . modifySweep
+                    ( \s ->
+                        s
+                            { reloadFlag = True
+                            , enabled = sweepIsEnabled
+                            , dividerPeriod = byteToInt divPeriod
+                            , negateDelta = negateFlag
+                            , shiftCount = byteToInt shiftC
+                            }
+                    )
 
 write4002 :: Byte -> APU r ()
 write4002 = writePulseThirdByte modifyPulse1
@@ -102,22 +120,25 @@ write4006 = writePulseThirdByte modifyPulse2
 writePulseThirdByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
 writePulseThirdByte setter byte = modifyAPUState $ setter $ \p ->
     let newPeriod = (period p .&. 0b11100000000) .|. byteToInt byte
-     in p{period = newPeriod}
+     in updateTargetPeriod $ p{period = newPeriod}
 
 write4003 :: Byte -> APU r ()
-write4003 = writePulseFourByte modifyPulse1
+write4003 = writePulseFourthByte modifyPulse1
 
 write4007 :: Byte -> APU r ()
-write4007 = writePulseFourByte modifyPulse2
+write4007 = writePulseFourthByte modifyPulse2
 
-{-# INLINE writePulseFourByte #-}
-writePulseFourByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
-writePulseFourByte setter byte = modifyAPUState $ setter $ \p ->
+{-# INLINE writePulseFourthByte #-}
+writePulseFourthByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseFourthByte setter byte = modifyAPUState $ setter $ \p ->
     let newPeriod = ((byteToInt byte .&. 0b111) `shiftL` 8) .|. (period p .&. 0b11111111)
         newLCLoad = byteToInt byte `shiftR` 3
-     in withLengthCounter
-            (loadLengthCounter newLCLoad)
-            p
-                { period = newPeriod
-                , dutyStep = 0 -- TODO Not sure
-                }
+     in updateTargetPeriod $
+            withLengthCounter
+                (loadLengthCounter newLCLoad)
+                p
+                    { period = newPeriod
+                    , dutyStep = 0
+                    -- TODO Not sure
+                    -- https://www.nesdev.org/wiki/APU_Pulse#Registers
+                    }
diff --git a/src/Nes/APU/Monad/FrameCounter.hs b/src/Nes/APU/Monad/FrameCounter.hs
index 8a3dea4..5459e19 100644
--- a/src/Nes/APU/Monad/FrameCounter.hs
+++ b/src/Nes/APU/Monad/FrameCounter.hs
@@ -14,6 +14,7 @@ import Control.Monad
 import Nes.APU.Monad
 import Nes.APU.State
 import Nes.APU.State.FrameCounter
+import Nes.APU.State.Pulse (clockSweepUnit)
 
 -- | Tells the frame counter to clock channels
 --
@@ -47,8 +48,12 @@ runQuarterFrameEvent :: APU r ()
 runQuarterFrameEvent = return ()
 
 runHalfFrameEvent :: APU r ()
--- TODO clock all lengthcounters and sweep units
-runHalfFrameEvent = return ()
+-- TODO clock all lengthcounters
+runHalfFrameEvent = modifyAPUState $ \st ->
+    st
+        { pulse1 = clockSweepUnit (pulse1 st)
+        , pulse2 = clockSweepUnit (pulse2 st)
+        }
 
 -- | Set the Frame Counter's Frame flag
 setFrameInterruptFlag :: Bool -> APU r ()
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index 19a9fdc..89a8efe 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -29,7 +29,7 @@ data APUState = MkAPUState
 
 newAPUState :: APUState
 newAPUState =
-    MkAPUState newFrameCounter newPulse newPulse
+    MkAPUState newFrameCounter (newPulse True) (newPulse False)
 
 -- { pulse1 = mkChannel 0 0 0 0
 -- , pulse2 = mkChannel 0 0 0 0
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
index d455cc8..7ff44ec 100644
--- a/src/Nes/APU/State/LengthCounter.hs
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -3,7 +3,7 @@ module Nes.APU.State.LengthCounter (
     newLengthCounter,
     clockLengthCounter,
     loadLengthCounter,
-    clearLength,
+    clearLengthCounter,
 
     -- * Class
     HasLengthCounter (..),
@@ -25,8 +25,8 @@ clockLengthCounter lc =
         else lc
 
 -- | Set 'remainingLength' to 0
-clearLength :: LengthCounter -> LengthCounter
-clearLength lc = lc{remainingLength = 0}
+clearLengthCounter :: LengthCounter -> LengthCounter
+clearLengthCounter lc = lc{remainingLength = 0}
 
 -- | Load Length using the argument a an index in the length table
 --
diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
index deb659d..b8c8f5b 100644
--- a/src/Nes/APU/State/Pulse.hs
+++ b/src/Nes/APU/State/Pulse.hs
@@ -1,5 +1,21 @@
-module Nes.APU.State.Pulse (Pulse (..), newPulse, clockPulse, getOutput) where
+module Nes.APU.State.Pulse (
+    -- * Pulse
+    Pulse (..),
+    newPulse,
+    clockPulse,
+    modifySweep,
+    withSweep,
 
+    -- * Sweep Unit
+    SweepUnit (..),
+    clockSweepUnit,
+    updateTargetPeriod,
+
+    -- * Output
+    getOutput,
+) where
+
+import Data.Bits
 import Data.List ((!?))
 import Data.Maybe (fromMaybe)
 import Nes.APU.State.LengthCounter
@@ -16,12 +32,48 @@ data Pulse = MkP
     -- ^ Decreases each tick, from 'period' to 0 and loops
     , volume :: Int
     , volumeIsConstant :: Bool
+    , sweepUnit :: SweepUnit
+    }
+
+-- | Args is true if building pulse 1
+newPulse :: Bool -> Pulse
+newPulse isPulseOne = MkP 0 0 newLengthCounter 0 0 0 False (MkSU False 0 0 False 0 0 False isPulseOne)
+
+--
+
+data SweepUnit = MkSU
+    { enabled :: Bool
+    , dividerPeriod :: Int
+    , dividerCounter :: Int
+    , negateDelta :: Bool
+    , targetPeriod :: Int
+    , shiftCount :: Int
+    , reloadFlag :: Bool
+    , isPulse1 :: Bool
     }
 
--- TODO Sweep unit
+modifySweep :: (SweepUnit -> SweepUnit) -> Pulse -> Pulse
+modifySweep f p = p{sweepUnit = f (sweepUnit p)}
+
+withSweep :: (SweepUnit -> a) -> Pulse -> a
+withSweep f p = f (sweepUnit p)
 
-newPulse :: Pulse
-newPulse = MkP 0 0 newLengthCounter 0 0 0 False
+-- | Update the target period in the Sweep unit of the pulse
+updateTargetPeriod :: Pulse -> Pulse
+updateTargetPeriod p =
+    modifySweep
+        ( \s ->
+            let
+                delta = period p `shiftR` shiftCount s
+             in
+                s
+                    { targetPeriod =
+                        if negateDelta s
+                            then period p - delta - fromEnum (isPulse1 s)
+                            else period p + delta
+                    }
+        )
+        p
 
 clockPulse :: Pulse -> Pulse
 clockPulse p = p{dutyStep = newDutyStep, timer = newTimer}
@@ -29,6 +81,33 @@ clockPulse p = p{dutyStep = newDutyStep, timer = newTimer}
     newDutyStep = if timer p == 0 then (dutyStep p + 1) `mod` 8 else dutyStep p
     newTimer = if timer p == 0 then period p else timer p - 1
 
+clockSweepUnit :: Pulse -> Pulse
+clockSweepUnit p = p2
+  where
+    sweep = sweepUnit p
+    p1 =
+        if dividerCounter sweep == 0 && enabled sweep && shiftCount sweep > 0
+            then
+                -- If sweep unit is not muting channel
+                if period p >= 8 && targetPeriod sweep <= 0x7ff
+                    then
+                        updateTargetPeriod $ p{period = targetPeriod sweep}
+                    else
+                        modifySweep
+                            (\s -> s{dividerCounter = dividerPeriod s})
+                            p
+            else p
+    p2 =
+        -- TODO Not sure if should use p1 or p2
+        if (reloadFlag . sweepUnit) p1 || (dividerCounter . sweepUnit) p1 == 0
+            then
+                modifySweep
+                    (\s -> s{dividerCounter = dividerPeriod s, reloadFlag = False})
+                    p1
+            else modifySweep (\s -> s{dividerCounter = dividerCounter s - 1}) p1
+
+--
+
 instance HasLengthCounter Pulse where
     getLengthCounter = lengthCounter
     setLengthCounter lc a = a{lengthCounter = lc}
@@ -36,9 +115,13 @@ instance HasLengthCounter Pulse where
 getOutput :: Pulse -> Int
 getOutput p =
     let dutyValue = fromMaybe 0 ((dutySequences !? dutyIndex p) >>= (!? dutyStep p))
-        isSilenced = isSilencedByLengthCounter p || (period p < 8) || dutyValue == 0
-     in -- TODO return 0 if overflow from the sweep unit's adder is silencing the channel
-        if isSilenced
+        periodOverflows = (targetPeriod . sweepUnit) p > 0x7ff
+        isSilenced =
+            isSilencedByLengthCounter p
+                || (period p < 8)
+                || dutyValue == 0
+                || periodOverflows
+     in if isSilenced
             then 0
             else volume p
 

From 1a2395e4fa4b039b0182ff4bcc2f12f0f8588e20 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 7 Nov 2025 20:43:51 +0000
Subject: [PATCH 06/37] APU: Add Envelope for Pulse

---
 funes.cabal                        |  1 +
 src/Nes/APU/BusInterface.hs        | 10 +++---
 src/Nes/APU/Monad/FrameCounter.hs  |  6 +++-
 src/Nes/APU/State/Envelope.hs      | 57 ++++++++++++++++++++++++++++++
 src/Nes/APU/State/LengthCounter.hs |  2 --
 src/Nes/APU/State/Pulse.hs         | 28 +++++++++++----
 6 files changed, 88 insertions(+), 16 deletions(-)
 create mode 100644 src/Nes/APU/State/Envelope.hs

diff --git a/funes.cabal b/funes.cabal
index 045e8a3..93f032f 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -28,6 +28,7 @@ library
       Nes.APU.Monad
       Nes.APU.Monad.FrameCounter
       Nes.APU.State
+      Nes.APU.State.Envelope
       Nes.APU.State.FrameCounter
       Nes.APU.State.LengthCounter
       Nes.APU.State.Pulse
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index 71ad70c..c77996d 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -23,6 +23,7 @@ import Data.Bits
 import Nes.APU.Monad
 import Nes.APU.Monad.FrameCounter
 import Nes.APU.State
+import Nes.APU.State.Envelope (Envelope (constantVolume, loopFlag, useConstantVolume), withEnvelope)
 import Nes.APU.State.FrameCounter
 import Nes.APU.State.LengthCounter
 import Nes.APU.State.Pulse
@@ -75,12 +76,9 @@ writePulseFirstByte setter byte = do
         constVol = byte `testBit` 4
         vol = byte .&. 0b1111
     modifyAPUState $ setter $ \p ->
-        withLengthCounter (\lc -> lc{isHalted = haltLC}) $
-            p
-                { dutyIndex = fromIntegral $ unByte duty
-                , volume = fromIntegral $ unByte vol
-                , volumeIsConstant = constVol
-                }
+        withEnvelope (\e -> e{constantVolume = fromIntegral $ unByte vol, useConstantVolume = constVol, loopFlag = haltLC}) $
+            withLengthCounter (\lc -> lc{isHalted = haltLC}) $
+                p{dutyIndex = fromIntegral $ unByte duty}
 
 write4001 :: Byte -> APU r ()
 write4001 = writePulseSecondByte modifyPulse1
diff --git a/src/Nes/APU/Monad/FrameCounter.hs b/src/Nes/APU/Monad/FrameCounter.hs
index 5459e19..970d5c4 100644
--- a/src/Nes/APU/Monad/FrameCounter.hs
+++ b/src/Nes/APU/Monad/FrameCounter.hs
@@ -13,6 +13,7 @@ module Nes.APU.Monad.FrameCounter (
 import Control.Monad
 import Nes.APU.Monad
 import Nes.APU.State
+import Nes.APU.State.Envelope (clockEnvelope, withEnvelope)
 import Nes.APU.State.FrameCounter
 import Nes.APU.State.Pulse (clockSweepUnit)
 
@@ -45,7 +46,10 @@ clockFrameCounterFiveStep = do
 
 runQuarterFrameEvent :: APU r ()
 -- TODO clock all envelopes and triangle counter
-runQuarterFrameEvent = return ()
+runQuarterFrameEvent = do
+    modifyAPUState $
+        modifyPulse1 (withEnvelope clockEnvelope)
+            . modifyPulse2 (withEnvelope clockEnvelope)
 
 runHalfFrameEvent :: APU r ()
 -- TODO clock all lengthcounters
diff --git a/src/Nes/APU/State/Envelope.hs b/src/Nes/APU/State/Envelope.hs
new file mode 100644
index 0000000..551dd69
--- /dev/null
+++ b/src/Nes/APU/State/Envelope.hs
@@ -0,0 +1,57 @@
+module Nes.APU.State.Envelope (
+    -- * Type
+    Envelope (..),
+    newEnvelope,
+
+    -- * Type class
+    HasEnvelope (..),
+    withEnvelope,
+
+    -- * Clock
+    clockEnvelope,
+
+    -- * Output
+    getEnvelopeOutput,
+) where
+
+data Envelope = MkE
+    { startFlag :: Bool
+    , useConstantVolume :: Bool
+    , constantVolume :: Int
+    , decayLevel :: Int
+    , divider :: Int
+    , loopFlag :: Bool
+    }
+
+newEnvelope :: Envelope
+newEnvelope = MkE False False 0 0 0 False
+
+class HasEnvelope a where
+    getEnvelope :: a -> Envelope
+    setEnvelope :: Envelope -> a -> a
+
+withEnvelope :: (HasEnvelope a) => (Envelope -> Envelope) -> a -> a
+withEnvelope f a = setEnvelope (f $ getEnvelope a) a
+
+clockEnvelope :: Envelope -> Envelope
+clockEnvelope e =
+    if startFlag e
+        then e{startFlag = False, decayLevel = 15, divider = constantVolume e}
+        else clockDivider e
+
+clockDivider :: Envelope -> Envelope
+clockDivider e =
+    if divider e == 0
+        then e{divider = constantVolume e, decayLevel = newDecay}
+        else e{divider = divider e - 1}
+  where
+    newDecay =
+        if decayLevel e == 0
+            then if loopFlag e then 15 else 0
+            else decayLevel e - 1
+
+getEnvelopeOutput :: Envelope -> Int
+getEnvelopeOutput e =
+    if useConstantVolume e
+        then constantVolume e
+        else decayLevel e
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
index 7ff44ec..d33eaa3 100644
--- a/src/Nes/APU/State/LengthCounter.hs
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -36,8 +36,6 @@ loadLengthCounter idx lc = case lengthTable !? idx of
     Just l -> lc{remainingLength = l, tableIndex = idx}
     Nothing -> lc -- Index is invalid
 
--- TODO When enabled bit is cleared (via $4015), set length counter to 0
-
 class HasLengthCounter a where
     getLengthCounter :: a -> LengthCounter
     setLengthCounter :: LengthCounter -> a -> a
diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
index b8c8f5b..bd726cb 100644
--- a/src/Nes/APU/State/Pulse.hs
+++ b/src/Nes/APU/State/Pulse.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module Nes.APU.State.Pulse (
     -- * Pulse
     Pulse (..),
@@ -12,12 +14,13 @@ module Nes.APU.State.Pulse (
     updateTargetPeriod,
 
     -- * Output
-    getOutput,
+    getPulseOutput,
 ) where
 
 import Data.Bits
 import Data.List ((!?))
 import Data.Maybe (fromMaybe)
+import Nes.APU.State.Envelope
 import Nes.APU.State.LengthCounter
 
 data Pulse = MkP
@@ -30,14 +33,21 @@ data Pulse = MkP
     -- ^ Max value of the timer
     , timer :: Int
     -- ^ Decreases each tick, from 'period' to 0 and loops
-    , volume :: Int
-    , volumeIsConstant :: Bool
     , sweepUnit :: SweepUnit
+    , envelope :: Envelope
     }
 
 -- | Args is true if building pulse 1
 newPulse :: Bool -> Pulse
-newPulse isPulseOne = MkP 0 0 newLengthCounter 0 0 0 False (MkSU False 0 0 False 0 0 False isPulseOne)
+newPulse isPulseOne = MkP{..}
+  where
+    dutyIndex = 0
+    dutyStep = 0
+    lengthCounter = newLengthCounter
+    period = 0
+    timer = 0
+    sweepUnit = MkSU False 0 0 False 0 0 False isPulseOne
+    envelope = newEnvelope
 
 --
 
@@ -112,8 +122,12 @@ instance HasLengthCounter Pulse where
     getLengthCounter = lengthCounter
     setLengthCounter lc a = a{lengthCounter = lc}
 
-getOutput :: Pulse -> Int
-getOutput p =
+instance HasEnvelope Pulse where
+    getEnvelope = envelope
+    setEnvelope e a = a{envelope = e}
+
+getPulseOutput :: Pulse -> Int
+getPulseOutput p =
     let dutyValue = fromMaybe 0 ((dutySequences !? dutyIndex p) >>= (!? dutyStep p))
         periodOverflows = (targetPeriod . sweepUnit) p > 0x7ff
         isSilenced =
@@ -123,7 +137,7 @@ getOutput p =
                 || periodOverflows
      in if isSilenced
             then 0
-            else volume p
+            else getEnvelopeOutput (envelope p)
 
 dutySequences :: [[Int]]
 dutySequences =

From 86b025415b2635aff044b56454e76f8dd81f083b Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Sat, 8 Nov 2025 11:02:13 +0000
Subject: [PATCH 07/37] APU: Add Triangle

---
 funes.cabal                       |  1 +
 src/Nes/APU/BusInterface.hs       | 54 ++++++++++++++++++++---
 src/Nes/APU/Monad/FrameCounter.hs |  8 +++-
 src/Nes/APU/State.hs              | 13 +++---
 src/Nes/APU/State/Triangle.hs     | 71 +++++++++++++++++++++++++++++++
 src/Nes/APU/Tick.hs               |  9 ++--
 6 files changed, 139 insertions(+), 17 deletions(-)
 create mode 100644 src/Nes/APU/State/Triangle.hs

diff --git a/funes.cabal b/funes.cabal
index 93f032f..a86b09c 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -32,6 +32,7 @@ library
       Nes.APU.State.FrameCounter
       Nes.APU.State.LengthCounter
       Nes.APU.State.Pulse
+      Nes.APU.State.Triangle
       Nes.APU.Tick
       Nes.Bus
       Nes.Bus.Constants
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index c77996d..ba1107c 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -11,6 +11,11 @@ module Nes.APU.BusInterface (
     write4006,
     write4007,
 
+    -- * Triangle
+    write4008,
+    write400A,
+    write400B,
+
     -- * Status register
     write4015,
 
@@ -23,10 +28,13 @@ import Data.Bits
 import Nes.APU.Monad
 import Nes.APU.Monad.FrameCounter
 import Nes.APU.State
-import Nes.APU.State.Envelope (Envelope (constantVolume, loopFlag, useConstantVolume), withEnvelope)
+import Nes.APU.State.Envelope
 import Nes.APU.State.FrameCounter
 import Nes.APU.State.LengthCounter
 import Nes.APU.State.Pulse
+import qualified Nes.APU.State.Pulse as Pulse
+import Nes.APU.State.Triangle
+import qualified Nes.APU.State.Triangle as Triangle
 import Nes.Memory (Byte (..), byteToInt)
 
 -- | Callback when a byte is written to 0x4017 through the Bus
@@ -48,7 +56,7 @@ write4015 :: Byte -> APU r ()
 write4015 byte = do
     let enablePulse1Lc = byte `testBit` 0
         enablePulse2Lc = byte `testBit` 1
-        enableTriangeLc = byte `testBit` 2
+        enableTriangleLc = byte `testBit` 2
         enableNoiseLc = byte `testBit` 3
         enableDmc = byte `testBit` 4
     -- TODO: For each LC: If enable is false, call 'clearRemainingLength'
@@ -62,6 +70,11 @@ write4015 byte = do
             modifyPulse2 $
                 withLengthCounter clearLengthCounter
 
+    unless enableTriangleLc $
+        modifyAPUState $
+            modifyTriangle $
+                withLengthCounter clearLengthCounter
+
 write4000 :: Byte -> APU r ()
 write4000 = writePulseFirstByte modifyPulse1
 
@@ -100,7 +113,7 @@ writePulseSecondByte setter byte = do
                 . modifySweep
                     ( \s ->
                         s
-                            { reloadFlag = True
+                            { Pulse.reloadFlag = True
                             , enabled = sweepIsEnabled
                             , dividerPeriod = byteToInt divPeriod
                             , negateDelta = negateFlag
@@ -117,8 +130,8 @@ write4006 = writePulseThirdByte modifyPulse2
 {-# INLINE writePulseThirdByte #-}
 writePulseThirdByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
 writePulseThirdByte setter byte = modifyAPUState $ setter $ \p ->
-    let newPeriod = (period p .&. 0b11100000000) .|. byteToInt byte
-     in updateTargetPeriod $ p{period = newPeriod}
+    let newPeriod = (Pulse.period p .&. 0b11100000000) .|. byteToInt byte
+     in updateTargetPeriod $ p{Pulse.period = newPeriod}
 
 write4003 :: Byte -> APU r ()
 write4003 = writePulseFourthByte modifyPulse1
@@ -129,14 +142,41 @@ write4007 = writePulseFourthByte modifyPulse2
 {-# INLINE writePulseFourthByte #-}
 writePulseFourthByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
 writePulseFourthByte setter byte = modifyAPUState $ setter $ \p ->
-    let newPeriod = ((byteToInt byte .&. 0b111) `shiftL` 8) .|. (period p .&. 0b11111111)
+    let newPeriod = ((byteToInt byte .&. 0b111) `shiftL` 8) .|. (Pulse.period p .&. 0b11111111)
         newLCLoad = byteToInt byte `shiftR` 3
      in updateTargetPeriod $
             withLengthCounter
                 (loadLengthCounter newLCLoad)
                 p
-                    { period = newPeriod
+                    { Pulse.period = newPeriod
                     , dutyStep = 0
                     -- TODO Not sure
                     -- https://www.nesdev.org/wiki/APU_Pulse#Registers
                     }
+
+--
+
+write4008 :: Byte -> APU r ()
+write4008 byte = do
+    let control = byte `testBit` 7
+        reload = byteToInt $ byte `clearBit` 7
+    modifyAPUState $
+        modifyTriangle $
+            withLengthCounter (\lc -> lc{isHalted = control})
+                . \t -> t{controlFlag = control, reloadValue = reload}
+
+write400A :: Byte -> APU r ()
+write400A periodLow = modifyAPUState $ modifyTriangle $ \t ->
+    let newPeriod = (Triangle.period t .&. 0b11100000000) .|. byteToInt periodLow
+     in t{Triangle.period = newPeriod}
+
+write400B :: Byte -> APU r ()
+write400B byte = modifyAPUState $ modifyTriangle $ \t ->
+    let timerHigh = byteToInt $ byte .&. 0b111
+        newPeriod = (timerHigh `shiftL` 8) .|. (Triangle.period t .&. 0b11111111)
+        newLcLoad = byteToInt byte `shiftR` 3
+     in withLengthCounter (loadLengthCounter newLcLoad) $
+            t
+                { Triangle.reloadFlag = True
+                , Triangle.period = newPeriod
+                }
diff --git a/src/Nes/APU/Monad/FrameCounter.hs b/src/Nes/APU/Monad/FrameCounter.hs
index 970d5c4..73e4c3f 100644
--- a/src/Nes/APU/Monad/FrameCounter.hs
+++ b/src/Nes/APU/Monad/FrameCounter.hs
@@ -15,7 +15,9 @@ import Nes.APU.Monad
 import Nes.APU.State
 import Nes.APU.State.Envelope (clockEnvelope, withEnvelope)
 import Nes.APU.State.FrameCounter
+import Nes.APU.State.LengthCounter (clockLengthCounter, withLengthCounter)
 import Nes.APU.State.Pulse (clockSweepUnit)
+import Nes.APU.State.Triangle (clockTriangleLinearCounter)
 
 -- | Tells the frame counter to clock channels
 --
@@ -50,13 +52,15 @@ runQuarterFrameEvent = do
     modifyAPUState $
         modifyPulse1 (withEnvelope clockEnvelope)
             . modifyPulse2 (withEnvelope clockEnvelope)
+            . modifyTriangle clockTriangleLinearCounter
 
 runHalfFrameEvent :: APU r ()
 -- TODO clock all lengthcounters
 runHalfFrameEvent = modifyAPUState $ \st ->
     st
-        { pulse1 = clockSweepUnit (pulse1 st)
-        , pulse2 = clockSweepUnit (pulse2 st)
+        { pulse1 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse1 st)
+        , pulse2 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse2 st)
+        , triangle = withLengthCounter clockLengthCounter $ triangle st
         }
 
 -- | Set the Frame Counter's Frame flag
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index 89a8efe..66c7fe4 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -7,15 +7,18 @@ module Nes.APU.State (
     modifyFrameCounter,
     modifyPulse1,
     modifyPulse2,
+    modifyTriangle,
 ) where
 
 import Nes.APU.State.FrameCounter
 import Nes.APU.State.Pulse
+import Nes.APU.State.Triangle
 
 data APUState = MkAPUState
     { frameCounter :: FrameCounter
     , pulse1 :: Pulse
     , pulse2 :: Pulse
+    , triangle :: Triangle
     }
 
 -- { pulse1 :: Pulse
@@ -29,7 +32,7 @@ data APUState = MkAPUState
 
 newAPUState :: APUState
 newAPUState =
-    MkAPUState newFrameCounter (newPulse True) (newPulse False)
+    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle
 
 -- { pulse1 = mkChannel 0 0 0 0
 -- , pulse2 = mkChannel 0 0 0 0
@@ -49,10 +52,10 @@ modifyPulse1 f st = st{pulse1 = f (pulse1 st)}
 modifyPulse2 :: (Pulse -> Pulse) -> APUState -> APUState
 modifyPulse2 f st = st{pulse2 = f (pulse2 st)}
 
--- {-# INLINE modifyTriangle #-}
--- modifyTriangle :: (Triangle -> Triangle) -> APUState -> APUState
--- modifyTriangle f st = st{triangle = f (triangle st)}
---
+{-# INLINE modifyTriangle #-}
+modifyTriangle :: (Triangle -> Triangle) -> APUState -> APUState
+modifyTriangle f st = st{triangle = f (triangle st)}
+
 -- {-# INLINE modifyNoise #-}
 -- modifyNoise :: (Noise -> Noise) -> APUState -> APUState
 -- modifyNoise f st = st{noise = f (noise st)}
diff --git a/src/Nes/APU/State/Triangle.hs b/src/Nes/APU/State/Triangle.hs
new file mode 100644
index 0000000..e68b7ec
--- /dev/null
+++ b/src/Nes/APU/State/Triangle.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Nes.APU.State.Triangle (
+    -- * Definition
+    Triangle (..),
+    newTriangle,
+
+    -- * Output
+    getTriangleOutput,
+
+    -- * Clock
+    clockTriangle,
+    clockTriangleLinearCounter,
+) where
+
+import Nes.APU.State.LengthCounter
+
+data Triangle = MkT
+    { controlFlag :: Bool
+    , reloadFlag :: Bool
+    , reloadValue :: Int
+    , lengthCounter :: LengthCounter
+    , linearCounter :: Int
+    , period :: Int
+    , timer :: Int
+    , sequenceStep :: Int
+    }
+
+newTriangle :: Triangle
+newTriangle = MkT{..}
+  where
+    controlFlag = False
+    reloadFlag = False
+    reloadValue = 0
+    lengthCounter = newLengthCounter
+    period = 0
+    linearCounter = 0
+    sequenceStep = 0
+    timer = 0
+
+{-# INLINE getSequenceValue #-}
+getSequenceValue :: Triangle -> Int
+getSequenceValue t = if step <= 15 then 15 - step else step - 16
+  where
+    step = sequenceStep t
+
+getTriangleOutput :: Triangle -> Int
+getTriangleOutput t = if remainingLength (lengthCounter t) /= 0 then getSequenceValue t else 0
+
+instance HasLengthCounter Triangle where
+    getLengthCounter = lengthCounter
+    setLengthCounter lc t = t{lengthCounter = lc}
+
+clockTriangle :: Triangle -> Triangle
+clockTriangle t = t{timer = newTimer, sequenceStep = newSequenceStep}
+  where
+    newTimer = if timer t == 0 then period t else timer t - 1
+    clockSequence = timer t == 0 && linearCounter t /= 0 && remainingLength (lengthCounter t) /= 0
+    newSequenceStep = if clockSequence then (sequenceStep t + 1) `mod` 32 else sequenceStep t
+
+clockTriangleLinearCounter :: Triangle -> Triangle
+clockTriangleLinearCounter t = t2
+  where
+    t1 =
+        if reloadFlag t
+            then t{linearCounter = reloadValue t}
+            else t{linearCounter = max 0 (linearCounter t - 1)}
+    t2 =
+        if not $ controlFlag t1
+            then t1{reloadFlag = False}
+            else t1
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index ad5d36a..b054ed5 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -9,8 +9,9 @@ module Nes.APU.Tick (
 import Control.Monad
 import Nes.APU.Monad
 import Nes.APU.Monad.FrameCounter (clockFrameCounter)
-import Nes.APU.State (modifyPulse1, modifyPulse2)
+import Nes.APU.State (modifyPulse1, modifyPulse2, modifyTriangle)
 import Nes.APU.State.Pulse (clockPulse)
+import Nes.APU.State.Triangle (clockTriangle)
 
 -- $use
 --     The APU being a part of the CPU, they both tick at the same time. However, some clocks are updated every other CPU cycles.
@@ -29,7 +30,9 @@ tick b n = tickOnce b >> tick (not b) (n - 1)
 tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
     -- TODO Ticks and clocks
+    modifyAPUState $ modifyTriangle clockTriangle
     when isAPUCycle $ do
-        modifyAPUState $ modifyPulse1 clockPulse
-        modifyAPUState $ modifyPulse2 clockPulse
+        modifyAPUState $
+            modifyPulse1 clockPulse
+                . modifyPulse2 clockPulse
         clockFrameCounter

From 1203caa4cee7b3dbdb7fd5e891dacb77e1ddc70e Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Sat, 8 Nov 2025 12:49:25 +0000
Subject: [PATCH 08/37] APU: Merge APU.Monad.FrameCounter with APU.Tick

---
 funes.cabal                       |  1 -
 src/Nes/APU/BusInterface.hs       |  2 +-
 src/Nes/APU/Monad/FrameCounter.hs | 72 -------------------------------
 src/Nes/APU/Tick.hs               | 71 +++++++++++++++++++++++++++---
 4 files changed, 67 insertions(+), 79 deletions(-)
 delete mode 100644 src/Nes/APU/Monad/FrameCounter.hs

diff --git a/funes.cabal b/funes.cabal
index a86b09c..239a136 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -26,7 +26,6 @@ library
   exposed-modules:
       Nes.APU.BusInterface
       Nes.APU.Monad
-      Nes.APU.Monad.FrameCounter
       Nes.APU.State
       Nes.APU.State.Envelope
       Nes.APU.State.FrameCounter
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index ba1107c..4adeb58 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -26,7 +26,6 @@ module Nes.APU.BusInterface (
 import Control.Monad
 import Data.Bits
 import Nes.APU.Monad
-import Nes.APU.Monad.FrameCounter
 import Nes.APU.State
 import Nes.APU.State.Envelope
 import Nes.APU.State.FrameCounter
@@ -35,6 +34,7 @@ import Nes.APU.State.Pulse
 import qualified Nes.APU.State.Pulse as Pulse
 import Nes.APU.State.Triangle
 import qualified Nes.APU.State.Triangle as Triangle
+import Nes.APU.Tick
 import Nes.Memory (Byte (..), byteToInt)
 
 -- | Callback when a byte is written to 0x4017 through the Bus
diff --git a/src/Nes/APU/Monad/FrameCounter.hs b/src/Nes/APU/Monad/FrameCounter.hs
deleted file mode 100644
index 73e4c3f..0000000
--- a/src/Nes/APU/Monad/FrameCounter.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-module Nes.APU.Monad.FrameCounter (
-    -- * Clocking
-    clockFrameCounter,
-
-    -- * Events
-    runQuarterFrameEvent,
-    runHalfFrameEvent,
-
-    -- * statful setters
-    setFrameInterruptFlag,
-) where
-
-import Control.Monad
-import Nes.APU.Monad
-import Nes.APU.State
-import Nes.APU.State.Envelope (clockEnvelope, withEnvelope)
-import Nes.APU.State.FrameCounter
-import Nes.APU.State.LengthCounter (clockLengthCounter, withLengthCounter)
-import Nes.APU.State.Pulse (clockSweepUnit)
-import Nes.APU.State.Triangle (clockTriangleLinearCounter)
-
--- | Tells the frame counter to clock channels
---
--- Source: https://www.nesdev.org/wiki/APU_Frame_Counter
-clockFrameCounter :: APU r ()
-clockFrameCounter = do
-    seqMode <- withAPUState $ sequenceMode . frameCounter
-    case seqMode of
-        FourStep -> clockFrameCounterFourStep
-        FiveStep -> clockFrameCounterFiveStep
-    modifyAPUState $ modifyFrameCounter incrementSequenceStep
-
-clockFrameCounterFourStep :: APU r ()
-clockFrameCounterFourStep = do
-    step <- withAPUState $ sequenceStep . frameCounter
-    inhibitFrameInterrupt <- withAPUState $ inhibitInterrupt . frameCounter
-
-    when (step < 4) runHalfFrameEvent
-    when (step == 1 || step == 3) runHalfFrameEvent
-    when (step == 3 && not inhibitFrameInterrupt) $
-        setFrameInterruptFlag True
-
-clockFrameCounterFiveStep :: APU r ()
-clockFrameCounterFiveStep = do
-    step <- withAPUState $ sequenceStep . frameCounter
-    when (step < 5) runQuarterFrameEvent
-    when (step == 1 || step == 4) runHalfFrameEvent
-
-runQuarterFrameEvent :: APU r ()
--- TODO clock all envelopes and triangle counter
-runQuarterFrameEvent = do
-    modifyAPUState $
-        modifyPulse1 (withEnvelope clockEnvelope)
-            . modifyPulse2 (withEnvelope clockEnvelope)
-            . modifyTriangle clockTriangleLinearCounter
-
-runHalfFrameEvent :: APU r ()
--- TODO clock all lengthcounters
-runHalfFrameEvent = modifyAPUState $ \st ->
-    st
-        { pulse1 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse1 st)
-        , pulse2 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse2 st)
-        , triangle = withLengthCounter clockLengthCounter $ triangle st
-        }
-
--- | Set the Frame Counter's Frame flag
-setFrameInterruptFlag :: Bool -> APU r ()
-setFrameInterruptFlag b = do
-    -- TODO Connect to CPU 's IRQ
-    modifyAPUState $
-        modifyFrameCounter $
-            \fc -> fc{frameInterruptFlag = b}
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index b054ed5..a32cbfd 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -1,17 +1,26 @@
 module Nes.APU.Tick (
-    -- * Semantic of a tick
+    -- * Ticking
     -- $semantic
     tick,
     tickOnce,
     IsAPUCycle,
+
+    -- * Internal clocking
+    clockFrameCounter,
+    runHalfFrameEvent,
+    runQuarterFrameEvent,
+    setFrameInterruptFlag,
 ) where
 
 import Control.Monad
 import Nes.APU.Monad
-import Nes.APU.Monad.FrameCounter (clockFrameCounter)
-import Nes.APU.State (modifyPulse1, modifyPulse2, modifyTriangle)
-import Nes.APU.State.Pulse (clockPulse)
-import Nes.APU.State.Triangle (clockTriangle)
+import Nes.APU.State
+import Nes.APU.State.Envelope
+import Nes.APU.State.FrameCounter
+import qualified Nes.APU.State.FrameCounter as FC
+import Nes.APU.State.LengthCounter
+import Nes.APU.State.Pulse
+import Nes.APU.State.Triangle
 
 -- $use
 --     The APU being a part of the CPU, they both tick at the same time. However, some clocks are updated every other CPU cycles.
@@ -36,3 +45,55 @@ tickOnce isAPUCycle = do
             modifyPulse1 clockPulse
                 . modifyPulse2 clockPulse
         clockFrameCounter
+
+-- | Tells the frame counter to clock channels
+--
+-- Source: https://www.nesdev.org/wiki/APU_Frame_Counter
+clockFrameCounter :: APU r ()
+clockFrameCounter = do
+    seqMode <- withAPUState $ sequenceMode . frameCounter
+    case seqMode of
+        FourStep -> clockFrameCounterFourStep
+        FiveStep -> clockFrameCounterFiveStep
+    modifyAPUState $ modifyFrameCounter incrementSequenceStep
+
+clockFrameCounterFourStep :: APU r ()
+clockFrameCounterFourStep = do
+    step <- withAPUState $ FC.sequenceStep . frameCounter
+    inhibitFrameInterrupt <- withAPUState $ inhibitInterrupt . frameCounter
+
+    when (step < 4) runHalfFrameEvent
+    when (step == 1 || step == 3) runHalfFrameEvent
+    when (step == 3 && not inhibitFrameInterrupt) $
+        setFrameInterruptFlag True
+
+clockFrameCounterFiveStep :: APU r ()
+clockFrameCounterFiveStep = do
+    step <- withAPUState $ FC.sequenceStep . frameCounter
+    when (step < 5) runQuarterFrameEvent
+    when (step == 1 || step == 4) runHalfFrameEvent
+
+runQuarterFrameEvent :: APU r ()
+-- TODO clock all envelopes and triangle counter
+runQuarterFrameEvent = do
+    modifyAPUState $
+        modifyPulse1 (withEnvelope clockEnvelope)
+            . modifyPulse2 (withEnvelope clockEnvelope)
+            . modifyTriangle clockTriangleLinearCounter
+
+runHalfFrameEvent :: APU r ()
+-- TODO clock all lengthcounters
+runHalfFrameEvent = modifyAPUState $ \st ->
+    st
+        { pulse1 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse1 st)
+        , pulse2 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse2 st)
+        , triangle = withLengthCounter clockLengthCounter $ triangle st
+        }
+
+-- | Set the Frame Counter's Frame flag
+setFrameInterruptFlag :: Bool -> APU r ()
+setFrameInterruptFlag b = do
+    -- TODO Connect to CPU 's IRQ
+    modifyAPUState $
+        modifyFrameCounter $
+            \fc -> fc{frameInterruptFlag = b}

From 277dc4455389eb9666b60bc7a506e21fe7e037be Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Sat, 8 Nov 2025 13:04:47 +0000
Subject: [PATCH 09/37] APU: Split bus interface into files

---
 funes.cabal                              |   4 +
 src/Nes/APU/BusInterface.hs              | 207 ++++-------------------
 src/Nes/APU/BusInterface/FrameCounter.hs |  24 +++
 src/Nes/APU/BusInterface/Pulse.hs        | 102 +++++++++++
 src/Nes/APU/BusInterface/Status.hs       |  31 ++++
 src/Nes/APU/BusInterface/Triangle.hs     |  38 +++++
 src/Nes/Bus/Monad.hs                     |   3 +-
 7 files changed, 229 insertions(+), 180 deletions(-)
 create mode 100644 src/Nes/APU/BusInterface/FrameCounter.hs
 create mode 100644 src/Nes/APU/BusInterface/Pulse.hs
 create mode 100644 src/Nes/APU/BusInterface/Status.hs
 create mode 100644 src/Nes/APU/BusInterface/Triangle.hs

diff --git a/funes.cabal b/funes.cabal
index 239a136..5839da7 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -25,6 +25,10 @@ source-repository head
 library
   exposed-modules:
       Nes.APU.BusInterface
+      Nes.APU.BusInterface.FrameCounter
+      Nes.APU.BusInterface.Pulse
+      Nes.APU.BusInterface.Status
+      Nes.APU.BusInterface.Triangle
       Nes.APU.Monad
       Nes.APU.State
       Nes.APU.State.Envelope
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index 4adeb58..1a662f0 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -1,182 +1,33 @@
 module Nes.APU.BusInterface (
-    -- * Pulse 1
-    write4000,
-    write4001,
-    write4002,
-    write4003,
-
-    -- * Pulse 2
-    write4004,
-    write4005,
-    write4006,
-    write4007,
-
-    -- * Triangle
-    write4008,
-    write400A,
-    write400B,
-
-    -- * Status register
-    write4015,
-
-    -- * Frame counter
-    write4017,
+    writeToAPU,
 ) where
 
-import Control.Monad
-import Data.Bits
+import Nes.APU.BusInterface.FrameCounter
+import Nes.APU.BusInterface.Pulse
+import Nes.APU.BusInterface.Status
+import Nes.APU.BusInterface.Triangle
 import Nes.APU.Monad
-import Nes.APU.State
-import Nes.APU.State.Envelope
-import Nes.APU.State.FrameCounter
-import Nes.APU.State.LengthCounter
-import Nes.APU.State.Pulse
-import qualified Nes.APU.State.Pulse as Pulse
-import Nes.APU.State.Triangle
-import qualified Nes.APU.State.Triangle as Triangle
-import Nes.APU.Tick
-import Nes.Memory (Byte (..), byteToInt)
-
--- | Callback when a byte is written to 0x4017 through the Bus
-write4017 :: Byte -> APU r ()
-write4017 byte = do
-    let seqMode = sequenceModeFromBool $ byte `testBit` 7
-        inhibit = byte `testBit` 6
-    modifyAPUState $
-        modifyFrameCounter $
-            \fc -> fc{sequenceMode = seqMode, inhibitInterrupt = inhibit}
-    -- If the mode flag is set, then both "quarter frame" and "half frame" signals are also generated
-    when (seqMode == FiveStep) $ do
-        runQuarterFrameEvent
-        runHalfFrameEvent
-    when inhibit $ do
-        setFrameInterruptFlag False
-
-write4015 :: Byte -> APU r ()
-write4015 byte = do
-    let enablePulse1Lc = byte `testBit` 0
-        enablePulse2Lc = byte `testBit` 1
-        enableTriangleLc = byte `testBit` 2
-        enableNoiseLc = byte `testBit` 3
-        enableDmc = byte `testBit` 4
-    -- TODO: For each LC: If enable is false, call 'clearRemainingLength'
-    unless enablePulse1Lc $
-        modifyAPUState $
-            modifyPulse1 $
-                withLengthCounter clearLengthCounter
-
-    unless enablePulse2Lc $
-        modifyAPUState $
-            modifyPulse2 $
-                withLengthCounter clearLengthCounter
-
-    unless enableTriangleLc $
-        modifyAPUState $
-            modifyTriangle $
-                withLengthCounter clearLengthCounter
-
-write4000 :: Byte -> APU r ()
-write4000 = writePulseFirstByte modifyPulse1
-
-write4004 :: Byte -> APU r ()
-write4004 = writePulseFirstByte modifyPulse2
-
-{-# INLINE writePulseFirstByte #-}
-writePulseFirstByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
-writePulseFirstByte setter byte = do
-    let duty = byte `shiftR` 6
-        haltLC = byte `testBit` 5
-        constVol = byte `testBit` 4
-        vol = byte .&. 0b1111
-    modifyAPUState $ setter $ \p ->
-        withEnvelope (\e -> e{constantVolume = fromIntegral $ unByte vol, useConstantVolume = constVol, loopFlag = haltLC}) $
-            withLengthCounter (\lc -> lc{isHalted = haltLC}) $
-                p{dutyIndex = fromIntegral $ unByte duty}
-
-write4001 :: Byte -> APU r ()
-write4001 = writePulseSecondByte modifyPulse1
-
-write4005 :: Byte -> APU r ()
-write4005 = writePulseSecondByte modifyPulse2
-
-{-# INLINE writePulseSecondByte #-}
-writePulseSecondByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
-writePulseSecondByte setter byte = do
-    let enabledFlag = byte `testBit` 7
-        divPeriod = (byte `shiftR` 4) .&. 0b111
-        negateFlag = byte `testBit` 3
-        shiftC = byte .&. 0b111
-        sweepIsEnabled = enabledFlag && shiftC > 0
-    modifyAPUState $
-        setter $
-            updateTargetPeriod
-                . modifySweep
-                    ( \s ->
-                        s
-                            { Pulse.reloadFlag = True
-                            , enabled = sweepIsEnabled
-                            , dividerPeriod = byteToInt divPeriod
-                            , negateDelta = negateFlag
-                            , shiftCount = byteToInt shiftC
-                            }
-                    )
-
-write4002 :: Byte -> APU r ()
-write4002 = writePulseThirdByte modifyPulse1
-
-write4006 :: Byte -> APU r ()
-write4006 = writePulseThirdByte modifyPulse2
-
-{-# INLINE writePulseThirdByte #-}
-writePulseThirdByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
-writePulseThirdByte setter byte = modifyAPUState $ setter $ \p ->
-    let newPeriod = (Pulse.period p .&. 0b11100000000) .|. byteToInt byte
-     in updateTargetPeriod $ p{Pulse.period = newPeriod}
-
-write4003 :: Byte -> APU r ()
-write4003 = writePulseFourthByte modifyPulse1
-
-write4007 :: Byte -> APU r ()
-write4007 = writePulseFourthByte modifyPulse2
-
-{-# INLINE writePulseFourthByte #-}
-writePulseFourthByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
-writePulseFourthByte setter byte = modifyAPUState $ setter $ \p ->
-    let newPeriod = ((byteToInt byte .&. 0b111) `shiftL` 8) .|. (Pulse.period p .&. 0b11111111)
-        newLCLoad = byteToInt byte `shiftR` 3
-     in updateTargetPeriod $
-            withLengthCounter
-                (loadLengthCounter newLCLoad)
-                p
-                    { Pulse.period = newPeriod
-                    , dutyStep = 0
-                    -- TODO Not sure
-                    -- https://www.nesdev.org/wiki/APU_Pulse#Registers
-                    }
-
---
-
-write4008 :: Byte -> APU r ()
-write4008 byte = do
-    let control = byte `testBit` 7
-        reload = byteToInt $ byte `clearBit` 7
-    modifyAPUState $
-        modifyTriangle $
-            withLengthCounter (\lc -> lc{isHalted = control})
-                . \t -> t{controlFlag = control, reloadValue = reload}
-
-write400A :: Byte -> APU r ()
-write400A periodLow = modifyAPUState $ modifyTriangle $ \t ->
-    let newPeriod = (Triangle.period t .&. 0b11100000000) .|. byteToInt periodLow
-     in t{Triangle.period = newPeriod}
-
-write400B :: Byte -> APU r ()
-write400B byte = modifyAPUState $ modifyTriangle $ \t ->
-    let timerHigh = byteToInt $ byte .&. 0b111
-        newPeriod = (timerHigh `shiftL` 8) .|. (Triangle.period t .&. 0b11111111)
-        newLcLoad = byteToInt byte `shiftR` 3
-     in withLengthCounter (loadLengthCounter newLcLoad) $
-            t
-                { Triangle.reloadFlag = True
-                , Triangle.period = newPeriod
-                }
+import Nes.Memory (Addr, Byte (..))
+
+writeToAPU :: Addr -> Byte -> APU r ()
+writeToAPU addr = case addr of
+    -- Pulse 1
+    0x4000 -> write4000
+    0x4001 -> write4001
+    0x4002 -> write4002
+    0x4003 -> write4003
+    -- Pulse 2
+    0x4004 -> write4004
+    0x4005 -> write4005
+    0x4006 -> write4006
+    0x4007 -> write4007
+    -- Triangle
+    0x4008 -> write4008
+    0x400A -> write400A
+    0x400B -> write400B
+    -- Status
+    0x4015 -> write4015
+    -- Frame Counter
+    0x4017 -> write4017
+    -- TODO: 0x400C, 0x400F, 0x4010, 0x4013
+    _ -> const (return ())
diff --git a/src/Nes/APU/BusInterface/FrameCounter.hs b/src/Nes/APU/BusInterface/FrameCounter.hs
new file mode 100644
index 0000000..05d1ab9
--- /dev/null
+++ b/src/Nes/APU/BusInterface/FrameCounter.hs
@@ -0,0 +1,24 @@
+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.Memory
+
+-- | Callback when a byte is written to 0x4017 through the Bus
+write4017 :: Byte -> APU r ()
+write4017 byte = do
+    let seqMode = sequenceModeFromBool $ byte `testBit` 7
+        inhibit = byte `testBit` 6
+    modifyAPUState $
+        modifyFrameCounter $
+            \fc -> fc{sequenceMode = seqMode, inhibitInterrupt = inhibit}
+    -- If the mode flag is set, then both "quarter frame" and "half frame" signals are also generated
+    when (seqMode == FiveStep) $ do
+        runQuarterFrameEvent
+        runHalfFrameEvent
+    when inhibit $ do
+        setFrameInterruptFlag False
diff --git a/src/Nes/APU/BusInterface/Pulse.hs b/src/Nes/APU/BusInterface/Pulse.hs
new file mode 100644
index 0000000..e71b538
--- /dev/null
+++ b/src/Nes/APU/BusInterface/Pulse.hs
@@ -0,0 +1,102 @@
+module Nes.APU.BusInterface.Pulse (
+    -- * Pulse 1
+    write4000,
+    write4001,
+    write4002,
+    write4003,
+
+    -- * Pulse 2
+    write4004,
+    write4005,
+    write4006,
+    write4007,
+) 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.Pulse
+import Nes.Memory
+
+write4000 :: Byte -> APU r ()
+write4000 = writePulseFirstByte modifyPulse1
+
+write4004 :: Byte -> APU r ()
+write4004 = writePulseFirstByte modifyPulse2
+
+{-# INLINE writePulseFirstByte #-}
+writePulseFirstByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseFirstByte setter byte = do
+    let duty = byte `shiftR` 6
+        haltLC = byte `testBit` 5
+        constVol = byte `testBit` 4
+        vol = byte .&. 0b1111
+    modifyAPUState $ setter $ \p ->
+        withEnvelope (\e -> e{constantVolume = fromIntegral $ unByte vol, useConstantVolume = constVol, loopFlag = haltLC}) $
+            withLengthCounter (\lc -> lc{isHalted = haltLC}) $
+                p{dutyIndex = fromIntegral $ unByte duty}
+
+write4001 :: Byte -> APU r ()
+write4001 = writePulseSecondByte modifyPulse1
+
+write4005 :: Byte -> APU r ()
+write4005 = writePulseSecondByte modifyPulse2
+
+{-# INLINE writePulseSecondByte #-}
+writePulseSecondByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseSecondByte setter byte = do
+    let enabledFlag = byte `testBit` 7
+        divPeriod = (byte `shiftR` 4) .&. 0b111
+        negateFlag = byte `testBit` 3
+        shiftC = byte .&. 0b111
+        sweepIsEnabled = enabledFlag && shiftC > 0
+    modifyAPUState $
+        setter $
+            updateTargetPeriod
+                . modifySweep
+                    ( \s ->
+                        s
+                            { reloadFlag = True
+                            , enabled = sweepIsEnabled
+                            , dividerPeriod = byteToInt divPeriod
+                            , negateDelta = negateFlag
+                            , shiftCount = byteToInt shiftC
+                            }
+                    )
+
+write4002 :: Byte -> APU r ()
+write4002 = writePulseThirdByte modifyPulse1
+
+write4006 :: Byte -> APU r ()
+write4006 = writePulseThirdByte modifyPulse2
+
+{-# INLINE writePulseThirdByte #-}
+writePulseThirdByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseThirdByte setter byte = modifyAPUState $ setter $ \p ->
+    let newPeriod = (period p .&. 0b11100000000) .|. byteToInt byte
+     in updateTargetPeriod $ p{period = newPeriod}
+
+write4003 :: Byte -> APU r ()
+write4003 = writePulseFourthByte modifyPulse1
+
+write4007 :: Byte -> APU r ()
+write4007 = writePulseFourthByte modifyPulse2
+
+{-# INLINE writePulseFourthByte #-}
+writePulseFourthByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
+writePulseFourthByte setter byte = modifyAPUState $ setter $ \p ->
+    let newPeriod = ((byteToInt byte .&. 0b111) `shiftL` 8) .|. (period p .&. 0b11111111)
+        newLCLoad = byteToInt byte `shiftR` 3
+     in updateTargetPeriod $
+            withLengthCounter
+                (loadLengthCounter newLCLoad)
+                p
+                    { period = newPeriod
+                    , dutyStep = 0
+                    -- TODO Not sure
+                    -- https://www.nesdev.org/wiki/APU_Pulse#Registers
+                    }
+
+--
diff --git a/src/Nes/APU/BusInterface/Status.hs b/src/Nes/APU/BusInterface/Status.hs
new file mode 100644
index 0000000..505c8bf
--- /dev/null
+++ b/src/Nes/APU/BusInterface/Status.hs
@@ -0,0 +1,31 @@
+module Nes.APU.BusInterface.Status (write4015) where
+
+import Control.Monad
+import Data.Bits
+import Nes.APU.Monad
+import Nes.APU.State
+import Nes.APU.State.LengthCounter
+import Nes.Memory
+
+write4015 :: Byte -> APU r ()
+write4015 byte = do
+    let enablePulse1Lc = byte `testBit` 0
+        enablePulse2Lc = byte `testBit` 1
+        enableTriangleLc = byte `testBit` 2
+        enableNoiseLc = byte `testBit` 3
+        enableDmc = byte `testBit` 4
+    -- TODO: For each LC: If enable is false, call 'clearRemainingLength'
+    unless enablePulse1Lc $
+        modifyAPUState $
+            modifyPulse1 $
+                withLengthCounter clearLengthCounter
+
+    unless enablePulse2Lc $
+        modifyAPUState $
+            modifyPulse2 $
+                withLengthCounter clearLengthCounter
+
+    unless enableTriangleLc $
+        modifyAPUState $
+            modifyTriangle $
+                withLengthCounter clearLengthCounter
diff --git a/src/Nes/APU/BusInterface/Triangle.hs b/src/Nes/APU/BusInterface/Triangle.hs
new file mode 100644
index 0000000..c306f5d
--- /dev/null
+++ b/src/Nes/APU/BusInterface/Triangle.hs
@@ -0,0 +1,38 @@
+module Nes.APU.BusInterface.Triangle (
+    -- * Triangle
+    write4008,
+    write400A,
+    write400B,
+) where
+
+import Data.Bits
+import Nes.APU.Monad
+import Nes.APU.State
+import Nes.APU.State.LengthCounter
+import Nes.APU.State.Triangle
+import Nes.Memory
+
+write4008 :: Byte -> APU r ()
+write4008 byte = do
+    let control = byte `testBit` 7
+        reload = byteToInt $ byte `clearBit` 7
+    modifyAPUState $
+        modifyTriangle $
+            withLengthCounter (\lc -> lc{isHalted = control})
+                . \t -> t{controlFlag = control, reloadValue = reload}
+
+write400A :: Byte -> APU r ()
+write400A periodLow = modifyAPUState $ modifyTriangle $ \t ->
+    let newPeriod = (period t .&. 0b11100000000) .|. byteToInt periodLow
+     in t{period = newPeriod}
+
+write400B :: Byte -> APU r ()
+write400B byte = modifyAPUState $ modifyTriangle $ \t ->
+    let timerHigh = byteToInt $ byte .&. 0b111
+        newPeriod = (timerHigh `shiftL` 8) .|. (period t .&. 0b11111111)
+        newLcLoad = byteToInt byte `shiftR` 3
+     in withLengthCounter (loadLengthCounter newLcLoad) $
+            t
+                { reloadFlag = True
+                , period = newPeriod
+                }
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index eca605a..6c8df78 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -185,8 +185,7 @@ instance MemoryInterface () (BusM r) where
                 -- TODO 2) Not sure about about the tick count
                 tick (513 + fromEnum (odd cycles_))
             | idx == 0x4016 = withController $ setStrobe byte
-            -- APU
-            | idx == 0x4017 = withAPU $ write4017 byte
+            | (0x4000, 0x4017) `inRange` idx = withAPU $ writeToAPU idx byte
             | otherwise = pure () -- liftIO $ printf "Ignoring write at %4x\n" $ unAddr idx
     readAddr idx () = do
         low <- readByte idx ()

From 686c6a435ca2ae14d48e0be56b9e2c0d322204b0 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Sat, 8 Nov 2025 18:40:48 +0000
Subject: [PATCH 10/37] APU: Add Noise

---
 funes.cabal                        |  2 +
 src/Nes/APU/BusInterface.hs        |  9 +++-
 src/Nes/APU/BusInterface/Noise.hs  | 35 ++++++++++++++
 src/Nes/APU/BusInterface/Pulse.hs  | 19 ++++----
 src/Nes/APU/BusInterface/Status.hs |  5 ++
 src/Nes/APU/State.hs               | 37 ++++-----------
 src/Nes/APU/State/Noise.hs         | 74 ++++++++++++++++++++++++++++++
 src/Nes/APU/Tick.hs                |  3 +-
 8 files changed, 145 insertions(+), 39 deletions(-)
 create mode 100644 src/Nes/APU/BusInterface/Noise.hs
 create mode 100644 src/Nes/APU/State/Noise.hs

diff --git a/funes.cabal b/funes.cabal
index 5839da7..4861f00 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -26,6 +26,7 @@ library
   exposed-modules:
       Nes.APU.BusInterface
       Nes.APU.BusInterface.FrameCounter
+      Nes.APU.BusInterface.Noise
       Nes.APU.BusInterface.Pulse
       Nes.APU.BusInterface.Status
       Nes.APU.BusInterface.Triangle
@@ -34,6 +35,7 @@ library
       Nes.APU.State.Envelope
       Nes.APU.State.FrameCounter
       Nes.APU.State.LengthCounter
+      Nes.APU.State.Noise
       Nes.APU.State.Pulse
       Nes.APU.State.Triangle
       Nes.APU.Tick
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index 1a662f0..878ce86 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -3,6 +3,7 @@ module Nes.APU.BusInterface (
 ) where
 
 import Nes.APU.BusInterface.FrameCounter
+import Nes.APU.BusInterface.Noise
 import Nes.APU.BusInterface.Pulse
 import Nes.APU.BusInterface.Status
 import Nes.APU.BusInterface.Triangle
@@ -25,9 +26,15 @@ writeToAPU addr = case addr of
     0x4008 -> write4008
     0x400A -> write400A
     0x400B -> write400B
+    -- Noise
+    0x400C -> write400C
+    0x400E -> write400E
+    0x400F -> write400F
     -- Status
     0x4015 -> write4015
     -- Frame Counter
     0x4017 -> write4017
-    -- TODO: 0x400C, 0x400F, 0x4010, 0x4013
+    -- TODO: 0x4010, 0x4013
     _ -> const (return ())
+
+-- TODO Read from APU
diff --git a/src/Nes/APU/BusInterface/Noise.hs b/src/Nes/APU/BusInterface/Noise.hs
new file mode 100644
index 0000000..1f59be1
--- /dev/null
+++ b/src/Nes/APU/BusInterface/Noise.hs
@@ -0,0 +1,35 @@
+module Nes.APU.BusInterface.Noise 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.Memory
+
+write400C :: Byte -> APU r ()
+write400C byte = do
+    let haltLC = byte `testBit` 5
+        constVol = byte `testBit` 4
+        vol = byte .&. 0b1111
+    modifyAPUState $
+        modifyNoise $
+            withLengthCounter
+                (\lc -> lc{isHalted = haltLC})
+                . withEnvelope
+                    (\e -> e{constantVolume = byteToInt vol, useConstantVolume = constVol, loopFlag = haltLC})
+
+write400E :: Byte -> APU r ()
+write400E byte = do
+    let modeFlag = byte `testBit` 7
+        periodIndex = byteToInt $ byte .&. 0b1111
+    modifyAPUState $ modifyNoise $ \t -> t{period = getPeriodValue periodIndex, useBit6ForFeedback = modeFlag}
+
+write400F :: Byte -> APU r ()
+write400F byte = do
+    let newLCLoad = byteToInt $ byte `shiftR` 3
+    modifyAPUState $
+        modifyNoise $
+            withLengthCounter (loadLengthCounter newLCLoad)
+                . withEnvelope (\e -> e{startFlag = True})
diff --git a/src/Nes/APU/BusInterface/Pulse.hs b/src/Nes/APU/BusInterface/Pulse.hs
index e71b538..37d41e5 100644
--- a/src/Nes/APU/BusInterface/Pulse.hs
+++ b/src/Nes/APU/BusInterface/Pulse.hs
@@ -34,7 +34,7 @@ writePulseFirstByte setter byte = do
         constVol = byte `testBit` 4
         vol = byte .&. 0b1111
     modifyAPUState $ setter $ \p ->
-        withEnvelope (\e -> e{constantVolume = fromIntegral $ unByte vol, useConstantVolume = constVol, loopFlag = haltLC}) $
+        withEnvelope (\e -> e{constantVolume = byteToInt vol, useConstantVolume = constVol, loopFlag = haltLC}) $
             withLengthCounter (\lc -> lc{isHalted = haltLC}) $
                 p{dutyIndex = fromIntegral $ unByte duty}
 
@@ -90,13 +90,14 @@ writePulseFourthByte setter byte = modifyAPUState $ setter $ \p ->
     let newPeriod = ((byteToInt byte .&. 0b111) `shiftL` 8) .|. (period p .&. 0b11111111)
         newLCLoad = byteToInt byte `shiftR` 3
      in updateTargetPeriod $
-            withLengthCounter
-                (loadLengthCounter newLCLoad)
-                p
-                    { period = newPeriod
-                    , dutyStep = 0
-                    -- TODO Not sure
-                    -- https://www.nesdev.org/wiki/APU_Pulse#Registers
-                    }
+            withEnvelope (\e -> e{startFlag = True}) $
+                withLengthCounter
+                    (loadLengthCounter newLCLoad)
+                    p
+                        { period = newPeriod
+                        , dutyStep = 0
+                        -- TODO Not sure
+                        -- https://www.nesdev.org/wiki/APU_Pulse#Registers
+                        }
 
 --
diff --git a/src/Nes/APU/BusInterface/Status.hs b/src/Nes/APU/BusInterface/Status.hs
index 505c8bf..a27e21f 100644
--- a/src/Nes/APU/BusInterface/Status.hs
+++ b/src/Nes/APU/BusInterface/Status.hs
@@ -29,3 +29,8 @@ write4015 byte = do
         modifyAPUState $
             modifyTriangle $
                 withLengthCounter clearLengthCounter
+
+    unless enableNoiseLc $
+        modifyAPUState $
+            modifyNoise $
+                withLengthCounter clearLengthCounter
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index 66c7fe4..01c1d69 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -8,9 +8,11 @@ module Nes.APU.State (
     modifyPulse1,
     modifyPulse2,
     modifyTriangle,
+    modifyNoise,
 ) where
 
 import Nes.APU.State.FrameCounter
+import Nes.APU.State.Noise
 import Nes.APU.State.Pulse
 import Nes.APU.State.Triangle
 
@@ -19,30 +21,12 @@ data APUState = MkAPUState
     , pulse1 :: Pulse
     , pulse2 :: Pulse
     , triangle :: Triangle
+    , noise :: Noise
     }
 
--- { pulse1 :: Pulse
--- , pulse2 :: Pulse
--- , triangle :: Triangle
--- , noise :: Noise
--- , dmc :: DMC
--- , status :: StatusRegister
--- , frameCounter :: FrameCounter
--- }
-
 newAPUState :: APUState
 newAPUState =
-    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle
-
--- { pulse1 = mkChannel 0 0 0 0
--- , pulse2 = mkChannel 0 0 0 0
--- , triangle = mkChannel 0 0 0 0
--- , noise = mkChannel 0 0 0 0
--- , dmc = mkChannel 0 0 0 0
--- , status = MkSR 0
--- , frameCounter = MkFC 0
--- }
--- mkChannel b1 b2 b3 b4 = fromChannel $ MkChannel b1 b2 b3 b4
+    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle newNoise
 
 {-# INLINE modifyPulse1 #-}
 modifyPulse1 :: (Pulse -> Pulse) -> APUState -> APUState
@@ -56,18 +40,15 @@ modifyPulse2 f st = st{pulse2 = f (pulse2 st)}
 modifyTriangle :: (Triangle -> Triangle) -> APUState -> APUState
 modifyTriangle f st = st{triangle = f (triangle st)}
 
--- {-# INLINE modifyNoise #-}
--- modifyNoise :: (Noise -> Noise) -> APUState -> APUState
--- modifyNoise f st = st{noise = f (noise st)}
---
+{-# INLINE modifyNoise #-}
+modifyNoise :: (Noise -> Noise) -> APUState -> APUState
+modifyNoise f st = st{noise = f (noise st)}
+
 -- {-# INLINE modifyDMC #-}
 -- modifyDMC :: (DMC -> DMC) -> APUState -> APUState
 -- modifyDMC f st = st{dmc = f (dmc st)}
 --
--- {-# INLINE modifyStatus #-}
--- modifyStatus :: (StatusRegister -> StatusRegister) -> APUState -> APUState
--- modifyStatus f st = st{status = f (status st)}
---
+
 {-# INLINE modifyFrameCounter #-}
 modifyFrameCounter :: (FrameCounter -> FrameCounter) -> APUState -> APUState
 modifyFrameCounter f st = st{frameCounter = f (frameCounter st)}
diff --git a/src/Nes/APU/State/Noise.hs b/src/Nes/APU/State/Noise.hs
new file mode 100644
index 0000000..8956ceb
--- /dev/null
+++ b/src/Nes/APU/State/Noise.hs
@@ -0,0 +1,74 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Nes.APU.State.Noise (
+    -- * Data type
+    Noise (..),
+    newNoise,
+    getNoiseOutput,
+
+    -- * Clock
+    clockPulse,
+    clockShiftRegister,
+
+    -- * Utils
+    getPeriodValue,
+) where
+
+import Data.Bits
+import Data.List ((!?))
+import Data.Maybe (fromMaybe)
+import Data.Word
+import Nes.APU.State.Envelope
+import Nes.APU.State.LengthCounter
+
+data Noise = MkN
+    { useBit6ForFeedback :: Bool
+    -- ^ AKA Mode flag
+    , envelope :: Envelope
+    , lengthCounter :: LengthCounter
+    , shiftRegister :: Word16
+    , period :: Int
+    , timer :: Int
+    }
+
+newNoise :: Noise
+newNoise = MkN{..}
+  where
+    envelope = newEnvelope
+    useBit6ForFeedback = False
+    shiftRegister = 1
+    lengthCounter = newLengthCounter
+    period = 0
+    timer = 0
+
+getPeriodValue :: Int -> Int
+getPeriodValue idx = fromMaybe 4 ([4, 8, 16, 32, 64, 96, 128, 160, 202, 254, 380, 508, 762, 1016, 2034, 4068] !? idx)
+
+instance HasLengthCounter Noise where
+    getLengthCounter = lengthCounter
+    setLengthCounter lc t = t{lengthCounter = lc}
+
+instance HasEnvelope Noise where
+    getEnvelope = envelope
+    setEnvelope e t = t{envelope = e}
+
+clockPulse :: Noise -> Noise
+clockPulse n = clockCallback $ n{timer = newTimer}
+  where
+    newTimer = if timer n == 0 then period n else timer n - 1
+    clockCallback = if timer n == 0 then clockShiftRegister else id
+
+clockShiftRegister :: Noise -> Noise
+clockShiftRegister n = n{shiftRegister = shift2}
+  where
+    shift0 = shiftRegister n
+    xorBit = if useBit6ForFeedback n then 6 else 1
+    feeback = (shift0 `testBit` 0) .^. (shift0 `testBit` xorBit)
+    shift1 = shift0 `shiftR` 1
+    shift2 = if feeback then shift1 `setBit` 14 else shift1
+
+getNoiseOutput :: Noise -> Int
+getNoiseOutput n = if shiftBit0IsSet || lengthCounterIsZero then 0 else getEnvelopeOutput $ envelope n
+  where
+    shiftBit0IsSet = shiftRegister n `testBit` 0
+    lengthCounterIsZero = remainingLength (lengthCounter n) == 0
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index a32cbfd..c28502c 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -74,11 +74,11 @@ clockFrameCounterFiveStep = do
     when (step == 1 || step == 4) runHalfFrameEvent
 
 runQuarterFrameEvent :: APU r ()
--- TODO clock all envelopes and triangle counter
 runQuarterFrameEvent = do
     modifyAPUState $
         modifyPulse1 (withEnvelope clockEnvelope)
             . modifyPulse2 (withEnvelope clockEnvelope)
+            . modifyNoise (withEnvelope clockEnvelope)
             . modifyTriangle clockTriangleLinearCounter
 
 runHalfFrameEvent :: APU r ()
@@ -88,6 +88,7 @@ runHalfFrameEvent = modifyAPUState $ \st ->
         { pulse1 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse1 st)
         , pulse2 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse2 st)
         , triangle = withLengthCounter clockLengthCounter $ triangle st
+        , noise = withLengthCounter clockLengthCounter $ noise st
         }
 
 -- | Set the Frame Counter's Frame flag

From 36ccb8be21bc14c80530e7f47939351a755a302e Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Sat, 8 Nov 2025 18:49:26 +0000
Subject: [PATCH 11/37] APU: Fix behaviour on write to read register

---
 src/Nes/APU/BusInterface/Status.hs | 9 +++++----
 src/Nes/APU/State/LengthCounter.hs | 6 +++---
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/Nes/APU/BusInterface/Status.hs b/src/Nes/APU/BusInterface/Status.hs
index a27e21f..3577828 100644
--- a/src/Nes/APU/BusInterface/Status.hs
+++ b/src/Nes/APU/BusInterface/Status.hs
@@ -15,22 +15,23 @@ write4015 byte = do
         enableNoiseLc = byte `testBit` 3
         enableDmc = byte `testBit` 4
     -- TODO: For each LC: If enable is false, call 'clearRemainingLength'
+    -- TODO: Handle DMC side effects
     unless enablePulse1Lc $
         modifyAPUState $
             modifyPulse1 $
-                withLengthCounter clearLengthCounter
+                withLengthCounter clearAndHaltLengthCounter
 
     unless enablePulse2Lc $
         modifyAPUState $
             modifyPulse2 $
-                withLengthCounter clearLengthCounter
+                withLengthCounter clearAndHaltLengthCounter
 
     unless enableTriangleLc $
         modifyAPUState $
             modifyTriangle $
-                withLengthCounter clearLengthCounter
+                withLengthCounter clearAndHaltLengthCounter
 
     unless enableNoiseLc $
         modifyAPUState $
             modifyNoise $
-                withLengthCounter clearLengthCounter
+                withLengthCounter clearAndHaltLengthCounter
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
index d33eaa3..abec836 100644
--- a/src/Nes/APU/State/LengthCounter.hs
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -3,7 +3,7 @@ module Nes.APU.State.LengthCounter (
     newLengthCounter,
     clockLengthCounter,
     loadLengthCounter,
-    clearLengthCounter,
+    clearAndHaltLengthCounter,
 
     -- * Class
     HasLengthCounter (..),
@@ -25,8 +25,8 @@ clockLengthCounter lc =
         else lc
 
 -- | Set 'remainingLength' to 0
-clearLengthCounter :: LengthCounter -> LengthCounter
-clearLengthCounter lc = lc{remainingLength = 0}
+clearAndHaltLengthCounter :: LengthCounter -> LengthCounter
+clearAndHaltLengthCounter lc = lc{remainingLength = 0, isHalted = True}
 
 -- | Load Length using the argument a an index in the length table
 --

From cb443633efb4b176a2e778f438c3e98be676017b Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Sun, 9 Nov 2025 09:30:09 +0000
Subject: [PATCH 12/37] APU: Monad passes bus

---
 src/Nes/APU/Monad.hs | 24 ++++++++++++------------
 src/Nes/Bus/Monad.hs |  4 ++--
 2 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
index 8c71c6a..e902934 100644
--- a/src/Nes/APU/Monad.hs
+++ b/src/Nes/APU/Monad.hs
@@ -7,44 +7,44 @@ module Nes.APU.Monad (
 
 import Control.Monad.IO.Class
 import Nes.APU.State
+import Nes.Bus
 
 newtype APU r a = MkAPU
-    { unAPU :: APUState -> (APUState -> a -> IO r) -> IO r
-    -- TODO Not sure IO is needed here
+    { unAPU :: APUState -> Bus -> (APUState -> Bus -> a -> IO r) -> IO r
     }
     deriving (Functor)
 
 instance Applicative (APU r) where
     {-# INLINE pure #-}
-    pure a = MkAPU $ \st cont -> cont st a
+    pure a = MkAPU $ \st bus cont -> cont st bus a
 
     {-# INLINE liftA2 #-}
-    liftA2 f (MkAPU a) (MkAPU b) = MkAPU $ \st cont ->
-        a st $ \st' a' -> b st' $ \st'' b' -> cont st'' (f a' b')
+    liftA2 f (MkAPU a) (MkAPU b) = MkAPU $ \st bus cont ->
+        a st bus $ \st' bus' a' -> b st' bus' $ \st'' bus'' b' -> cont st'' bus'' (f a' b')
 
 instance Monad (APU r) where
     {-# INLINE (>>=) #-}
-    (MkAPU a) >>= next = MkAPU $ \st cont ->
-        a st $ \st' a' -> unAPU (next a') st' $ \st'' res -> cont st'' res
+    (MkAPU a) >>= next = MkAPU $ \st bus cont ->
+        a st bus $ \st' bus' a' -> unAPU (next a') st' bus' cont
 
 instance MonadIO (APU r) where
     {-# INLINE liftIO #-}
-    liftIO io = MkAPU $ \st cont -> io >>= cont st
+    liftIO io = MkAPU $ \st bus cont -> io >>= cont st bus
 
 instance MonadFail (APU r) where
     {-# INLINE fail #-}
     fail = liftIO . fail
 
 {-# INLINE runAPU #-}
-runAPU :: APUState -> APU (a, APUState) a -> IO (a, APUState)
-runAPU st f = unAPU op st $ \_ a -> return a
+runAPU :: APUState -> Bus -> APU (a, APUState) a -> IO (a, APUState)
+runAPU st bus f = unAPU op st bus $ \_ _ a -> return a
   where
     op = f >>= \a -> withAPUState (a,)
 
 {-# INLINE modifyAPUState #-}
 modifyAPUState :: (APUState -> APUState) -> APU r ()
-modifyAPUState f = MkAPU $ \st cont -> cont (f st) ()
+modifyAPUState f = MkAPU $ \st bus cont -> cont (f st) bus ()
 
 {-# INLINE withAPUState #-}
 withAPUState :: (APUState -> a) -> APU r a
-withAPUState f = MkAPU $ \st cont -> cont st (f st)
+withAPUState f = MkAPU $ \st bus cont -> cont st bus (f st)
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index 6c8df78..73abdd8 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -68,7 +68,7 @@ withPPU f = MkBusM $ \bus cont -> do
 {-# INLINE withAPU #-}
 withAPU :: APU (a, APUState) a -> BusM r a
 withAPU f = MkBusM $ \bus cont -> do
-    (res, apuSt) <- runAPU (apuState bus) f
+    (res, apuSt) <- runAPU (apuState bus) bus f
     cont (bus{apuState = apuSt}) res
 
 {-# INLINE withController #-}
@@ -89,7 +89,7 @@ tick n = MkBusM $ \bus cont -> do
         isNewFrame <- PPUM.tick (n * 3)
         after <- withPPUState nmiInterrupt
         return (isNewFrame, before, after)
-    ((), apuSt) <- runAPU (apuState bus) $ APU.tick (odd (Nes.Bus.cycles bus)) n
+    ((), apuSt) <- runAPU (apuState bus) bus $ APU.tick (odd (Nes.Bus.cycles bus)) n
     let bus' =
             bus
                 { unsleptCycles = newUnsleptCycles

From e9baf04e7869af5e8bdd0ea7b01966080fda8ac8 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Sun, 9 Nov 2025 10:53:02 +0000
Subject: [PATCH 13/37] APU: DMC [WIP]

---
 funes.cabal              |   1 +
 src/Nes/APU/State.hs     |  12 +++--
 src/Nes/APU/State/DMC.hs | 113 +++++++++++++++++++++++++++++++++++++++
 src/Nes/APU/Tick.hs      |   3 +-
 4 files changed, 123 insertions(+), 6 deletions(-)
 create mode 100644 src/Nes/APU/State/DMC.hs

diff --git a/funes.cabal b/funes.cabal
index 4861f00..e040280 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -32,6 +32,7 @@ library
       Nes.APU.BusInterface.Triangle
       Nes.APU.Monad
       Nes.APU.State
+      Nes.APU.State.DMC
       Nes.APU.State.Envelope
       Nes.APU.State.FrameCounter
       Nes.APU.State.LengthCounter
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index 01c1d69..6194c4d 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -9,8 +9,10 @@ module Nes.APU.State (
     modifyPulse2,
     modifyTriangle,
     modifyNoise,
+    modifyDMC,
 ) where
 
+import Nes.APU.State.DMC
 import Nes.APU.State.FrameCounter
 import Nes.APU.State.Noise
 import Nes.APU.State.Pulse
@@ -22,11 +24,12 @@ data APUState = MkAPUState
     , pulse2 :: Pulse
     , triangle :: Triangle
     , noise :: Noise
+    , dmc :: DMC
     }
 
 newAPUState :: APUState
 newAPUState =
-    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle newNoise
+    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle newNoise newDMC
 
 {-# INLINE modifyPulse1 #-}
 modifyPulse1 :: (Pulse -> Pulse) -> APUState -> APUState
@@ -44,10 +47,9 @@ modifyTriangle f st = st{triangle = f (triangle st)}
 modifyNoise :: (Noise -> Noise) -> APUState -> APUState
 modifyNoise f st = st{noise = f (noise st)}
 
--- {-# INLINE modifyDMC #-}
--- modifyDMC :: (DMC -> DMC) -> APUState -> APUState
--- modifyDMC f st = st{dmc = f (dmc st)}
---
+{-# INLINE modifyDMC #-}
+modifyDMC :: (DMC -> DMC) -> APUState -> APUState
+modifyDMC f st = st{dmc = f (dmc st)}
 
 {-# INLINE modifyFrameCounter #-}
 modifyFrameCounter :: (FrameCounter -> FrameCounter) -> APUState -> APUState
diff --git a/src/Nes/APU/State/DMC.hs b/src/Nes/APU/State/DMC.hs
new file mode 100644
index 0000000..94985ac
--- /dev/null
+++ b/src/Nes/APU/State/DMC.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Nes.APU.State.DMC where
+
+import Data.Array
+import Data.Bits
+import Data.List ((!?))
+import Data.Maybe (fromMaybe, isNothing)
+import Nes.Memory
+
+data DMC = MkDMC
+    { irqEnabledFlag :: Bool
+    , loopFlag :: Bool
+    , period :: Int
+    , timer :: Int
+    , sampleOgAddr :: Addr
+    , sampleOgLength :: Int
+    , sampleBufferAddr :: Addr -- Addr in memory of the sample buffer's byte
+    , sampleBytesRemaining :: Int
+    , sampleBuffer :: Maybe Byte
+    , outputLevel :: Int
+    , enableChannel :: Bool
+    , shouldClock :: Bool
+    , sleepingCycles :: Int
+    , shiftRegister :: Byte
+    , remainingBits :: Byte
+    , silentFlag :: Bool
+    }
+
+newDMC :: DMC
+newDMC = MkDMC{..}
+  where
+    irqEnabledFlag = False
+    loopFlag = False
+    period = 0
+    timer = 0
+    sampleOgAddr = 0
+    sampleOgLength = 0
+    sampleBufferAddr = 0
+    sampleBytesRemaining = 0
+    remainingBits = 0
+    shiftRegister = 0
+    silentFlag = False
+    sampleBuffer = Nothing
+    enableChannel = True
+    outputLevel = 0
+    shouldClock = False
+    sleepingCycles = 0
+
+getPeriodValue :: Int -> Int
+getPeriodValue idx = fromMaybe 428 ([428, 380, 340, 286, 254, 226, 214, 190, 160, 142, 128, 106, 84, 72, 54] !? idx)
+
+clockDMC :: DMC -> DMC
+clockDMC dmc =
+    (if clocks then clockRemainingBits else id)
+        dmc
+            { timer = newTimer
+            , outputLevel = newOutputLevel
+            , shiftRegister = newShiftRegister
+            }
+  where
+    clocks = timer dmc == 0
+    newTimer = if timer dmc == 0 then period dmc else timer dmc - 1
+    newShiftRegister = if clocks then shiftRegister dmc `shiftR` 1 else shiftRegister dmc
+    newOutputLevel =
+        if clocks && not (silentFlag dmc)
+            then
+                let delta = if shiftRegister dmc `testBit` 0 then 2 else (-2)
+                    tmpOutLevel = outputLevel dmc + delta
+                 in if (0, 127) `inRange` tmpOutLevel then tmpOutLevel else outputLevel dmc
+            else outputLevel dmc
+
+clockRemainingBits :: DMC -> DMC
+clockRemainingBits dmc =
+    dmc
+        { remainingBits = newRemainingBits
+        , silentFlag = newSilentFlag
+        , shiftRegister = newShiftRegister
+        , sampleBuffer = newSampleBuffer
+        }
+  where
+    outputCycleEnds = remainingBits dmc == 1
+    newRemainingBits = if remainingBits dmc == 1 then 8 else remainingBits dmc - 1
+    newSilentFlag = outputCycleEnds && isNothing (sampleBuffer dmc)
+    -- TODO Call loadSampleBuffer if we empty sample buffer
+    (newShiftRegister, newSampleBuffer) = case (outputCycleEnds, sampleBuffer dmc) of
+        (True, Just byte) -> (byte, Nothing)
+        _ -> (shiftRegister dmc, sampleBuffer dmc)
+
+reloadSample :: DMC -> DMC
+reloadSample dmc =
+    dmc
+        { sampleBufferAddr = sampleOgAddr dmc
+        , sampleBytesRemaining = sampleOgLength dmc
+        , shouldClock = sampleOgLength dmc > 0
+        }
+
+-- | Loads the byte into the sample buffer and shift the sample buffer-related values
+--
+-- The first element of the returned tuple ays if the IRQ flag of the CPU should be set
+loadSampleBuffer :: Byte -> DMC -> (Bool, DMC)
+loadSampleBuffer byte dmc
+    | sampleBytesRemaining dmc == 0 = (False, dmc)
+    | otherwise = if shouldRestartSample then (False, reloadSample dmc1) else (shouldIRQ, dmc1)
+  where
+    dmc1 = dmc{sampleBuffer = Just byte, sampleBytesRemaining = newRemainingLength, sampleBufferAddr = newSampleAddr, shouldClock = newRemainingLength > 0}
+    shouldRestartSample = newRemainingLength == 0 && loopFlag dmc
+    shouldIRQ = newRemainingLength == 0 && irqEnabledFlag dmc
+    newRemainingLength = sampleBytesRemaining dmc - 1
+    newSampleAddr = let addr = sampleBufferAddr dmc + 1 in if addr >= 0xffff then addr - 0x8000 else addr
+
+getDMCOutput :: DMC -> Int
+getDMCOutput dmc = if silentFlag dmc then 0 else outputLevel dmc
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index c28502c..fe7a711 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -15,6 +15,7 @@ module Nes.APU.Tick (
 import Control.Monad
 import Nes.APU.Monad
 import Nes.APU.State
+import Nes.APU.State.DMC
 import Nes.APU.State.Envelope
 import Nes.APU.State.FrameCounter
 import qualified Nes.APU.State.FrameCounter as FC
@@ -38,7 +39,7 @@ tick b n = tickOnce b >> tick (not b) (n - 1)
 
 tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
-    -- TODO Ticks and clocks
+    modifyAPUState $ modifyDMC clockDMC
     modifyAPUState $ modifyTriangle clockTriangle
     when isAPUCycle $ do
         modifyAPUState $

From f9b67c606f8a2ad7e11ad78896846c9ad0679caa Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Sun, 9 Nov 2025 11:50:32 +0000
Subject: [PATCH 14/37] APU: Rename 'clock' functions to 'tick' for clarity

---
 src/Nes/APU/State/DMC.hs           | 12 ++++---
 src/Nes/APU/State/Envelope.hs      | 12 +++----
 src/Nes/APU/State/LengthCounter.hs |  7 ++--
 src/Nes/APU/State/Noise.hs         | 14 ++++----
 src/Nes/APU/State/Pulse.hs         | 12 +++----
 src/Nes/APU/State/Triangle.hs      | 16 ++++-----
 src/Nes/APU/Tick.hs                | 52 +++++++++++++++---------------
 7 files changed, 63 insertions(+), 62 deletions(-)

diff --git a/src/Nes/APU/State/DMC.hs b/src/Nes/APU/State/DMC.hs
index 94985ac..0ebe5b6 100644
--- a/src/Nes/APU/State/DMC.hs
+++ b/src/Nes/APU/State/DMC.hs
@@ -50,9 +50,9 @@ newDMC = MkDMC{..}
 getPeriodValue :: Int -> Int
 getPeriodValue idx = fromMaybe 428 ([428, 380, 340, 286, 254, 226, 214, 190, 160, 142, 128, 106, 84, 72, 54] !? idx)
 
-clockDMC :: DMC -> DMC
-clockDMC dmc =
-    (if clocks then clockRemainingBits else id)
+tickDMC :: DMC -> DMC
+tickDMC dmc =
+    (if clocks then tickRemainingBits else id)
         dmc
             { timer = newTimer
             , outputLevel = newOutputLevel
@@ -70,8 +70,10 @@ clockDMC dmc =
                  in if (0, 127) `inRange` tmpOutLevel then tmpOutLevel else outputLevel dmc
             else outputLevel dmc
 
-clockRemainingBits :: DMC -> DMC
-clockRemainingBits dmc =
+-- TODO split clock and tick
+
+tickRemainingBits :: DMC -> DMC
+tickRemainingBits dmc =
     dmc
         { remainingBits = newRemainingBits
         , silentFlag = newSilentFlag
diff --git a/src/Nes/APU/State/Envelope.hs b/src/Nes/APU/State/Envelope.hs
index 551dd69..fe61693 100644
--- a/src/Nes/APU/State/Envelope.hs
+++ b/src/Nes/APU/State/Envelope.hs
@@ -8,7 +8,7 @@ module Nes.APU.State.Envelope (
     withEnvelope,
 
     -- * Clock
-    clockEnvelope,
+    tickEnvelope,
 
     -- * Output
     getEnvelopeOutput,
@@ -33,14 +33,14 @@ class HasEnvelope a where
 withEnvelope :: (HasEnvelope a) => (Envelope -> Envelope) -> a -> a
 withEnvelope f a = setEnvelope (f $ getEnvelope a) a
 
-clockEnvelope :: Envelope -> Envelope
-clockEnvelope e =
+tickEnvelope :: Envelope -> Envelope
+tickEnvelope e =
     if startFlag e
         then e{startFlag = False, decayLevel = 15, divider = constantVolume e}
-        else clockDivider e
+        else tickDivider e
 
-clockDivider :: Envelope -> Envelope
-clockDivider e =
+tickDivider :: Envelope -> Envelope
+tickDivider e =
     if divider e == 0
         then e{divider = constantVolume e, decayLevel = newDecay}
         else e{divider = divider e - 1}
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
index abec836..e59afc1 100644
--- a/src/Nes/APU/State/LengthCounter.hs
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -1,7 +1,7 @@
 module Nes.APU.State.LengthCounter (
     LengthCounter (..),
     newLengthCounter,
-    clockLengthCounter,
+    tickLengthCounter,
     loadLengthCounter,
     clearAndHaltLengthCounter,
 
@@ -18,13 +18,12 @@ data LengthCounter = MkLC {remainingLength :: Int, isHalted :: Bool, tableIndex
 newLengthCounter :: LengthCounter
 newLengthCounter = MkLC 0 False 0
 
-clockLengthCounter :: LengthCounter -> LengthCounter
-clockLengthCounter lc =
+tickLengthCounter :: LengthCounter -> LengthCounter
+tickLengthCounter lc =
     if remainingLength lc > 0 && not (isHalted lc)
         then lc{remainingLength = remainingLength lc - 1}
         else lc
 
--- | Set 'remainingLength' to 0
 clearAndHaltLengthCounter :: LengthCounter -> LengthCounter
 clearAndHaltLengthCounter lc = lc{remainingLength = 0, isHalted = True}
 
diff --git a/src/Nes/APU/State/Noise.hs b/src/Nes/APU/State/Noise.hs
index 8956ceb..2c7bd03 100644
--- a/src/Nes/APU/State/Noise.hs
+++ b/src/Nes/APU/State/Noise.hs
@@ -7,8 +7,8 @@ module Nes.APU.State.Noise (
     getNoiseOutput,
 
     -- * Clock
-    clockPulse,
-    clockShiftRegister,
+    tickPulse,
+    tickShiftRegister,
 
     -- * Utils
     getPeriodValue,
@@ -52,14 +52,14 @@ instance HasEnvelope Noise where
     getEnvelope = envelope
     setEnvelope e t = t{envelope = e}
 
-clockPulse :: Noise -> Noise
-clockPulse n = clockCallback $ n{timer = newTimer}
+tickPulse :: Noise -> Noise
+tickPulse n = tickCallback $ n{timer = newTimer}
   where
     newTimer = if timer n == 0 then period n else timer n - 1
-    clockCallback = if timer n == 0 then clockShiftRegister else id
+    tickCallback = if timer n == 0 then tickShiftRegister else id
 
-clockShiftRegister :: Noise -> Noise
-clockShiftRegister n = n{shiftRegister = shift2}
+tickShiftRegister :: Noise -> Noise
+tickShiftRegister n = n{shiftRegister = shift2}
   where
     shift0 = shiftRegister n
     xorBit = if useBit6ForFeedback n then 6 else 1
diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
index bd726cb..a60a466 100644
--- a/src/Nes/APU/State/Pulse.hs
+++ b/src/Nes/APU/State/Pulse.hs
@@ -4,13 +4,13 @@ module Nes.APU.State.Pulse (
     -- * Pulse
     Pulse (..),
     newPulse,
-    clockPulse,
+    tickPulse,
     modifySweep,
     withSweep,
 
     -- * Sweep Unit
     SweepUnit (..),
-    clockSweepUnit,
+    tickSweepUnit,
     updateTargetPeriod,
 
     -- * Output
@@ -85,14 +85,14 @@ updateTargetPeriod p =
         )
         p
 
-clockPulse :: Pulse -> Pulse
-clockPulse p = p{dutyStep = newDutyStep, timer = newTimer}
+tickPulse :: Pulse -> Pulse
+tickPulse p = p{dutyStep = newDutyStep, timer = newTimer}
   where
     newDutyStep = if timer p == 0 then (dutyStep p + 1) `mod` 8 else dutyStep p
     newTimer = if timer p == 0 then period p else timer p - 1
 
-clockSweepUnit :: Pulse -> Pulse
-clockSweepUnit p = p2
+tickSweepUnit :: Pulse -> Pulse
+tickSweepUnit p = p2
   where
     sweep = sweepUnit p
     p1 =
diff --git a/src/Nes/APU/State/Triangle.hs b/src/Nes/APU/State/Triangle.hs
index e68b7ec..5e16c19 100644
--- a/src/Nes/APU/State/Triangle.hs
+++ b/src/Nes/APU/State/Triangle.hs
@@ -9,8 +9,8 @@ module Nes.APU.State.Triangle (
     getTriangleOutput,
 
     -- * Clock
-    clockTriangle,
-    clockTriangleLinearCounter,
+    tickTriangle,
+    tickTriangleLinearCounter,
 ) where
 
 import Nes.APU.State.LengthCounter
@@ -51,15 +51,15 @@ instance HasLengthCounter Triangle where
     getLengthCounter = lengthCounter
     setLengthCounter lc t = t{lengthCounter = lc}
 
-clockTriangle :: Triangle -> Triangle
-clockTriangle t = t{timer = newTimer, sequenceStep = newSequenceStep}
+tickTriangle :: Triangle -> Triangle
+tickTriangle t = t{timer = newTimer, sequenceStep = newSequenceStep}
   where
     newTimer = if timer t == 0 then period t else timer t - 1
-    clockSequence = timer t == 0 && linearCounter t /= 0 && remainingLength (lengthCounter t) /= 0
-    newSequenceStep = if clockSequence then (sequenceStep t + 1) `mod` 32 else sequenceStep t
+    tickSequence = timer t == 0 && linearCounter t /= 0 && remainingLength (lengthCounter t) /= 0
+    newSequenceStep = if tickSequence then (sequenceStep t + 1) `mod` 32 else sequenceStep t
 
-clockTriangleLinearCounter :: Triangle -> Triangle
-clockTriangleLinearCounter t = t2
+tickTriangleLinearCounter :: Triangle -> Triangle
+tickTriangleLinearCounter t = t2
   where
     t1 =
         if reloadFlag t
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index fe7a711..136490c 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -5,8 +5,8 @@ module Nes.APU.Tick (
     tickOnce,
     IsAPUCycle,
 
-    -- * Internal clocking
-    clockFrameCounter,
+    -- * Internal ticking
+    tickFrameCounter,
     runHalfFrameEvent,
     runQuarterFrameEvent,
     setFrameInterruptFlag,
@@ -24,7 +24,7 @@ import Nes.APU.State.Pulse
 import Nes.APU.State.Triangle
 
 -- $use
---     The APU being a part of the CPU, they both tick at the same time. However, some clocks are updated every other CPU cycles.
+--     The APU being a part of the CPU, they both tick at the same time. However, some ticks are updated every other CPU cycles.
 --     Here the 'tick' function should be called every CPU tick, and pass as parameter whether the tick is on an even CPU cycle or not.
 --     Same goes for 'tickMany'.
 
@@ -39,27 +39,27 @@ tick b n = tickOnce b >> tick (not b) (n - 1)
 
 tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
-    modifyAPUState $ modifyDMC clockDMC
-    modifyAPUState $ modifyTriangle clockTriangle
+    modifyAPUState $ modifyDMC tickDMC
+    modifyAPUState $ modifyTriangle tickTriangle
     when isAPUCycle $ do
         modifyAPUState $
-            modifyPulse1 clockPulse
-                . modifyPulse2 clockPulse
-        clockFrameCounter
+            modifyPulse1 tickPulse
+                . modifyPulse2 tickPulse
+        tickFrameCounter
 
--- | Tells the frame counter to clock channels
+-- | Tells the frame counter to tick channels
 --
 -- Source: https://www.nesdev.org/wiki/APU_Frame_Counter
-clockFrameCounter :: APU r ()
-clockFrameCounter = do
+tickFrameCounter :: APU r ()
+tickFrameCounter = do
     seqMode <- withAPUState $ sequenceMode . frameCounter
     case seqMode of
-        FourStep -> clockFrameCounterFourStep
-        FiveStep -> clockFrameCounterFiveStep
+        FourStep -> tickFrameCounterFourStep
+        FiveStep -> tickFrameCounterFiveStep
     modifyAPUState $ modifyFrameCounter incrementSequenceStep
 
-clockFrameCounterFourStep :: APU r ()
-clockFrameCounterFourStep = do
+tickFrameCounterFourStep :: APU r ()
+tickFrameCounterFourStep = do
     step <- withAPUState $ FC.sequenceStep . frameCounter
     inhibitFrameInterrupt <- withAPUState $ inhibitInterrupt . frameCounter
 
@@ -68,8 +68,8 @@ clockFrameCounterFourStep = do
     when (step == 3 && not inhibitFrameInterrupt) $
         setFrameInterruptFlag True
 
-clockFrameCounterFiveStep :: APU r ()
-clockFrameCounterFiveStep = do
+tickFrameCounterFiveStep :: APU r ()
+tickFrameCounterFiveStep = do
     step <- withAPUState $ FC.sequenceStep . frameCounter
     when (step < 5) runQuarterFrameEvent
     when (step == 1 || step == 4) runHalfFrameEvent
@@ -77,19 +77,19 @@ clockFrameCounterFiveStep = do
 runQuarterFrameEvent :: APU r ()
 runQuarterFrameEvent = do
     modifyAPUState $
-        modifyPulse1 (withEnvelope clockEnvelope)
-            . modifyPulse2 (withEnvelope clockEnvelope)
-            . modifyNoise (withEnvelope clockEnvelope)
-            . modifyTriangle clockTriangleLinearCounter
+        modifyPulse1 (withEnvelope tickEnvelope)
+            . modifyPulse2 (withEnvelope tickEnvelope)
+            . modifyNoise (withEnvelope tickEnvelope)
+            . modifyTriangle tickTriangleLinearCounter
 
 runHalfFrameEvent :: APU r ()
--- TODO clock all lengthcounters
+-- TODO tick all lengthcounters
 runHalfFrameEvent = modifyAPUState $ \st ->
     st
-        { pulse1 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse1 st)
-        , pulse2 = withLengthCounter clockLengthCounter $ clockSweepUnit (pulse2 st)
-        , triangle = withLengthCounter clockLengthCounter $ triangle st
-        , noise = withLengthCounter clockLengthCounter $ noise st
+        { pulse1 = withLengthCounter tickLengthCounter $ tickSweepUnit (pulse1 st)
+        , pulse2 = withLengthCounter tickLengthCounter $ tickSweepUnit (pulse2 st)
+        , triangle = withLengthCounter tickLengthCounter $ triangle st
+        , noise = withLengthCounter tickLengthCounter $ noise st
         }
 
 -- | Set the Frame Counter's Frame flag

From 636635419897041918260081c0b25d48bbd82f75 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Mon, 10 Nov 2025 09:33:26 +0000
Subject: [PATCH 15/37] APU: DMC + CPU Side effect

---
 funes.cabal                        |   2 +
 src/Nes/APU/BusInterface.hs        |   7 +-
 src/Nes/APU/BusInterface/DMC.hs    |  36 ++++++++++
 src/Nes/APU/BusInterface/Status.hs |   8 ++-
 src/Nes/APU/Monad.hs               |  35 ++++++----
 src/Nes/APU/State.hs               |   8 ++-
 src/Nes/APU/State/DMC.hs           | 101 +++++++++++++++++------------
 src/Nes/APU/State/Pulse.hs         |   2 +-
 src/Nes/APU/Tick.hs                |   2 +-
 src/Nes/Bus/Monad.hs               |   9 ++-
 src/Nes/Bus/SideEffect.hs          |   9 +++
 11 files changed, 154 insertions(+), 65 deletions(-)
 create mode 100644 src/Nes/APU/BusInterface/DMC.hs
 create mode 100644 src/Nes/Bus/SideEffect.hs

diff --git a/funes.cabal b/funes.cabal
index e040280..8212ffc 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -25,6 +25,7 @@ source-repository head
 library
   exposed-modules:
       Nes.APU.BusInterface
+      Nes.APU.BusInterface.DMC
       Nes.APU.BusInterface.FrameCounter
       Nes.APU.BusInterface.Noise
       Nes.APU.BusInterface.Pulse
@@ -43,6 +44,7 @@ library
       Nes.Bus
       Nes.Bus.Constants
       Nes.Bus.Monad
+      Nes.Bus.SideEffect
       Nes.Controller
       Nes.CPU.Instructions.Access
       Nes.CPU.Instructions.Addressing
diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index 878ce86..52ddb8d 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -2,6 +2,7 @@ module Nes.APU.BusInterface (
     writeToAPU,
 ) where
 
+import Nes.APU.BusInterface.DMC
 import Nes.APU.BusInterface.FrameCounter
 import Nes.APU.BusInterface.Noise
 import Nes.APU.BusInterface.Pulse
@@ -30,11 +31,15 @@ writeToAPU addr = case addr of
     0x400C -> write400C
     0x400E -> write400E
     0x400F -> write400F
+    -- DMC
+    0x4010 -> write4010
+    0x4011 -> write4011
+    0x4012 -> write4012
+    0x4013 -> write4013
     -- Status
     0x4015 -> write4015
     -- Frame Counter
     0x4017 -> write4017
-    -- TODO: 0x4010, 0x4013
     _ -> const (return ())
 
 -- TODO Read from APU
diff --git a/src/Nes/APU/BusInterface/DMC.hs b/src/Nes/APU/BusInterface/DMC.hs
new file mode 100644
index 0000000..323613d
--- /dev/null
+++ b/src/Nes/APU/BusInterface/DMC.hs
@@ -0,0 +1,36 @@
+module Nes.APU.BusInterface.DMC (write4010, write4011, write4012, write4013) where
+
+import Data.Bits
+import Nes.APU.Monad
+import Nes.APU.State (modifyDMC)
+import Nes.APU.State.DMC
+import Nes.Memory
+
+write4010 :: Byte -> APU r ()
+write4010 byte = do
+    let irq = byte `testBit` 7
+        loop = byte `testBit` 6
+        rateIdx = byteToInt $ byte .&. 0b1111
+        rate = getPeriodValue rateIdx
+    modifyAPUState $ modifyDMC $ \dmc ->
+        dmc
+            { irqEnabledFlag = irq
+            , loopFlag = loop
+            , period = rate
+            }
+
+write4011 :: Byte -> APU r ()
+write4011 byte = do
+    let directLoad = byteToInt $ byte .&. 0b1111111
+    -- TODO If the timer is outputting a clock at the same time, the output level is occasionally not changed properly.
+    modifyAPUState $ modifyDMC $ \dmc -> dmc{outputLevel = directLoad}
+
+write4012 :: Byte -> APU r ()
+write4012 byte = do
+    let sampleAddr = 0xC000 + (byteToAddr byte * 64)
+    modifyAPUState $ modifyDMC $ \dmc -> dmc{sampleOgAddr = sampleAddr}
+
+write4013 :: Byte -> APU r ()
+write4013 byte = do
+    let sampleLength = (byteToInt byte * 16) + 1
+    modifyAPUState $ modifyDMC $ \dmc -> dmc{sampleOgLength = sampleLength}
diff --git a/src/Nes/APU/BusInterface/Status.hs b/src/Nes/APU/BusInterface/Status.hs
index 3577828..8c29fc4 100644
--- a/src/Nes/APU/BusInterface/Status.hs
+++ b/src/Nes/APU/BusInterface/Status.hs
@@ -4,6 +4,7 @@ import Control.Monad
 import Data.Bits
 import Nes.APU.Monad
 import Nes.APU.State
+import Nes.APU.State.DMC
 import Nes.APU.State.LengthCounter
 import Nes.Memory
 
@@ -14,8 +15,6 @@ write4015 byte = do
         enableTriangleLc = byte `testBit` 2
         enableNoiseLc = byte `testBit` 3
         enableDmc = byte `testBit` 4
-    -- TODO: For each LC: If enable is false, call 'clearRemainingLength'
-    -- TODO: Handle DMC side effects
     unless enablePulse1Lc $
         modifyAPUState $
             modifyPulse1 $
@@ -35,3 +34,8 @@ write4015 byte = do
         modifyAPUState $
             modifyNoise $
                 withLengthCounter clearAndHaltLengthCounter
+    modifyAPUState $ modifyDMC $ \t ->
+        if enableDmc
+            -- TODO If there are bits remaining in the 1-byte sample buffer, these will finish playing before the next sample is fetched.
+            then if sampleBytesRemaining t == 0 then restartSample t else t
+            else t{sampleBytesRemaining = 0}
diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
index e902934..d97c409 100644
--- a/src/Nes/APU/Monad.hs
+++ b/src/Nes/APU/Monad.hs
@@ -2,49 +2,56 @@ module Nes.APU.Monad (
     APU (..),
     runAPU,
     modifyAPUState,
+    modifyAPUStateWithSideEffect,
     withAPUState,
+    setSideEffect,
 ) where
 
 import Control.Monad.IO.Class
 import Nes.APU.State
-import Nes.Bus
+import Nes.Bus.SideEffect
 
 newtype APU r a = MkAPU
-    { unAPU :: APUState -> Bus -> (APUState -> Bus -> a -> IO r) -> IO r
+    { unAPU :: APUState -> CPUSideEffect -> (APUState -> CPUSideEffect -> a -> IO r) -> IO r
     }
     deriving (Functor)
 
 instance Applicative (APU r) where
     {-# INLINE pure #-}
-    pure a = MkAPU $ \st bus cont -> cont st bus a
+    pure a = MkAPU $ \st cpuEff cont -> cont st cpuEff a
 
     {-# INLINE liftA2 #-}
-    liftA2 f (MkAPU a) (MkAPU b) = MkAPU $ \st bus cont ->
-        a st bus $ \st' bus' a' -> b st' bus' $ \st'' bus'' b' -> cont st'' bus'' (f a' b')
+    liftA2 f (MkAPU a) (MkAPU b) = MkAPU $ \st cpuEff cont ->
+        a st cpuEff $ \st' cpuEff' a' -> b st' (cpuEff <> cpuEff') $ \st'' cpuEff'' b' -> cont st'' (cpuEff' <> cpuEff'') (f a' b')
 
 instance Monad (APU r) where
     {-# INLINE (>>=) #-}
-    (MkAPU a) >>= next = MkAPU $ \st bus cont ->
-        a st bus $ \st' bus' a' -> unAPU (next a') st' bus' cont
+    (MkAPU a) >>= next = MkAPU $ \st cpuEff cont ->
+        a st cpuEff $ \st' cpuEff' a' -> unAPU (next a') st' (cpuEff <> cpuEff') cont
 
 instance MonadIO (APU r) where
     {-# INLINE liftIO #-}
-    liftIO io = MkAPU $ \st bus cont -> io >>= cont st bus
+    liftIO io = MkAPU $ \st cpuEff cont -> io >>= cont st cpuEff
 
 instance MonadFail (APU r) where
     {-# INLINE fail #-}
     fail = liftIO . fail
 
 {-# INLINE runAPU #-}
-runAPU :: APUState -> Bus -> APU (a, APUState) a -> IO (a, APUState)
-runAPU st bus f = unAPU op st bus $ \_ _ a -> return a
-  where
-    op = f >>= \a -> withAPUState (a,)
+runAPU :: APUState -> APU (a, CPUSideEffect, APUState) a -> IO (a, CPUSideEffect, APUState)
+runAPU st f = unAPU f st mempty $ \st' cpuEff a -> return (a, cpuEff, st')
 
 {-# INLINE modifyAPUState #-}
 modifyAPUState :: (APUState -> APUState) -> APU r ()
-modifyAPUState f = MkAPU $ \st bus cont -> cont (f st) bus ()
+modifyAPUState f = MkAPU $ \st cpuEff cont -> cont (f st) cpuEff ()
+
+{-# INLINE modifyAPUStateWithSideEffect #-}
+modifyAPUStateWithSideEffect :: (APUState -> (APUState, CPUSideEffect)) -> APU r ()
+modifyAPUStateWithSideEffect f = MkAPU $ \st cpuEff cont -> let (st', sideEff) = f st in cont st' (cpuEff <> sideEff) ()
 
 {-# INLINE withAPUState #-}
 withAPUState :: (APUState -> a) -> APU r a
-withAPUState f = MkAPU $ \st bus cont -> cont st bus (f st)
+withAPUState f = MkAPU $ \st cpuEff cont -> cont st cpuEff (f st)
+
+setSideEffect :: CPUSideEffect -> APU r ()
+setSideEffect eff = MkAPU $ \st cpuEff cont -> cont st (cpuEff <> eff) ()
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index 6194c4d..5fe3497 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -10,6 +10,7 @@ module Nes.APU.State (
     modifyTriangle,
     modifyNoise,
     modifyDMC,
+    modifyDMC',
 ) where
 
 import Nes.APU.State.DMC
@@ -17,6 +18,7 @@ import Nes.APU.State.FrameCounter
 import Nes.APU.State.Noise
 import Nes.APU.State.Pulse
 import Nes.APU.State.Triangle
+import Nes.Bus.SideEffect (CPUSideEffect)
 
 data APUState = MkAPUState
     { frameCounter :: FrameCounter
@@ -49,7 +51,11 @@ modifyNoise f st = st{noise = f (noise st)}
 
 {-# INLINE modifyDMC #-}
 modifyDMC :: (DMC -> DMC) -> APUState -> APUState
-modifyDMC f st = st{dmc = f (dmc st)}
+modifyDMC f st = let dmc' = f $ dmc st in st{dmc = dmc'}
+
+{-# INLINE modifyDMC' #-}
+modifyDMC' :: (DMC -> (DMC, CPUSideEffect)) -> APUState -> (APUState, CPUSideEffect)
+modifyDMC' f st = let (dmc', sideEff) = f $ dmc st in (st{dmc = dmc'}, sideEff)
 
 {-# INLINE modifyFrameCounter #-}
 modifyFrameCounter :: (FrameCounter -> FrameCounter) -> APUState -> APUState
diff --git a/src/Nes/APU/State/DMC.hs b/src/Nes/APU/State/DMC.hs
index 0ebe5b6..5b89b7b 100644
--- a/src/Nes/APU/State/DMC.hs
+++ b/src/Nes/APU/State/DMC.hs
@@ -1,11 +1,24 @@
 {-# LANGUAGE RecordWildCards #-}
 
-module Nes.APU.State.DMC where
+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.Bus.SideEffect (CPUSideEffect (setIRQ, startDMCDMA))
 import Nes.Memory
 
 data DMC = MkDMC
@@ -50,9 +63,21 @@ newDMC = MkDMC{..}
 getPeriodValue :: Int -> Int
 getPeriodValue idx = fromMaybe 428 ([428, 380, 340, 286, 254, 226, 214, 190, 160, 142, 128, 106, 84, 72, 54] !? idx)
 
-tickDMC :: DMC -> DMC
+-- | 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
+        { sampleBufferAddr = sampleOgAddr dmc
+        , sampleBytesRemaining = sampleOgLength dmc
+        , shouldClock = sampleOgLength dmc > 0
+        }
+
+getDMCOutput :: DMC -> Int
+getDMCOutput dmc = if silentFlag dmc then 0 else outputLevel dmc
+
+tickDMC :: DMC -> (DMC, CPUSideEffect)
 tickDMC dmc =
-    (if clocks then tickRemainingBits else id)
+    (if clocks then tickOutputUnit else (,mempty))
         dmc
             { timer = newTimer
             , outputLevel = newOutputLevel
@@ -70,46 +95,38 @@ tickDMC dmc =
                  in if (0, 127) `inRange` tmpOutLevel then tmpOutLevel else outputLevel dmc
             else outputLevel dmc
 
--- TODO split clock and tick
-
-tickRemainingBits :: DMC -> DMC
-tickRemainingBits dmc =
-    dmc
-        { remainingBits = newRemainingBits
-        , silentFlag = newSilentFlag
-        , shiftRegister = newShiftRegister
-        , sampleBuffer = newSampleBuffer
-        }
+tickOutputUnit :: DMC -> (DMC, CPUSideEffect)
+tickOutputUnit dmc = if isEndOfOutputCycle then onOutputCycleEnd dmc1 else (dmc1, mempty)
   where
-    outputCycleEnds = remainingBits dmc == 1
-    newRemainingBits = if remainingBits dmc == 1 then 8 else remainingBits dmc - 1
-    newSilentFlag = outputCycleEnds && isNothing (sampleBuffer dmc)
-    -- TODO Call loadSampleBuffer if we empty sample buffer
-    (newShiftRegister, newSampleBuffer) = case (outputCycleEnds, sampleBuffer dmc) of
-        (True, Just byte) -> (byte, Nothing)
-        _ -> (shiftRegister dmc, sampleBuffer dmc)
-
-reloadSample :: DMC -> DMC
-reloadSample dmc =
-    dmc
-        { sampleBufferAddr = sampleOgAddr dmc
-        , sampleBytesRemaining = sampleOgLength dmc
-        , shouldClock = sampleOgLength dmc > 0
-        }
+    newRemainingBits = max 0 (remainingBits dmc - 1)
+    isEndOfOutputCycle = newRemainingBits == 0
+    dmc1 = dmc{remainingBits = newRemainingBits}
 
--- | Loads the byte into the sample buffer and shift the sample buffer-related values
---
--- The first element of the returned tuple ays if the IRQ flag of the CPU should be set
-loadSampleBuffer :: Byte -> DMC -> (Bool, DMC)
-loadSampleBuffer byte dmc
-    | sampleBytesRemaining dmc == 0 = (False, dmc)
-    | otherwise = if shouldRestartSample then (False, reloadSample dmc1) else (shouldIRQ, dmc1)
+onOutputCycleEnd :: DMC -> (DMC, CPUSideEffect)
+onOutputCycleEnd dmc = (dmc1, sideEffect)
   where
-    dmc1 = dmc{sampleBuffer = Just byte, sampleBytesRemaining = newRemainingLength, sampleBufferAddr = newSampleAddr, shouldClock = newRemainingLength > 0}
-    shouldRestartSample = newRemainingLength == 0 && loopFlag dmc
-    shouldIRQ = newRemainingLength == 0 && irqEnabledFlag dmc
-    newRemainingLength = sampleBytesRemaining dmc - 1
-    newSampleAddr = let addr = sampleBufferAddr dmc + 1 in if addr >= 0xffff then addr - 0x8000 else addr
+    dmc0 = dmc{remainingBits = 8}
+    dmc1 = case sampleBuffer dmc0 of
+        Nothing -> dmc0{silentFlag = True}
+        Just b -> dmc0{shiftRegister = b, sampleBuffer = Nothing}
+    sideEffect = mempty{startDMCDMA = isNothing (sampleBuffer dmc1) && sampleBytesRemaining dmc1 > 0}
 
-getDMCOutput :: DMC -> Int
-getDMCOutput dmc = if silentFlag dmc then 0 else outputLevel dmc
+-- | Loads the byte into the sample buffer and shift the sample buffer-related values
+loadSampleBuffer :: Byte -> DMC -> (DMC, CPUSideEffect)
+loadSampleBuffer byte dmc =
+    let
+        newSampleBufferAddr = let addr = sampleBufferAddr dmc + 1 in if addr >= 0xffff then addr - 0x8000 else addr
+        newRemainingLength = max 0 (sampleBytesRemaining dmc - 1)
+        dmc1 =
+            dmc
+                { sampleBuffer = Just byte
+                , sampleBytesRemaining = newRemainingLength
+                , sampleBufferAddr = newSampleBufferAddr
+                , shouldClock = newRemainingLength > 0
+                }
+        shouldRestartSample = newRemainingLength == 0 && loopFlag dmc
+        shouldIRQ = newRemainingLength == 0 && irqEnabledFlag dmc
+     in
+        if shouldRestartSample
+            then (restartSample dmc1, mempty)
+            else (dmc1, mempty{setIRQ = shouldIRQ})
diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
index a60a466..8c5761a 100644
--- a/src/Nes/APU/State/Pulse.hs
+++ b/src/Nes/APU/State/Pulse.hs
@@ -88,7 +88,7 @@ updateTargetPeriod p =
 tickPulse :: Pulse -> Pulse
 tickPulse p = p{dutyStep = newDutyStep, timer = newTimer}
   where
-    newDutyStep = if timer p == 0 then (dutyStep p + 1) `mod` 8 else dutyStep p
+    newDutyStep = if timer p == 0 then (dutyStep p - 1) `mod` 8 else dutyStep p
     newTimer = if timer p == 0 then period p else timer p - 1
 
 tickSweepUnit :: Pulse -> Pulse
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index 136490c..b973fd9 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -39,7 +39,7 @@ tick b n = tickOnce b >> tick (not b) (n - 1)
 
 tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
-    modifyAPUState $ modifyDMC tickDMC
+    modifyAPUStateWithSideEffect $ modifyDMC' tickDMC
     modifyAPUState $ modifyTriangle tickTriangle
     when isAPUCycle $ do
         modifyAPUState $
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index 73abdd8..37521f5 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -15,6 +15,7 @@ import Nes.APU.State
 import qualified Nes.APU.Tick as APU
 import Nes.Bus
 import Nes.Bus.Constants
+import Nes.Bus.SideEffect (CPUSideEffect)
 import Nes.Controller
 import Nes.FlagRegister (clearFlag)
 import Nes.Memory
@@ -66,9 +67,10 @@ withPPU f = MkBusM $ \bus cont -> do
     cont (bus{ppuState = ppuSt}) res
 
 {-# INLINE withAPU #-}
-withAPU :: APU (a, APUState) a -> BusM r a
+withAPU :: APU (a, CPUSideEffect, APUState) a -> BusM r a
 withAPU f = MkBusM $ \bus cont -> do
-    (res, apuSt) <- runAPU (apuState bus) bus f
+    (res, _cpuEff, apuSt) <- runAPU (apuState bus) f
+    -- TODO Apply cpuEff
     cont (bus{apuState = apuSt}) res
 
 {-# INLINE withController #-}
@@ -89,7 +91,8 @@ tick n = MkBusM $ \bus cont -> do
         isNewFrame <- PPUM.tick (n * 3)
         after <- withPPUState nmiInterrupt
         return (isNewFrame, before, after)
-    ((), apuSt) <- runAPU (apuState bus) bus $ APU.tick (odd (Nes.Bus.cycles bus)) n
+    ((), _cpuEff, apuSt) <- runAPU (apuState bus) $ APU.tick (odd (Nes.Bus.cycles bus)) n
+    -- TODO Apply cpuEff
     let bus' =
             bus
                 { unsleptCycles = newUnsleptCycles
diff --git a/src/Nes/Bus/SideEffect.hs b/src/Nes/Bus/SideEffect.hs
new file mode 100644
index 0000000..7c9378e
--- /dev/null
+++ b/src/Nes/Bus/SideEffect.hs
@@ -0,0 +1,9 @@
+module Nes.Bus.SideEffect (CPUSideEffect (..)) where
+
+data CPUSideEffect = MkSE {setIRQ :: Bool, startDMCDMA :: Bool} deriving (Eq, Show)
+
+instance Semigroup CPUSideEffect where
+    (MkSE irq1 dma1) <> (MkSE irq2 dma2) = MkSE (irq1 || irq2) (dma1 || dma2)
+
+instance Monoid CPUSideEffect where
+    mempty = MkSE False False

From 75c57c6aa80c05464b8d744a717fd02f67718cf4 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Mon, 10 Nov 2025 11:09:04 +0000
Subject: [PATCH 16/37] APU: Read through Bus

---
 src/Nes/APU/BusInterface.hs        |  8 +++++-
 src/Nes/APU/BusInterface/Status.hs | 30 ++++++++++++++++++-
 src/Nes/Bus/Monad.hs               | 46 ++++++++++++++++++++----------
 3 files changed, 67 insertions(+), 17 deletions(-)

diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index 52ddb8d..fc924b4 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -1,5 +1,6 @@
 module Nes.APU.BusInterface (
     writeToAPU,
+    readFromAPU,
 ) where
 
 import Nes.APU.BusInterface.DMC
@@ -42,4 +43,9 @@ writeToAPU addr = case addr of
     0x4017 -> write4017
     _ -> const (return ())
 
--- TODO Read from APU
+readFromAPU :: Addr -> APU r (Maybe Byte)
+readFromAPU = \case
+    -- TODO Not open bus
+    -- TODO Bit 5 is open bus.
+    0x4015 -> Just <$> read4015
+    _ -> return Nothing
diff --git a/src/Nes/APU/BusInterface/Status.hs b/src/Nes/APU/BusInterface/Status.hs
index 8c29fc4..049e4ba 100644
--- a/src/Nes/APU/BusInterface/Status.hs
+++ b/src/Nes/APU/BusInterface/Status.hs
@@ -1,10 +1,11 @@
-module Nes.APU.BusInterface.Status (write4015) where
+module Nes.APU.BusInterface.Status (write4015, read4015) where
 
 import Control.Monad
 import Data.Bits
 import Nes.APU.Monad
 import Nes.APU.State
 import Nes.APU.State.DMC
+import Nes.APU.State.FrameCounter
 import Nes.APU.State.LengthCounter
 import Nes.Memory
 
@@ -39,3 +40,30 @@ write4015 byte = do
             -- TODO If there are bits remaining in the 1-byte sample buffer, these will finish playing before the next sample is fetched.
             then if sampleBytesRemaining t == 0 then restartSample t else t
             else t{sampleBytesRemaining = 0}
+
+read4015 :: APU r Byte
+read4015 = do
+    noiseBit <- withAPUState $ lengthCounterBit . noise
+    triangleBit <- withAPUState $ lengthCounterBit . triangle
+    pulse1Bit <- withAPUState $ lengthCounterBit . pulse1
+    pulse2Bit <- withAPUState $ lengthCounterBit . pulse2
+    dmcBit <- withAPUState $ \st -> sampleBytesRemaining (dmc st) > 0
+    let frameInterruptBit = False -- TODO Should check if side effect if applied
+    let dmcInterruptBit = False -- TODO Should check if side effect if applied
+    -- TODO That Should be a CPUSideEffect
+    modifyAPUState $ modifyFrameCounter $ \fc -> fc{frameInterruptFlag = False}
+    -- TODO If an interrupt flag was set at the same moment of the read, it will read back as 1 but it will not be cleared.
+    return $
+        setBit' dmcInterruptBit 7 $
+            setBit' frameInterruptBit 6 $
+                setBit' dmcBit 4 $
+                    setBit' noiseBit 3 $
+                        setBit' triangleBit 2 $
+                            setBit' pulse2Bit 1 $
+                                setBit'
+                                    pulse1Bit
+                                    0
+                                    0
+  where
+    setBit' b i a = if b then a `setBit` i else a `clearBit` i
+    lengthCounterBit st = let lc = getLengthCounter st in remainingLength lc > 0 && not (isHalted lc)
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index 37521f5..c17d75b 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -7,6 +7,7 @@ import Control.Monad
 import Control.Monad.IO.Class
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Internal as BS
+import Data.Functor (($>))
 import Data.Ix
 import Foreign
 import Nes.APU.BusInterface
@@ -106,19 +107,22 @@ tick n = MkBusM $ \bus cont -> do
         else
             cont bus' ()
 
+data BusReadOutput = OpenBus | DataBus Byte | Internal Byte
+
 instance MemoryInterface () (BusM r) where
-    readByte idx () = do
-        res <- go
-        modifyBus $ \b -> b{lastReadByte = res}
-        return res
+    readByte idx () =
+        go >>= \case
+            DataBus byte -> modifyBus (\b -> b{lastReadByte = byte}) $> byte
+            OpenBus -> withBus lastReadByte
+            Internal byte -> return byte
       where
         go
             | inRange ramRange idx = do
                 let mirroredDownAddr = idx .&. 0b11111111111 -- 11 bits
-                liftIO . readByte mirroredDownAddr =<< withBus cpuVram
+                fmap DataBus . liftIO . readByte mirroredDownAddr =<< withBus cpuVram
             | inRange ppuRegisters idx = do
                 let mirroredIdx = Addr . fromIntegral $ addrToInt (idx - fst ppuRegisters) `mod` 8
-                    onInvalidRead = return 0
+                    onInvalidRead = return $ DataBus 0
                 case mirroredIdx of
                     0 ->
                         if idx == 0x2000
@@ -127,26 +131,38 @@ instance MemoryInterface () (BusM r) where
                                 let
                                     addr1 = idx .&. 0b0010000000000111
                                  in
-                                    readByte addr1 ()
+                                    DataBus <$> readByte addr1 ()
                     1 -> onInvalidRead
                     2 -> withPPU $ do
                         st <- readStatus
                         -- https://www.nesdev.org/wiki/PPU_registers#PPUSTATUS_-_Rendering_events_($2002_read)
                         modifyPPUState $ modifyStatusRegister $ clearFlag VBlankStarted
-                        return st
+                        return $ DataBus st
                     3 -> onInvalidRead
-                    4 -> withPPU readOamData
+                    4 -> DataBus <$> withPPU readOamData
                     5 -> onInvalidRead
                     6 -> onInvalidRead
-                    7 -> withPPU readData
+                    7 -> DataBus <$> withPPU readData
                     _ -> error "Cannot happen"
             | inRange prgRomRange idx = do
                 rom <- withBus cartridge
-                readPrgRomAddr (idx - fst prgRomRange) rom readByte
-            | idx == 0x4014 = return 0
-            | idx == 0x4016 = withController readButtonStatus
-            | idx == 0x4017 = return 0 -- Second joypad, ignore
-            | otherwise = withBus lastReadByte
+                DataBus <$> readPrgRomAddr (idx - fst prgRomRange) rom readByte
+            | idx == 0x4014 = return $ DataBus 0
+            | idx == 0x4016 = DataBus <$> withController readButtonStatus
+            | idx == 0x4017 = return $ DataBus 0 -- Second joypad, ignore
+            | (0x4000, 0x4017) `inRange` idx = do
+                res <- withAPU $ readFromAPU idx
+                case res of
+                    Nothing -> return OpenBus
+                    Just b -> do
+                        b' <- do
+                            if idx == 0x4015
+                                then do
+                                    bit5 <- withBus $ (`testBit` 5) . lastReadByte
+                                    return $ if bit5 then b `setBit` 5 else b `clearBit` 5
+                                else return b
+                        return $ Internal b'
+            | otherwise = return OpenBus
 
     writeByte byte idx () = guardWriteBound idx go
       where

From 9893e13dcd532358652e0413f6292dfa8badc9e2 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Mon, 10 Nov 2025 11:20:09 +0000
Subject: [PATCH 17/37] APU: Strict Fields

---
 src/Nes/APU/Monad.hs               | 10 +++++-----
 src/Nes/APU/State.hs               | 12 +++++------
 src/Nes/APU/State/DMC.hs           | 32 +++++++++++++++---------------
 src/Nes/APU/State/Envelope.hs      | 12 +++++------
 src/Nes/APU/State/FrameCounter.hs  |  8 ++++----
 src/Nes/APU/State/LengthCounter.hs |  6 +++++-
 src/Nes/APU/State/Noise.hs         | 12 +++++------
 src/Nes/APU/State/Pulse.hs         | 14 ++++++-------
 src/Nes/APU/State/Triangle.hs      | 16 +++++++--------
 src/Nes/Bus/SideEffect.hs          |  6 +++++-
 10 files changed, 68 insertions(+), 60 deletions(-)

diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
index d97c409..96efc14 100644
--- a/src/Nes/APU/Monad.hs
+++ b/src/Nes/APU/Monad.hs
@@ -18,16 +18,16 @@ newtype APU r a = MkAPU
 
 instance Applicative (APU r) where
     {-# INLINE pure #-}
-    pure a = MkAPU $ \st cpuEff cont -> cont st cpuEff a
+    pure a = MkAPU $ \(!st) (!cpuEff) cont -> cont st cpuEff a
 
     {-# INLINE liftA2 #-}
-    liftA2 f (MkAPU a) (MkAPU b) = MkAPU $ \st cpuEff cont ->
-        a st cpuEff $ \st' cpuEff' a' -> b st' (cpuEff <> cpuEff') $ \st'' cpuEff'' b' -> cont st'' (cpuEff' <> cpuEff'') (f a' b')
+    liftA2 f (MkAPU a) (MkAPU b) = MkAPU $ \(!st) (!cpuEff) cont ->
+        a st cpuEff $ \(!st') (!cpuEff') !a' -> b st' (cpuEff <> cpuEff') $ \(!st'') (!cpuEff'') !b' -> cont st'' (cpuEff' <> cpuEff'') (f a' b')
 
 instance Monad (APU r) where
     {-# INLINE (>>=) #-}
     (MkAPU a) >>= next = MkAPU $ \st cpuEff cont ->
-        a st cpuEff $ \st' cpuEff' a' -> unAPU (next a') st' (cpuEff <> cpuEff') cont
+        a st cpuEff $ \(!st') (!cpuEff') (!a') -> unAPU (next a') st' (cpuEff <> cpuEff') cont
 
 instance MonadIO (APU r) where
     {-# INLINE liftIO #-}
@@ -39,7 +39,7 @@ instance MonadFail (APU r) where
 
 {-# INLINE runAPU #-}
 runAPU :: APUState -> APU (a, CPUSideEffect, APUState) a -> IO (a, CPUSideEffect, APUState)
-runAPU st f = unAPU f st mempty $ \st' cpuEff a -> return (a, cpuEff, st')
+runAPU st f = unAPU f st mempty $ \(!st') (!cpuEff) a -> return (a, cpuEff, st')
 
 {-# INLINE modifyAPUState #-}
 modifyAPUState :: (APUState -> APUState) -> APU r ()
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index 5fe3497..e5df877 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -21,12 +21,12 @@ import Nes.APU.State.Triangle
 import Nes.Bus.SideEffect (CPUSideEffect)
 
 data APUState = MkAPUState
-    { frameCounter :: FrameCounter
-    , pulse1 :: Pulse
-    , pulse2 :: Pulse
-    , triangle :: Triangle
-    , noise :: Noise
-    , dmc :: DMC
+    { frameCounter :: {-# UNPACK #-} !FrameCounter
+    , pulse1 :: {-# UNPACK #-} !Pulse
+    , pulse2 :: {-# UNPACK #-} !Pulse
+    , triangle :: {-# UNPACK #-} !Triangle
+    , noise :: {-# UNPACK #-} !Noise
+    , dmc :: {-# UNPACK #-} !DMC
     }
 
 newAPUState :: APUState
diff --git a/src/Nes/APU/State/DMC.hs b/src/Nes/APU/State/DMC.hs
index 5b89b7b..de06921 100644
--- a/src/Nes/APU/State/DMC.hs
+++ b/src/Nes/APU/State/DMC.hs
@@ -22,22 +22,22 @@ import Nes.Bus.SideEffect (CPUSideEffect (setIRQ, startDMCDMA))
 import Nes.Memory
 
 data DMC = MkDMC
-    { irqEnabledFlag :: Bool
-    , loopFlag :: Bool
-    , period :: Int
-    , timer :: Int
-    , sampleOgAddr :: Addr
-    , sampleOgLength :: Int
-    , sampleBufferAddr :: Addr -- Addr in memory of the sample buffer's byte
-    , sampleBytesRemaining :: Int
-    , sampleBuffer :: Maybe Byte
-    , outputLevel :: Int
-    , enableChannel :: Bool
-    , shouldClock :: Bool
-    , sleepingCycles :: Int
-    , shiftRegister :: Byte
-    , remainingBits :: Byte
-    , silentFlag :: Bool
+    { irqEnabledFlag :: {-# UNPACK #-} !Bool
+    , loopFlag :: {-# UNPACK #-} !Bool
+    , period :: {-# UNPACK #-} !Int
+    , timer :: {-# UNPACK #-} !Int
+    , sampleOgAddr :: {-# UNPACK #-} !Addr
+    , sampleOgLength :: {-# UNPACK #-} !Int
+    , sampleBufferAddr :: {-# UNPACK #-} !Addr -- Addr in memory of the sample buffer's byte
+    , sampleBytesRemaining :: {-# UNPACK #-} !Int
+    , sampleBuffer :: {-# UNPACK #-} !(Maybe Byte)
+    , outputLevel :: {-# UNPACK #-} !Int
+    , enableChannel :: {-# UNPACK #-} !Bool
+    , shouldClock :: {-# UNPACK #-} !Bool
+    , sleepingCycles :: {-# UNPACK #-} !Int
+    , shiftRegister :: {-# UNPACK #-} !Byte
+    , remainingBits :: {-# UNPACK #-} !Byte
+    , silentFlag :: {-# UNPACK #-} !Bool
     }
 
 newDMC :: DMC
diff --git a/src/Nes/APU/State/Envelope.hs b/src/Nes/APU/State/Envelope.hs
index fe61693..2c78734 100644
--- a/src/Nes/APU/State/Envelope.hs
+++ b/src/Nes/APU/State/Envelope.hs
@@ -15,12 +15,12 @@ module Nes.APU.State.Envelope (
 ) where
 
 data Envelope = MkE
-    { startFlag :: Bool
-    , useConstantVolume :: Bool
-    , constantVolume :: Int
-    , decayLevel :: Int
-    , divider :: Int
-    , loopFlag :: Bool
+    { startFlag :: {-# UNPACK #-} !Bool
+    , useConstantVolume :: {-# UNPACK #-} !Bool
+    , constantVolume :: {-# UNPACK #-} !Int
+    , decayLevel :: {-# UNPACK #-} !Int
+    , divider :: {-# UNPACK #-} !Int
+    , loopFlag :: {-# UNPACK #-} !Bool
     }
 
 newEnvelope :: Envelope
diff --git a/src/Nes/APU/State/FrameCounter.hs b/src/Nes/APU/State/FrameCounter.hs
index 4e00c4f..7edf425 100644
--- a/src/Nes/APU/State/FrameCounter.hs
+++ b/src/Nes/APU/State/FrameCounter.hs
@@ -21,10 +21,10 @@ sequenceModeStepCount = \case
     FiveStep -> 5
 
 data FrameCounter = MkFC
-    { sequenceMode :: SequenceMode
-    , frameInterruptFlag :: Bool
-    , inhibitInterrupt :: Bool
-    , sequenceStep :: Int
+    { sequenceMode :: {-# UNPACK #-} !SequenceMode
+    , frameInterruptFlag :: {-# UNPACK #-} !Bool
+    , inhibitInterrupt :: {-# UNPACK #-} !Bool
+    , sequenceStep :: {-# UNPACK #-} !Int
     }
 
 newFrameCounter :: FrameCounter
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
index e59afc1..6698e4a 100644
--- a/src/Nes/APU/State/LengthCounter.hs
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -13,7 +13,11 @@ module Nes.APU.State.LengthCounter (
 
 import Data.List ((!?))
 
-data LengthCounter = MkLC {remainingLength :: Int, isHalted :: Bool, tableIndex :: Int}
+data LengthCounter = MkLC
+    { remainingLength :: {-# UNPACK #-} !Int
+    , isHalted :: {-# UNPACK #-} !Bool
+    , tableIndex :: {-# UNPACK #-} !Int
+    }
 
 newLengthCounter :: LengthCounter
 newLengthCounter = MkLC 0 False 0
diff --git a/src/Nes/APU/State/Noise.hs b/src/Nes/APU/State/Noise.hs
index 2c7bd03..fc381f7 100644
--- a/src/Nes/APU/State/Noise.hs
+++ b/src/Nes/APU/State/Noise.hs
@@ -22,13 +22,13 @@ import Nes.APU.State.Envelope
 import Nes.APU.State.LengthCounter
 
 data Noise = MkN
-    { useBit6ForFeedback :: Bool
+    { useBit6ForFeedback :: {-# UNPACK #-} !Bool
     -- ^ AKA Mode flag
-    , envelope :: Envelope
-    , lengthCounter :: LengthCounter
-    , shiftRegister :: Word16
-    , period :: Int
-    , timer :: Int
+    , envelope :: {-# UNPACK #-} !Envelope
+    , lengthCounter :: {-# UNPACK #-} !LengthCounter
+    , shiftRegister :: {-# UNPACK #-} !Word16
+    , period :: {-# UNPACK #-} !Int
+    , timer :: {-# UNPACK #-} !Int
     }
 
 newNoise :: Noise
diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
index 8c5761a..eb72166 100644
--- a/src/Nes/APU/State/Pulse.hs
+++ b/src/Nes/APU/State/Pulse.hs
@@ -24,17 +24,17 @@ import Nes.APU.State.Envelope
 import Nes.APU.State.LengthCounter
 
 data Pulse = MkP
-    { dutyIndex :: Int
+    { dutyIndex :: {-# UNPACK #-} !Int
     -- ^ Index for the 'dutySequences' table
-    , dutyStep :: Int
+    , dutyStep :: {-# UNPACK #-} !Int
     -- ^ Index for a row's element in the 'dutySequences' table
-    , lengthCounter :: LengthCounter
-    , period :: Int
+    , lengthCounter :: {-# UNPACK #-} !LengthCounter
+    , period :: {-# UNPACK #-} !Int
     -- ^ Max value of the timer
-    , timer :: Int
+    , timer :: {-# UNPACK #-} !Int
     -- ^ Decreases each tick, from 'period' to 0 and loops
-    , sweepUnit :: SweepUnit
-    , envelope :: Envelope
+    , sweepUnit :: {-# UNPACK #-} !SweepUnit
+    , envelope :: {-# UNPACK #-} !Envelope
     }
 
 -- | Args is true if building pulse 1
diff --git a/src/Nes/APU/State/Triangle.hs b/src/Nes/APU/State/Triangle.hs
index 5e16c19..3181307 100644
--- a/src/Nes/APU/State/Triangle.hs
+++ b/src/Nes/APU/State/Triangle.hs
@@ -16,14 +16,14 @@ module Nes.APU.State.Triangle (
 import Nes.APU.State.LengthCounter
 
 data Triangle = MkT
-    { controlFlag :: Bool
-    , reloadFlag :: Bool
-    , reloadValue :: Int
-    , lengthCounter :: LengthCounter
-    , linearCounter :: Int
-    , period :: Int
-    , timer :: Int
-    , sequenceStep :: Int
+    { controlFlag :: {-# UNPACK #-} !Bool
+    , reloadFlag :: {-# UNPACK #-} !Bool
+    , reloadValue :: {-# UNPACK #-} !Int
+    , lengthCounter :: {-# UNPACK #-} !LengthCounter
+    , linearCounter :: {-# UNPACK #-} !Int
+    , period :: {-# UNPACK #-} !Int
+    , timer :: {-# UNPACK #-} !Int
+    , sequenceStep :: {-# UNPACK #-} !Int
     }
 
 newTriangle :: Triangle
diff --git a/src/Nes/Bus/SideEffect.hs b/src/Nes/Bus/SideEffect.hs
index 7c9378e..89f8836 100644
--- a/src/Nes/Bus/SideEffect.hs
+++ b/src/Nes/Bus/SideEffect.hs
@@ -1,6 +1,10 @@
 module Nes.Bus.SideEffect (CPUSideEffect (..)) where
 
-data CPUSideEffect = MkSE {setIRQ :: Bool, startDMCDMA :: Bool} deriving (Eq, Show)
+data CPUSideEffect = MkSE
+    { setIRQ :: {-# UNPACK #-} !Bool
+    , startDMCDMA :: {-# UNPACK #-} !Bool
+    }
+    deriving (Eq, Show)
 
 instance Semigroup CPUSideEffect where
     (MkSE irq1 dma1) <> (MkSE irq2 dma2) = MkSE (irq1 || irq2) (dma1 || dma2)

From d04fc718d04f13b5888b5bbdb0fe3c1b647babe1 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Mon, 10 Nov 2025 13:03:00 +0000
Subject: [PATCH 18/37] Transmit DMC DMA to CPU

---
 src/Nes/APU/BusInterface/Noise.hs |  2 +-
 src/Nes/APU/Monad.hs              |  6 ++--
 src/Nes/Bus.hs                    |  3 ++
 src/Nes/Bus/Monad.hs              | 13 ++++----
 src/Nes/Bus/SideEffect.hs         |  2 +-
 src/Nes/CPU/Monad.hs              | 52 ++++++++++++++++++++++---------
 6 files changed, 51 insertions(+), 27 deletions(-)

diff --git a/src/Nes/APU/BusInterface/Noise.hs b/src/Nes/APU/BusInterface/Noise.hs
index 1f59be1..742147a 100644
--- a/src/Nes/APU/BusInterface/Noise.hs
+++ b/src/Nes/APU/BusInterface/Noise.hs
@@ -1,4 +1,4 @@
-module Nes.APU.BusInterface.Noise where
+module Nes.APU.BusInterface.Noise (write400C, write400E, write400F) where
 
 import Data.Bits
 import Nes.APU.Monad
diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
index 96efc14..f62a60f 100644
--- a/src/Nes/APU/Monad.hs
+++ b/src/Nes/APU/Monad.hs
@@ -22,7 +22,7 @@ instance Applicative (APU r) where
 
     {-# INLINE liftA2 #-}
     liftA2 f (MkAPU a) (MkAPU b) = MkAPU $ \(!st) (!cpuEff) cont ->
-        a st cpuEff $ \(!st') (!cpuEff') !a' -> b st' (cpuEff <> cpuEff') $ \(!st'') (!cpuEff'') !b' -> cont st'' (cpuEff' <> cpuEff'') (f a' b')
+        a st cpuEff $ \(!st') (!cpuEff') !a' -> b st' cpuEff' $ \(!st'') (!cpuEff'') !b' -> cont st'' cpuEff'' (f a' b')
 
 instance Monad (APU r) where
     {-# INLINE (>>=) #-}
@@ -38,8 +38,8 @@ instance MonadFail (APU r) where
     fail = liftIO . fail
 
 {-# INLINE runAPU #-}
-runAPU :: APUState -> APU (a, CPUSideEffect, APUState) a -> IO (a, CPUSideEffect, APUState)
-runAPU st f = unAPU f st mempty $ \(!st') (!cpuEff) a -> return (a, cpuEff, st')
+runAPU :: APUState -> APU (a, APUState, CPUSideEffect) a -> IO (a, APUState, CPUSideEffect)
+runAPU st f = unAPU f st mempty $ \(!st') (!cpuEff) a -> return (a, st', cpuEff)
 
 {-# INLINE modifyAPUState #-}
 modifyAPUState :: (APUState -> APUState) -> APU r ()
diff --git a/src/Nes/Bus.hs b/src/Nes/Bus.hs
index 701fb11..9f9cb20 100644
--- a/src/Nes/Bus.hs
+++ b/src/Nes/Bus.hs
@@ -11,6 +11,7 @@ module Nes.Bus (
 ) where
 
 import Nes.APU.State (APUState, newAPUState)
+import Nes.Bus.SideEffect (CPUSideEffect)
 import Nes.Controller
 import Nes.Internal
 import Nes.Memory
@@ -43,6 +44,7 @@ data Bus = Bus
     , lastReadByte :: Byte
     -- ^ For open bus behaviour. Can be seen as data bus
     , apuState :: !APUState
+    , cpuSideEffect :: {-# UNPACK #-} !CPUSideEffect
     }
 
 newBus :: Rom -> (Bus -> IO Bus) -> (Double -> Int -> IO (Double, Int)) -> IO Bus
@@ -64,3 +66,4 @@ newBus rom_ onNewFrame_ tickCallback_ = do
             onNewFrame_
             0
             newAPUState
+            mempty
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index c17d75b..99c3e18 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
-module Nes.Bus.Monad (BusM (..), runBusM, tick, withBus, withPPU, withAPU, withController) where
+module Nes.Bus.Monad (BusM (..), runBusM, tick, modifyBus, withBus, withPPU, withAPU, withController) where
 
 import Control.Monad
 import Control.Monad.IO.Class
@@ -68,11 +68,10 @@ withPPU f = MkBusM $ \bus cont -> do
     cont (bus{ppuState = ppuSt}) res
 
 {-# INLINE withAPU #-}
-withAPU :: APU (a, CPUSideEffect, APUState) a -> BusM r a
+withAPU :: APU (a, APUState, CPUSideEffect) a -> BusM r a
 withAPU f = MkBusM $ \bus cont -> do
-    (res, _cpuEff, apuSt) <- runAPU (apuState bus) f
-    -- TODO Apply cpuEff
-    cont (bus{apuState = apuSt}) res
+    (res, apuSt, cpuEff) <- runAPU (apuState bus) f
+    cont (bus{apuState = apuSt, cpuSideEffect = cpuEff}) res
 
 {-# INLINE withController #-}
 withController :: ControllerM (a, Controller) a -> BusM r a
@@ -92,8 +91,7 @@ tick n = MkBusM $ \bus cont -> do
         isNewFrame <- PPUM.tick (n * 3)
         after <- withPPUState nmiInterrupt
         return (isNewFrame, before, after)
-    ((), _cpuEff, apuSt) <- runAPU (apuState bus) $ APU.tick (odd (Nes.Bus.cycles bus)) n
-    -- TODO Apply cpuEff
+    ((), apuSt, cpuEff) <- runAPU (apuState bus) $ APU.tick (odd (Nes.Bus.cycles bus)) n
     let bus' =
             bus
                 { unsleptCycles = newUnsleptCycles
@@ -101,6 +99,7 @@ tick n = MkBusM $ \bus cont -> do
                 , apuState = apuSt
                 , cycles = fromIntegral n + cycles bus
                 , lastSleepTime = newLastSleepTime
+                , cpuSideEffect = cpuEff
                 }
     if not nmiBefore && nmiAfter
         then onNewFrame bus' bus' >>= flip cont ()
diff --git a/src/Nes/Bus/SideEffect.hs b/src/Nes/Bus/SideEffect.hs
index 89f8836..c9b1a5e 100644
--- a/src/Nes/Bus/SideEffect.hs
+++ b/src/Nes/Bus/SideEffect.hs
@@ -7,7 +7,7 @@ data CPUSideEffect = MkSE
     deriving (Eq, Show)
 
 instance Semigroup CPUSideEffect where
-    (MkSE irq1 dma1) <> (MkSE irq2 dma2) = MkSE (irq1 || irq2) (dma1 || dma2)
+    (MkSE !irq1 !dma1) <> (MkSE !irq2 !dma2) = MkSE (irq1 || irq2) (dma1 || dma2)
 
 instance Monoid CPUSideEffect where
     mempty = MkSE False False
diff --git a/src/Nes/CPU/Monad.hs b/src/Nes/CPU/Monad.hs
index 0718359..24701ef 100644
--- a/src/Nes/CPU/Monad.hs
+++ b/src/Nes/CPU/Monad.hs
@@ -7,6 +7,8 @@ module Nes.CPU.Monad (
 
     -- * Interracting with bus
     withBus,
+    withBusState,
+    setSideEffect,
 
     -- * State
     modifyCPUState,
@@ -35,12 +37,17 @@ module Nes.CPU.Monad (
     unsafeWithBus,
 ) where
 
+import Control.Monad
 import Control.Monad.IO.Class
 import Data.Bits (Bits (shiftR), testBit)
+import Nes.APU.Monad (modifyAPUState)
+import Nes.APU.State (APUState (dmc), modifyDMC)
+import Nes.APU.State.DMC (DMC (sampleBuffer, sampleBufferAddr))
 import Nes.Bus (Bus (..))
 import Nes.Bus.Constants
 import Nes.Bus.Monad (BusM, runBusM)
 import qualified Nes.Bus.Monad as BusM
+import Nes.Bus.SideEffect (CPUSideEffect (startDMCDMA))
 import Nes.CPU.State
 import Nes.FlagRegister
 import Nes.Interrupt
@@ -58,16 +65,16 @@ newtype CPU r a = MkCPU
 
 instance Applicative (CPU r) where
     {-# INLINE pure #-}
-    pure a = MkCPU $ \st prog cont -> cont st prog a
+    pure a = MkCPU $ \st bus cont -> cont st bus a
     {-# INLINE (<*>) #-}
-    (MkCPU f) <*> (MkCPU a) = MkCPU $ \st prog cont -> f st prog $
+    (MkCPU f) <*> (MkCPU a) = MkCPU $ \st bus cont -> f st bus $
         \st' prog' f' -> a st' prog' $
             \st'' prog'' a' -> cont st'' prog'' $ f' a'
 
 instance Monad (CPU r) where
     {-# INLINE (>>=) #-}
-    (MkCPU a) >>= next = MkCPU $ \st prog cont -> a st prog $
-        \st' prog' a' -> unCPU (next a') st' prog' cont
+    (MkCPU a) >>= next = MkCPU $ \st bus cont -> a st bus $
+        \st' bus' a' -> unCPU (next a') st' bus' cont
 
 instance MonadFail (CPU r) where
     {-# INLINE fail #-}
@@ -75,19 +82,25 @@ instance MonadFail (CPU r) where
 
 instance MonadIO (CPU r) where
     {-# INLINE liftIO #-}
-    liftIO io = MkCPU $ \st prog cont -> io >>= cont st prog
+    liftIO io = MkCPU $ \st bus cont -> io >>= cont st bus
 
 {-# INLINE modifyCPUState #-}
 modifyCPUState :: (CPUState -> CPUState) -> CPU r ()
-modifyCPUState f = MkCPU $ \st prog cont -> cont (f st) prog ()
+modifyCPUState f = MkCPU $ \st bus cont -> cont (f st) bus ()
 
 {-# INLINE withCPUState #-}
 withCPUState :: (CPUState -> a) -> CPU r a
-withCPUState f = MkCPU $ \st prog cont -> cont st prog (f st)
+withCPUState f = MkCPU $ \st bus cont -> cont st bus (f st)
+
+withBusState :: (Bus -> a) -> CPU r a
+withBusState f = MkCPU $ \st bus cont -> cont st bus (f bus)
 
 {-# INLINE getCycles #-}
 getCycles :: CPU r Integer
-getCycles = MkCPU $ \st bus cont -> cont st bus (cycles bus)
+getCycles = withBusState cycles
+
+setSideEffect :: (CPUSideEffect -> CPUSideEffect) -> CPU r ()
+setSideEffect f = MkCPU $ \st bus cont -> cont st bus{cpuSideEffect = f $ cpuSideEffect bus} ()
 
 {-# INLINE getPC #-}
 
@@ -95,7 +108,6 @@ getCycles = MkCPU $ \st bus cont -> cont st bus (cycles bus)
 getPC :: CPU r Addr
 getPC = withCPUState programCounter
 
-{-# INLINE setPC #-}
 setPC :: Addr -> CPU r ()
 setPC addr = modifyCPUState $ \st -> st{programCounter = addr}
 
@@ -134,9 +146,12 @@ pushAddrStack addr = do
 
 {-# INLINE withBus #-}
 withBus :: BusM (a, Bus) a -> CPU r a
-withBus f = MkCPU $ \st bus cont -> do
-    (res, bus') <- runBusM bus f
-    cont st bus' res
+withBus f = do
+    res <- MkCPU $ \st bus cont -> do
+        (res, bus') <- runBusM bus f
+        cont st bus' res
+    handleSideEffect
+    return res
 
 -- | Unsafe action that provides access to Bus
 --
@@ -194,10 +209,17 @@ instance MemoryInterface () (CPU r) where
 
 {-# INLINE tick #-}
 tick :: Int -> CPU r ()
-tick n = MkCPU $ \st bus cont -> do
-    ((), newbus) <- runBusM bus $ BusM.tick n
-    cont st newbus ()
+tick = withBus . BusM.tick
 
 {-# INLINE tickOnce #-}
 tickOnce :: CPU r ()
 tickOnce = Nes.CPU.Monad.tick 1
+
+handleSideEffect :: CPU r ()
+handleSideEffect = do
+    hasDMCDMA <- withBusState $ startDMCDMA . cpuSideEffect
+    when hasDMCDMA $ withBus $ do
+        sampleByteAddr <- BusM.withBus $ sampleBufferAddr . dmc . apuState
+        sample <- Nes.Memory.readByte sampleByteAddr ()
+        BusM.withAPU $ modifyAPUState $ modifyDMC $ \d -> d{sampleBuffer = Just sample}
+        BusM.modifyBus $ \b -> b{cpuSideEffect = (cpuSideEffect b){startDMCDMA = False}}

From b105e12b69da3d577ff7493ef9de4245f8e4dc02 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Mon, 10 Nov 2025 13:15:09 +0000
Subject: [PATCH 19/37] APU: Remove UNPACK pragmas for object fields

---
 src/Nes/APU/Monad.hs          | 13 +++++++------
 src/Nes/APU/State.hs          | 12 ++++++------
 src/Nes/APU/State/DMC.hs      |  2 +-
 src/Nes/APU/State/Noise.hs    |  4 ++--
 src/Nes/APU/State/Pulse.hs    |  4 ++--
 src/Nes/APU/State/Triangle.hs |  2 +-
 src/Nes/Bus/Monad.hs          |  2 +-
 7 files changed, 20 insertions(+), 19 deletions(-)

diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
index f62a60f..e24ca5b 100644
--- a/src/Nes/APU/Monad.hs
+++ b/src/Nes/APU/Monad.hs
@@ -26,7 +26,7 @@ instance Applicative (APU r) where
 
 instance Monad (APU r) where
     {-# INLINE (>>=) #-}
-    (MkAPU a) >>= next = MkAPU $ \st cpuEff cont ->
+    (MkAPU a) >>= next = MkAPU $ \(!st) !cpuEff cont ->
         a st cpuEff $ \(!st') (!cpuEff') (!a') -> unAPU (next a') st' (cpuEff <> cpuEff') cont
 
 instance MonadIO (APU r) where
@@ -39,19 +39,20 @@ instance MonadFail (APU r) where
 
 {-# INLINE runAPU #-}
 runAPU :: APUState -> APU (a, APUState, CPUSideEffect) a -> IO (a, APUState, CPUSideEffect)
-runAPU st f = unAPU f st mempty $ \(!st') (!cpuEff) a -> return (a, st', cpuEff)
+runAPU !st f = unAPU f st mempty $ \(!st') (!cpuEff) a -> return (a, st', cpuEff)
 
 {-# INLINE modifyAPUState #-}
 modifyAPUState :: (APUState -> APUState) -> APU r ()
-modifyAPUState f = MkAPU $ \st cpuEff cont -> cont (f st) cpuEff ()
+modifyAPUState f = MkAPU $ \(!st) (!cpuEff) cont -> cont (f st) cpuEff ()
 
 {-# INLINE modifyAPUStateWithSideEffect #-}
 modifyAPUStateWithSideEffect :: (APUState -> (APUState, CPUSideEffect)) -> APU r ()
-modifyAPUStateWithSideEffect f = MkAPU $ \st cpuEff cont -> let (st', sideEff) = f st in cont st' (cpuEff <> sideEff) ()
+modifyAPUStateWithSideEffect f = MkAPU $ \(!st) !cpuEff cont ->
+    let (st', sideEff) = f st in cont st' (cpuEff <> sideEff) ()
 
 {-# INLINE withAPUState #-}
 withAPUState :: (APUState -> a) -> APU r a
-withAPUState f = MkAPU $ \st cpuEff cont -> cont st cpuEff (f st)
+withAPUState f = MkAPU $ \(!st) !cpuEff cont -> cont st cpuEff (f st)
 
 setSideEffect :: CPUSideEffect -> APU r ()
-setSideEffect eff = MkAPU $ \st cpuEff cont -> cont st (cpuEff <> eff) ()
+setSideEffect eff = MkAPU $ \(!st) !cpuEff cont -> cont st (cpuEff <> eff) ()
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index e5df877..f511e81 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -21,12 +21,12 @@ import Nes.APU.State.Triangle
 import Nes.Bus.SideEffect (CPUSideEffect)
 
 data APUState = MkAPUState
-    { frameCounter :: {-# UNPACK #-} !FrameCounter
-    , pulse1 :: {-# UNPACK #-} !Pulse
-    , pulse2 :: {-# UNPACK #-} !Pulse
-    , triangle :: {-# UNPACK #-} !Triangle
-    , noise :: {-# UNPACK #-} !Noise
-    , dmc :: {-# UNPACK #-} !DMC
+    { frameCounter :: !FrameCounter
+    , pulse1 :: !Pulse
+    , pulse2 :: !Pulse
+    , triangle :: !Triangle
+    , noise :: !Noise
+    , dmc :: !DMC
     }
 
 newAPUState :: APUState
diff --git a/src/Nes/APU/State/DMC.hs b/src/Nes/APU/State/DMC.hs
index de06921..e680add 100644
--- a/src/Nes/APU/State/DMC.hs
+++ b/src/Nes/APU/State/DMC.hs
@@ -30,7 +30,7 @@ data DMC = MkDMC
     , sampleOgLength :: {-# UNPACK #-} !Int
     , sampleBufferAddr :: {-# UNPACK #-} !Addr -- Addr in memory of the sample buffer's byte
     , sampleBytesRemaining :: {-# UNPACK #-} !Int
-    , sampleBuffer :: {-# UNPACK #-} !(Maybe Byte)
+    , sampleBuffer :: !(Maybe Byte)
     , outputLevel :: {-# UNPACK #-} !Int
     , enableChannel :: {-# UNPACK #-} !Bool
     , shouldClock :: {-# UNPACK #-} !Bool
diff --git a/src/Nes/APU/State/Noise.hs b/src/Nes/APU/State/Noise.hs
index fc381f7..2a0f785 100644
--- a/src/Nes/APU/State/Noise.hs
+++ b/src/Nes/APU/State/Noise.hs
@@ -24,8 +24,8 @@ import Nes.APU.State.LengthCounter
 data Noise = MkN
     { useBit6ForFeedback :: {-# UNPACK #-} !Bool
     -- ^ AKA Mode flag
-    , envelope :: {-# UNPACK #-} !Envelope
-    , lengthCounter :: {-# UNPACK #-} !LengthCounter
+    , envelope :: !Envelope
+    , lengthCounter :: !LengthCounter
     , shiftRegister :: {-# UNPACK #-} !Word16
     , period :: {-# UNPACK #-} !Int
     , timer :: {-# UNPACK #-} !Int
diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
index eb72166..d5b52a9 100644
--- a/src/Nes/APU/State/Pulse.hs
+++ b/src/Nes/APU/State/Pulse.hs
@@ -28,12 +28,12 @@ data Pulse = MkP
     -- ^ Index for the 'dutySequences' table
     , dutyStep :: {-# UNPACK #-} !Int
     -- ^ Index for a row's element in the 'dutySequences' table
-    , lengthCounter :: {-# UNPACK #-} !LengthCounter
+    , lengthCounter :: !LengthCounter
     , period :: {-# UNPACK #-} !Int
     -- ^ Max value of the timer
     , timer :: {-# UNPACK #-} !Int
     -- ^ Decreases each tick, from 'period' to 0 and loops
-    , sweepUnit :: {-# UNPACK #-} !SweepUnit
+    , sweepUnit :: !SweepUnit
     , envelope :: {-# UNPACK #-} !Envelope
     }
 
diff --git a/src/Nes/APU/State/Triangle.hs b/src/Nes/APU/State/Triangle.hs
index 3181307..0f2da21 100644
--- a/src/Nes/APU/State/Triangle.hs
+++ b/src/Nes/APU/State/Triangle.hs
@@ -19,7 +19,7 @@ data Triangle = MkT
     { controlFlag :: {-# UNPACK #-} !Bool
     , reloadFlag :: {-# UNPACK #-} !Bool
     , reloadValue :: {-# UNPACK #-} !Int
-    , lengthCounter :: {-# UNPACK #-} !LengthCounter
+    , lengthCounter :: !LengthCounter
     , linearCounter :: {-# UNPACK #-} !Int
     , period :: {-# UNPACK #-} !Int
     , timer :: {-# UNPACK #-} !Int
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index 99c3e18..2149d75 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -91,7 +91,7 @@ tick n = MkBusM $ \bus cont -> do
         isNewFrame <- PPUM.tick (n * 3)
         after <- withPPUState nmiInterrupt
         return (isNewFrame, before, after)
-    ((), apuSt, cpuEff) <- runAPU (apuState bus) $ APU.tick (odd (Nes.Bus.cycles bus)) n
+    ((), !apuSt, !cpuEff) <- runAPU (apuState bus) $ APU.tick (odd (Nes.Bus.cycles bus)) n
     let bus' =
             bus
                 { unsleptCycles = newUnsleptCycles

From 584d2c03dc5e3360d5bcea42821ae418384dfabe Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Mon, 10 Nov 2025 20:26:51 +0000
Subject: [PATCH 20/37] APU: Inline Bus Interface

---
 src/Nes/APU/BusInterface.hs              | 2 ++
 src/Nes/APU/BusInterface/DMC.hs          | 4 ++++
 src/Nes/APU/BusInterface/FrameCounter.hs | 1 +
 src/Nes/APU/BusInterface/Noise.hs        | 3 +++
 src/Nes/APU/BusInterface/Pulse.hs        | 8 ++++++++
 src/Nes/APU/BusInterface/Status.hs       | 2 ++
 src/Nes/APU/BusInterface/Triangle.hs     | 3 +++
 7 files changed, 23 insertions(+)

diff --git a/src/Nes/APU/BusInterface.hs b/src/Nes/APU/BusInterface.hs
index fc924b4..21359ab 100644
--- a/src/Nes/APU/BusInterface.hs
+++ b/src/Nes/APU/BusInterface.hs
@@ -12,6 +12,7 @@ import Nes.APU.BusInterface.Triangle
 import Nes.APU.Monad
 import Nes.Memory (Addr, Byte (..))
 
+{-# INLINE writeToAPU #-}
 writeToAPU :: Addr -> Byte -> APU r ()
 writeToAPU addr = case addr of
     -- Pulse 1
@@ -43,6 +44,7 @@ writeToAPU addr = case addr of
     0x4017 -> write4017
     _ -> const (return ())
 
+{-# INLINE readFromAPU #-}
 readFromAPU :: Addr -> APU r (Maybe Byte)
 readFromAPU = \case
     -- TODO Not open bus
diff --git a/src/Nes/APU/BusInterface/DMC.hs b/src/Nes/APU/BusInterface/DMC.hs
index 323613d..921a5a4 100644
--- a/src/Nes/APU/BusInterface/DMC.hs
+++ b/src/Nes/APU/BusInterface/DMC.hs
@@ -6,6 +6,7 @@ import Nes.APU.State (modifyDMC)
 import Nes.APU.State.DMC
 import Nes.Memory
 
+{-# INLINE write4010 #-}
 write4010 :: Byte -> APU r ()
 write4010 byte = do
     let irq = byte `testBit` 7
@@ -19,17 +20,20 @@ write4010 byte = do
             , period = rate
             }
 
+{-# INLINE write4011 #-}
 write4011 :: Byte -> APU r ()
 write4011 byte = do
     let directLoad = byteToInt $ byte .&. 0b1111111
     -- TODO If the timer is outputting a clock at the same time, the output level is occasionally not changed properly.
     modifyAPUState $ modifyDMC $ \dmc -> dmc{outputLevel = directLoad}
 
+{-# INLINE write4012 #-}
 write4012 :: Byte -> APU r ()
 write4012 byte = do
     let sampleAddr = 0xC000 + (byteToAddr byte * 64)
     modifyAPUState $ modifyDMC $ \dmc -> dmc{sampleOgAddr = sampleAddr}
 
+{-# INLINE write4013 #-}
 write4013 :: Byte -> APU r ()
 write4013 byte = do
     let sampleLength = (byteToInt byte * 16) + 1
diff --git a/src/Nes/APU/BusInterface/FrameCounter.hs b/src/Nes/APU/BusInterface/FrameCounter.hs
index 05d1ab9..592b00b 100644
--- a/src/Nes/APU/BusInterface/FrameCounter.hs
+++ b/src/Nes/APU/BusInterface/FrameCounter.hs
@@ -9,6 +9,7 @@ import Nes.APU.Tick
 import Nes.Memory
 
 -- | Callback when a byte is written to 0x4017 through the Bus
+{-# INLINE write4017 #-}
 write4017 :: Byte -> APU r ()
 write4017 byte = do
     let seqMode = sequenceModeFromBool $ byte `testBit` 7
diff --git a/src/Nes/APU/BusInterface/Noise.hs b/src/Nes/APU/BusInterface/Noise.hs
index 742147a..65fbf2b 100644
--- a/src/Nes/APU/BusInterface/Noise.hs
+++ b/src/Nes/APU/BusInterface/Noise.hs
@@ -8,6 +8,7 @@ import Nes.APU.State.LengthCounter
 import Nes.APU.State.Noise
 import Nes.Memory
 
+{-# INLINE write400C #-}
 write400C :: Byte -> APU r ()
 write400C byte = do
     let haltLC = byte `testBit` 5
@@ -20,12 +21,14 @@ write400C byte = do
                 . withEnvelope
                     (\e -> e{constantVolume = byteToInt vol, useConstantVolume = constVol, loopFlag = haltLC})
 
+{-# INLINE write400E #-}
 write400E :: Byte -> APU r ()
 write400E byte = do
     let modeFlag = byte `testBit` 7
         periodIndex = byteToInt $ byte .&. 0b1111
     modifyAPUState $ modifyNoise $ \t -> t{period = getPeriodValue periodIndex, useBit6ForFeedback = modeFlag}
 
+{-# INLINE write400F #-}
 write400F :: Byte -> APU r ()
 write400F byte = do
     let newLCLoad = byteToInt $ byte `shiftR` 3
diff --git a/src/Nes/APU/BusInterface/Pulse.hs b/src/Nes/APU/BusInterface/Pulse.hs
index 37d41e5..f4713a2 100644
--- a/src/Nes/APU/BusInterface/Pulse.hs
+++ b/src/Nes/APU/BusInterface/Pulse.hs
@@ -20,9 +20,11 @@ import Nes.APU.State.LengthCounter
 import Nes.APU.State.Pulse
 import Nes.Memory
 
+{-# INLINE write4000 #-}
 write4000 :: Byte -> APU r ()
 write4000 = writePulseFirstByte modifyPulse1
 
+{-# INLINE write4004 #-}
 write4004 :: Byte -> APU r ()
 write4004 = writePulseFirstByte modifyPulse2
 
@@ -38,9 +40,11 @@ writePulseFirstByte setter byte = do
             withLengthCounter (\lc -> lc{isHalted = haltLC}) $
                 p{dutyIndex = fromIntegral $ unByte duty}
 
+{-# INLINE write4001 #-}
 write4001 :: Byte -> APU r ()
 write4001 = writePulseSecondByte modifyPulse1
 
+{-# INLINE write4005 #-}
 write4005 :: Byte -> APU r ()
 write4005 = writePulseSecondByte modifyPulse2
 
@@ -66,9 +70,11 @@ writePulseSecondByte setter byte = do
                             }
                     )
 
+{-# INLINE write4002 #-}
 write4002 :: Byte -> APU r ()
 write4002 = writePulseThirdByte modifyPulse1
 
+{-# INLINE write4006 #-}
 write4006 :: Byte -> APU r ()
 write4006 = writePulseThirdByte modifyPulse2
 
@@ -78,9 +84,11 @@ writePulseThirdByte setter byte = modifyAPUState $ setter $ \p ->
     let newPeriod = (period p .&. 0b11100000000) .|. byteToInt byte
      in updateTargetPeriod $ p{period = newPeriod}
 
+{-# INLINE write4003 #-}
 write4003 :: Byte -> APU r ()
 write4003 = writePulseFourthByte modifyPulse1
 
+{-# INLINE write4007 #-}
 write4007 :: Byte -> APU r ()
 write4007 = writePulseFourthByte modifyPulse2
 
diff --git a/src/Nes/APU/BusInterface/Status.hs b/src/Nes/APU/BusInterface/Status.hs
index 049e4ba..f4e02f9 100644
--- a/src/Nes/APU/BusInterface/Status.hs
+++ b/src/Nes/APU/BusInterface/Status.hs
@@ -9,6 +9,7 @@ import Nes.APU.State.FrameCounter
 import Nes.APU.State.LengthCounter
 import Nes.Memory
 
+{-# INLINE write4015 #-}
 write4015 :: Byte -> APU r ()
 write4015 byte = do
     let enablePulse1Lc = byte `testBit` 0
@@ -41,6 +42,7 @@ write4015 byte = do
             then if sampleBytesRemaining t == 0 then restartSample t else t
             else t{sampleBytesRemaining = 0}
 
+{-# INLINE read4015 #-}
 read4015 :: APU r Byte
 read4015 = do
     noiseBit <- withAPUState $ lengthCounterBit . noise
diff --git a/src/Nes/APU/BusInterface/Triangle.hs b/src/Nes/APU/BusInterface/Triangle.hs
index c306f5d..112b019 100644
--- a/src/Nes/APU/BusInterface/Triangle.hs
+++ b/src/Nes/APU/BusInterface/Triangle.hs
@@ -12,6 +12,7 @@ import Nes.APU.State.LengthCounter
 import Nes.APU.State.Triangle
 import Nes.Memory
 
+{-# INLINE write4008 #-}
 write4008 :: Byte -> APU r ()
 write4008 byte = do
     let control = byte `testBit` 7
@@ -21,11 +22,13 @@ write4008 byte = do
             withLengthCounter (\lc -> lc{isHalted = control})
                 . \t -> t{controlFlag = control, reloadValue = reload}
 
+{-# INLINE write400A #-}
 write400A :: Byte -> APU r ()
 write400A periodLow = modifyAPUState $ modifyTriangle $ \t ->
     let newPeriod = (period t .&. 0b11100000000) .|. byteToInt periodLow
      in t{period = newPeriod}
 
+{-# INLINE write400B #-}
 write400B :: Byte -> APU r ()
 write400B byte = modifyAPUState $ modifyTriangle $ \t ->
     let timerHigh = byteToInt $ byte .&. 0b111

From ec3e0e59e05cb60df615498a33a9299ae25572b0 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Mon, 10 Nov 2025 20:56:32 +0000
Subject: [PATCH 21/37] APU: Inline more functions

---
 src/Nes/APU/Monad.hs               | 1 +
 src/Nes/APU/State/DMC.hs           | 1 +
 src/Nes/APU/State/Envelope.hs      | 1 +
 src/Nes/APU/State/LengthCounter.hs | 3 +++
 src/Nes/APU/State/Pulse.hs         | 3 +++
 src/Nes/APU/State/Triangle.hs      | 1 +
 6 files changed, 10 insertions(+)

diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
index e24ca5b..fc3584d 100644
--- a/src/Nes/APU/Monad.hs
+++ b/src/Nes/APU/Monad.hs
@@ -54,5 +54,6 @@ modifyAPUStateWithSideEffect f = MkAPU $ \(!st) !cpuEff cont ->
 withAPUState :: (APUState -> a) -> APU r a
 withAPUState f = MkAPU $ \(!st) !cpuEff cont -> cont st cpuEff (f st)
 
+{-# INLINE setSideEffect #-}
 setSideEffect :: CPUSideEffect -> APU r ()
 setSideEffect eff = MkAPU $ \(!st) !cpuEff cont -> cont st (cpuEff <> eff) ()
diff --git a/src/Nes/APU/State/DMC.hs b/src/Nes/APU/State/DMC.hs
index e680add..c5a9efb 100644
--- a/src/Nes/APU/State/DMC.hs
+++ b/src/Nes/APU/State/DMC.hs
@@ -72,6 +72,7 @@ restartSample dmc =
         , shouldClock = sampleOgLength dmc > 0
         }
 
+{-# INLINE getDMCOutput #-}
 getDMCOutput :: DMC -> Int
 getDMCOutput dmc = if silentFlag dmc then 0 else outputLevel dmc
 
diff --git a/src/Nes/APU/State/Envelope.hs b/src/Nes/APU/State/Envelope.hs
index 2c78734..8acf79e 100644
--- a/src/Nes/APU/State/Envelope.hs
+++ b/src/Nes/APU/State/Envelope.hs
@@ -30,6 +30,7 @@ class HasEnvelope a where
     getEnvelope :: a -> Envelope
     setEnvelope :: Envelope -> a -> a
 
+{-# INLINE withEnvelope #-}
 withEnvelope :: (HasEnvelope a) => (Envelope -> Envelope) -> a -> a
 withEnvelope f a = setEnvelope (f $ getEnvelope a) a
 
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
index 6698e4a..6db34bf 100644
--- a/src/Nes/APU/State/LengthCounter.hs
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -28,6 +28,7 @@ tickLengthCounter lc =
         then lc{remainingLength = remainingLength lc - 1}
         else lc
 
+{-# INLINE clearAndHaltLengthCounter #-}
 clearAndHaltLengthCounter :: LengthCounter -> LengthCounter
 clearAndHaltLengthCounter lc = lc{remainingLength = 0, isHalted = True}
 
@@ -43,9 +44,11 @@ class HasLengthCounter a where
     getLengthCounter :: a -> LengthCounter
     setLengthCounter :: LengthCounter -> a -> a
 
+{-# INLINE withLengthCounter #-}
 withLengthCounter :: (HasLengthCounter a) => (LengthCounter -> LengthCounter) -> a -> a
 withLengthCounter f a = setLengthCounter (f $ getLengthCounter a) a
 
+{-# INLINE isSilencedByLengthCounter #-}
 isSilencedByLengthCounter :: (HasLengthCounter a) => a -> Bool
 isSilencedByLengthCounter = (== 0) . remainingLength . getLengthCounter
 
diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
index d5b52a9..b693a66 100644
--- a/src/Nes/APU/State/Pulse.hs
+++ b/src/Nes/APU/State/Pulse.hs
@@ -62,9 +62,11 @@ data SweepUnit = MkSU
     , isPulse1 :: Bool
     }
 
+{-# INLINE modifySweep #-}
 modifySweep :: (SweepUnit -> SweepUnit) -> Pulse -> Pulse
 modifySweep f p = p{sweepUnit = f (sweepUnit p)}
 
+{-# INLINE withSweep #-}
 withSweep :: (SweepUnit -> a) -> Pulse -> a
 withSweep f p = f (sweepUnit p)
 
@@ -126,6 +128,7 @@ instance HasEnvelope Pulse where
     getEnvelope = envelope
     setEnvelope e a = a{envelope = e}
 
+{-# INLINE getPulseOutput #-}
 getPulseOutput :: Pulse -> Int
 getPulseOutput p =
     let dutyValue = fromMaybe 0 ((dutySequences !? dutyIndex p) >>= (!? dutyStep p))
diff --git a/src/Nes/APU/State/Triangle.hs b/src/Nes/APU/State/Triangle.hs
index 0f2da21..4b2a8ae 100644
--- a/src/Nes/APU/State/Triangle.hs
+++ b/src/Nes/APU/State/Triangle.hs
@@ -44,6 +44,7 @@ getSequenceValue t = if step <= 15 then 15 - step else step - 16
   where
     step = sequenceStep t
 
+{-# INLINE getTriangleOutput #-}
 getTriangleOutput :: Triangle -> Int
 getTriangleOutput t = if remainingLength (lengthCounter t) /= 0 then getSequenceValue t else 0
 

From 51d616ec7d68b1c7d0cf3fd6da2a4768a067d1d3 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Mon, 10 Nov 2025 20:57:15 +0000
Subject: [PATCH 22/37] APU: Mixer, Filter Chain + Send sound to SDL2

---
 app/Main.hs                       | 30 ++++++++++++-
 examples/Snake.hs                 |  2 +-
 funes.cabal                       |  2 +
 src/Nes/APU/Mixer.hs              | 33 ++++++++++++++
 src/Nes/APU/State.hs              | 13 +++++-
 src/Nes/APU/State/Filter.hs       | 75 +++++++++++++++++++++++++++++++
 src/Nes/APU/State/FrameCounter.hs | 50 +++++++++++++++++++--
 src/Nes/APU/Tick.hs               | 48 ++++++++++++++++----
 src/Nes/Bus.hs                    |  6 +--
 src/Nes/Bus/Monad.hs              |  2 +-
 10 files changed, 241 insertions(+), 20 deletions(-)
 create mode 100644 src/Nes/APU/Mixer.hs
 create mode 100644 src/Nes/APU/State/Filter.hs

diff --git a/app/Main.hs b/app/Main.hs
index cfcc63b..e73ada0 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,6 +1,8 @@
 module Main (main) where
 
 import Control.Monad
+import Data.IORef
+import qualified Data.Vector.Storable.Mutable as V
 import Events
 import Nes.Bus
 import Nes.Bus.Monad (runBusM)
@@ -25,6 +27,7 @@ main = do
     rom <- do
         res <- fromFile romPath
         either fail return res
+    audioSamples <- newIORef []
     initializeAll
     let windowConfig =
             defaultWindow
@@ -34,6 +37,17 @@ main = do
                         (240 * 3)
                 , windowPosition = Centered
                 }
+    (device, _) <-
+        openAudioDevice
+            OpenDeviceSpec
+                { SDL.openDeviceFreq = Mandate 44100
+                , SDL.openDeviceFormat = Mandate FloatingLEAudio
+                , SDL.openDeviceChannels = Mandate Mono
+                , SDL.openDeviceSamples = 512
+                , SDL.openDeviceCallback = audioCallback audioSamples
+                , SDL.openDeviceUsage = ForPlayback
+                , SDL.openDeviceName = Nothing
+                }
     window <- createWindow "FuNes" windowConfig
     renderer@(Renderer rendererPtr) <-
         createRenderer
@@ -43,9 +57,13 @@ main = do
     _ <- setHintWithPriority NormalPriority HintRenderVSync DisableVSync
     _ <- Raw.renderSetScale rendererPtr 3 3
     texture <- createTexture renderer RGB24 TextureAccessTarget (V2 256 240)
+    setAudioDevicePlaybackState device Play
     frame <- newFrameState
-    bus <- newBus rom (onDrawFrame frame texture renderer) tickCallback
+    let sampleCallback sample = do
+            modifyIORef audioSamples $ \array -> sample : array
+    bus <- newBus rom (onDrawFrame frame texture renderer) sampleCallback tickCallback
     void $ runProgram bus (pure ())
+    closeAudioDevice device
     destroyRenderer renderer
 
 tickCallback :: Double -> Int -> IO (Double, Int)
@@ -76,6 +94,16 @@ tickCallback lastSleepTime_ ticks_ = return (lastSleepTime_, ticks_)
 --   -- Frequency in Hz
 --   cpuFrequency = 1.789773 * 1000000
 
+audioCallback :: IORef [Float] -> AudioFormat sampleType -> V.IOVector sampleType -> IO ()
+audioCallback samples fmt buffer = case fmt of
+    FloatingLEAudio -> do
+        samples' <- readIORef samples
+        let n = V.length buffer
+            samples1 = reverse samples'
+        zipWithM_ (V.write buffer) [0 ..] (take n samples1)
+        writeIORef samples (reverse $ drop n samples1)
+    _ -> error "Unsupported audio format"
+
 onDrawFrame :: FrameState -> Texture -> Renderer -> Bus -> IO Bus
 onDrawFrame frame texture renderer bus = do
     bs <- runRender (render bus R.>> toSDL2ByteString) frame
diff --git a/examples/Snake.hs b/examples/Snake.hs
index 5da1a87..de50a51 100644
--- a/examples/Snake.hs
+++ b/examples/Snake.hs
@@ -48,7 +48,7 @@ main = do
     texture <- createTexture renderer RGB24 TextureAccessTarget (V2 32 32)
     frame <- newArray @IOUArray (0, frameSize) (0 :: Word8)
     let cpuState = newCPUState{programCounter = programOffset}
-    bus <- newBus unsafeEmptyRom pure (\a b -> pure (a, b))
+    bus <- newBus unsafeEmptyRom pure (\_ -> pure ()) (\a b -> pure (a, b))
     loadProgramToMemory gameCode bus
     _ <- runProgram' cpuState bus (callback frame texture renderer)
     destroyRenderer renderer
diff --git a/funes.cabal b/funes.cabal
index 8212ffc..a35bd62 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -31,10 +31,12 @@ library
       Nes.APU.BusInterface.Pulse
       Nes.APU.BusInterface.Status
       Nes.APU.BusInterface.Triangle
+      Nes.APU.Mixer
       Nes.APU.Monad
       Nes.APU.State
       Nes.APU.State.DMC
       Nes.APU.State.Envelope
+      Nes.APU.State.Filter
       Nes.APU.State.FrameCounter
       Nes.APU.State.LengthCounter
       Nes.APU.State.Noise
diff --git a/src/Nes/APU/Mixer.hs b/src/Nes/APU/Mixer.hs
new file mode 100644
index 0000000..e413129
--- /dev/null
+++ b/src/Nes/APU/Mixer.hs
@@ -0,0 +1,33 @@
+module Nes.APU.Mixer (runMixer) where
+
+import Nes.APU.State
+import Nes.APU.State.DMC (getDMCOutput)
+import Nes.APU.State.Filter
+import Nes.APU.State.Noise (getNoiseOutput)
+import Nes.APU.State.Pulse (getPulseOutput)
+import Nes.APU.State.Triangle (getTriangleOutput)
+
+runMixer :: APUState -> (Float, APUState)
+runMixer st =
+    let
+        pulse1Out = getPulseOutput . pulse1 $ st
+        pulse2Out = getPulseOutput . pulse2 $ st
+        triangleOut = getTriangleOutput . triangle $ st
+        noiseOut = getNoiseOutput . noise $ st
+        dmcOut = getDMCOutput . dmc $ st
+        pulseOut = pulseTable (pulse1Out + pulse2Out)
+        tndOut = tndTable (3 * triangleOut + 2 * noiseOut + dmcOut)
+        mixerOutput = pulseOut + tndOut
+        (res, newFilters) = processSample mixerOutput $ filterChain st
+     in
+        (res, st{filterChain = newFilters})
+
+{-# INLINE pulseTable #-}
+pulseTable :: Int -> Float
+pulseTable 0 = 0
+pulseTable n = 95.52 / ((8128.0 / fromIntegral n) + 100)
+
+{-# INLINE tndTable #-}
+tndTable :: Int -> Float
+tndTable 0 = 0
+tndTable n = 163.67 / ((24329.0 / fromIntegral n) + 100)
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index f511e81..c174746 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -11,9 +11,11 @@ module Nes.APU.State (
     modifyNoise,
     modifyDMC,
     modifyDMC',
+    setCycleDeltaSinceLastSample,
 ) where
 
 import Nes.APU.State.DMC
+import Nes.APU.State.Filter
 import Nes.APU.State.FrameCounter
 import Nes.APU.State.Noise
 import Nes.APU.State.Pulse
@@ -27,11 +29,18 @@ data APUState = MkAPUState
     , triangle :: !Triangle
     , noise :: !Noise
     , dmc :: !DMC
+    , filterChain :: !FilterChain
+    , cycleDeltaSinceLastSample :: {-# UNPACK #-} !Int
+    , pushSampleCallback :: !(Float -> IO ())
     }
 
-newAPUState :: APUState
+newAPUState :: (Float -> IO ()) -> APUState
 newAPUState =
-    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle newNoise newDMC
+    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle newNoise newDMC newFilterChain 0
+
+setCycleDeltaSinceLastSample :: (Int -> Int) -> APUState -> APUState
+setCycleDeltaSinceLastSample f fc =
+    fc{cycleDeltaSinceLastSample = f $ cycleDeltaSinceLastSample fc}
 
 {-# INLINE modifyPulse1 #-}
 modifyPulse1 :: (Pulse -> Pulse) -> APUState -> APUState
diff --git a/src/Nes/APU/State/Filter.hs b/src/Nes/APU/State/Filter.hs
new file mode 100644
index 0000000..4c84766
--- /dev/null
+++ b/src/Nes/APU/State/Filter.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Nes.APU.State.Filter (
+    -- * Filter chain
+    FilterChain (..),
+    newFilterChain,
+    processSample,
+
+    -- * Filter
+    lowPassFilter,
+    highPassFilter,
+    filterProcessSample,
+) where
+
+import Prelude hiding (filter)
+
+-- Source: https://github.com/luckasRanarison/mes/blob/main/crates/mes-core/src/apu/filters.rs#L58
+
+newtype FilterChain = MkFC {unFC :: [Filter]}
+
+newFilterChain :: FilterChain
+newFilterChain = MkFC [highPassFilter 44100 90, highPassFilter 44100 440, lowPassFilter 44100 14000]
+
+processSample :: Float -> FilterChain -> (Float, FilterChain)
+processSample sample chain =
+    let
+        (res, newChain) =
+            foldl
+                ( \(sample', newFilters) filter ->
+                    let
+                        (filteredSample, filter') = filterProcessSample sample' filter
+                     in
+                        (filteredSample, newFilters ++ [filter'])
+                )
+                (sample, [])
+                $ unFC chain
+     in
+        (res, MkFC newChain)
+
+data Filter = MkF
+    { b0 :: {-# UNPACK #-} !Float
+    , b1 :: {-# UNPACK #-} !Float
+    , a1 :: {-# UNPACK #-} !Float
+    , prevX :: {-# UNPACK #-} !Float
+    , prevY :: {-# UNPACK #-} !Float
+    }
+
+lowPassFilter :: Float -> Float -> Filter
+lowPassFilter sampleRate freq = MkF{..}
+  where
+    b0 = a0
+    b1 = a0
+    a1 = (1.0 - c) * a0
+    prevX = 0.0
+    prevY = 0.0
+    c = sampleRate / (freq * pi)
+    a0 = 1.0 / (1.0 + c)
+
+highPassFilter :: Float -> Float -> Filter
+highPassFilter sampleRate freq = MkF{..}
+  where
+    b0 = c * a0
+    b1 = (-c) * a0
+    a1 = (1.0 - c) * a0
+    prevX = 0.0
+    prevY = 0.0
+    c = sampleRate / (freq * pi)
+    a0 = 1.0 / (1.0 + c)
+
+{-# INLINE filterProcessSample #-}
+filterProcessSample :: Float -> Filter -> (Float, Filter)
+filterProcessSample sample f@MkF{..} = (res, newFilter)
+  where
+    res = b0 * sample + b1 * prevX - a1 * prevY
+    newFilter = f{prevX = sample, prevY = res}
diff --git a/src/Nes/APU/State/FrameCounter.hs b/src/Nes/APU/State/FrameCounter.hs
index 7edf425..2c51e28 100644
--- a/src/Nes/APU/State/FrameCounter.hs
+++ b/src/Nes/APU/State/FrameCounter.hs
@@ -6,35 +6,79 @@ module Nes.APU.State.FrameCounter (
     SequenceMode (..),
     sequenceModeFromBool,
 
-    -- * Sequence step
+    -- * Utils
+    shouldIncrementSequenceStep,
+    shouldResetSequenceStep,
     incrementSequenceStep,
+    resetSequence,
+    setCycles,
 ) where
 
+import Data.List ((!?))
+
 data SequenceMode = FourStep | FiveStep deriving (Eq, Show, Enum)
 
+{-# INLINE sequenceModeFromBool #-}
 sequenceModeFromBool :: Bool -> SequenceMode
 sequenceModeFromBool = toEnum . fromEnum
 
+{-# INLINE sequenceModeStepCount #-}
 sequenceModeStepCount :: SequenceMode -> Int
 sequenceModeStepCount = \case
     FourStep -> 4
     FiveStep -> 5
 
+sequenceStepCycles :: SequenceMode -> [Int]
+sequenceStepCycles = \case
+    FourStep -> [3728, 7456, 11185, 14914, 14915]
+    FiveStep -> [3728, 7456, 11185, 14914, 18640, 18641]
+
+{-# INLINE shouldIncrementSequenceStep #-}
+shouldIncrementSequenceStep :: FrameCounter -> Bool
+shouldIncrementSequenceStep fc =
+    let
+        table = sequenceStepCycles $ sequenceMode fc
+     in
+        case table !? sequenceStep fc of
+            Nothing -> False
+            Just s -> cycles fc >= s
+
+{-# INLINE shouldResetSequenceStep #-}
+shouldResetSequenceStep :: FrameCounter -> Bool
+shouldResetSequenceStep fc =
+    let
+        table = sequenceStepCycles $ sequenceMode fc
+     in
+        case table !? 5 of
+            Nothing -> False
+            Just s -> cycles fc >= s
+
 data FrameCounter = MkFC
     { sequenceMode :: {-# UNPACK #-} !SequenceMode
     , frameInterruptFlag :: {-# UNPACK #-} !Bool
     , inhibitInterrupt :: {-# UNPACK #-} !Bool
     , sequenceStep :: {-# UNPACK #-} !Int
+    , cycles :: {-# UNPACK #-} !Int
     }
 
 newFrameCounter :: FrameCounter
-newFrameCounter = MkFC FourStep False False 0
+newFrameCounter = MkFC FourStep False False 0 0
+
+{-# INLINE resetSequence #-}
+resetSequence :: FrameCounter -> FrameCounter
+resetSequence fc = fc{cycles = 0, sequenceStep = 0}
+
+{-# INLINE setCycles #-}
+setCycles :: (Int -> Int) -> FrameCounter -> FrameCounter
+setCycles f fc = fc{cycles = f $ cycles fc}
 
 -- | Increment 'sequenceStep', or set to zero when sequence ends
+{-# INLINE incrementSequenceStep #-}
 incrementSequenceStep :: FrameCounter -> FrameCounter
 incrementSequenceStep fc =
     fc
-        { sequenceStep = nextStep `mod` maxStep
+        { sequenceStep = nextStep `mod` (maxStep + 1)
+        -- To get end of sequence
         }
   where
     nextStep = sequenceStep fc + 1
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index b973fd9..5edba80 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -13,6 +13,8 @@ module Nes.APU.Tick (
 ) where
 
 import Control.Monad
+import Control.Monad.IO.Class
+import Nes.APU.Mixer
 import Nes.APU.Monad
 import Nes.APU.State
 import Nes.APU.State.DMC
@@ -22,6 +24,7 @@ import qualified Nes.APU.State.FrameCounter as FC
 import Nes.APU.State.LengthCounter
 import Nes.APU.State.Pulse
 import Nes.APU.State.Triangle
+import Nes.Bus.SideEffect (CPUSideEffect (setIRQ))
 
 -- $use
 --     The APU being a part of the CPU, they both tick at the same time. However, some ticks are updated every other CPU cycles.
@@ -33,10 +36,12 @@ type IsAPUCycle = Bool
 -- | Calls 'tick' n amount of time
 --
 -- the first parameter says whether the first tick is an APU cycle or not
+{-# INLINE tick #-}
 tick :: IsAPUCycle -> Int -> APU r ()
 tick _ 0 = return ()
 tick b n = tickOnce b >> tick (not b) (n - 1)
 
+{-# INLINE tickOnce #-}
 tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
     modifyAPUStateWithSideEffect $ modifyDMC' tickDMC
@@ -46,24 +51,49 @@ tickOnce isAPUCycle = do
             modifyPulse1 tickPulse
                 . modifyPulse2 tickPulse
         tickFrameCounter
+    delta <- withAPUState cycleDeltaSinceLastSample
+    if delta > 40
+        then do
+            (sample, st'') <- withAPUState runMixer
+            modifyAPUState $ const st''
+            callback <- withAPUState pushSampleCallback
+            liftIO $ callback sample
+            modifyAPUState $ setCycleDeltaSinceLastSample (const 0)
+        else
+            modifyAPUState $
+                setCycleDeltaSinceLastSample (+ 1)
 
 -- | Tells the frame counter to tick channels
 --
 -- Source: https://www.nesdev.org/wiki/APU_Frame_Counter
 tickFrameCounter :: APU r ()
 tickFrameCounter = do
+    reset <- withAPUState $ shouldResetSequenceStep . frameCounter
     seqMode <- withAPUState $ sequenceMode . frameCounter
-    case seqMode of
-        FourStep -> tickFrameCounterFourStep
-        FiveStep -> tickFrameCounterFiveStep
-    modifyAPUState $ modifyFrameCounter incrementSequenceStep
+    if reset
+        then resetFrameCounterSequence
+        else do
+            fc <- withAPUState frameCounter
+            when (shouldIncrementSequenceStep fc) $ do
+                case seqMode of
+                    FourStep -> tickFrameCounterFourStep
+                    FiveStep -> tickFrameCounterFiveStep
+                modifyAPUState $ modifyFrameCounter incrementSequenceStep
+            modifyAPUState $ modifyFrameCounter $ setCycles (+ 1)
+
+resetFrameCounterSequence :: APU r ()
+resetFrameCounterSequence = do
+    modifyAPUState $ modifyFrameCounter resetSequence
+    seqMode <- withAPUState $ sequenceMode . frameCounter
+    inhibitFrameInterrupt <- withAPUState $ inhibitInterrupt . frameCounter
+    when (seqMode == FourStep && not inhibitFrameInterrupt) $ do
+        setFrameInterruptFlag True
 
 tickFrameCounterFourStep :: APU r ()
 tickFrameCounterFourStep = do
     step <- withAPUState $ FC.sequenceStep . frameCounter
     inhibitFrameInterrupt <- withAPUState $ inhibitInterrupt . frameCounter
-
-    when (step < 4) runHalfFrameEvent
+    when (step < 4) runQuarterFrameEvent
     when (step == 1 || step == 3) runHalfFrameEvent
     when (step == 3 && not inhibitFrameInterrupt) $
         setFrameInterruptFlag True
@@ -71,7 +101,7 @@ tickFrameCounterFourStep = do
 tickFrameCounterFiveStep :: APU r ()
 tickFrameCounterFiveStep = do
     step <- withAPUState $ FC.sequenceStep . frameCounter
-    when (step < 5) runQuarterFrameEvent
+    when (step < 5 && step /= 3) runQuarterFrameEvent
     when (step == 1 || step == 4) runHalfFrameEvent
 
 runQuarterFrameEvent :: APU r ()
@@ -83,7 +113,6 @@ runQuarterFrameEvent = do
             . modifyTriangle tickTriangleLinearCounter
 
 runHalfFrameEvent :: APU r ()
--- TODO tick all lengthcounters
 runHalfFrameEvent = modifyAPUState $ \st ->
     st
         { pulse1 = withLengthCounter tickLengthCounter $ tickSweepUnit (pulse1 st)
@@ -93,9 +122,10 @@ runHalfFrameEvent = modifyAPUState $ \st ->
         }
 
 -- | Set the Frame Counter's Frame flag
+{-# INLINE setFrameInterruptFlag #-}
 setFrameInterruptFlag :: Bool -> APU r ()
 setFrameInterruptFlag b = do
-    -- TODO Connect to CPU 's IRQ
+    setSideEffect $ mempty{setIRQ = True}
     modifyAPUState $
         modifyFrameCounter $
             \fc -> fc{frameInterruptFlag = b}
diff --git a/src/Nes/Bus.hs b/src/Nes/Bus.hs
index 9f9cb20..d65864e 100644
--- a/src/Nes/Bus.hs
+++ b/src/Nes/Bus.hs
@@ -47,8 +47,8 @@ data Bus = Bus
     , cpuSideEffect :: {-# UNPACK #-} !CPUSideEffect
     }
 
-newBus :: Rom -> (Bus -> IO Bus) -> (Double -> Int -> IO (Double, Int)) -> IO Bus
-newBus rom_ onNewFrame_ tickCallback_ = do
+newBus :: Rom -> (Bus -> IO Bus) -> (Float -> IO ()) -> (Double -> Int -> IO (Double, Int)) -> IO Bus
+newBus rom_ onNewFrame_ pushSample_ tickCallback_ = do
     fptr <- callocForeignPtr vramSize
     ppuPtrs <- newPPUPointers
     let ppuSt = newPPUState (mirroring rom_)
@@ -65,5 +65,5 @@ newBus rom_ onNewFrame_ tickCallback_ = do
             ppuPtrs
             onNewFrame_
             0
-            newAPUState
+            (newAPUState pushSample_)
             mempty
diff --git a/src/Nes/Bus/Monad.hs b/src/Nes/Bus/Monad.hs
index 2149d75..520b49b 100644
--- a/src/Nes/Bus/Monad.hs
+++ b/src/Nes/Bus/Monad.hs
@@ -70,7 +70,7 @@ withPPU f = MkBusM $ \bus cont -> do
 {-# INLINE withAPU #-}
 withAPU :: APU (a, APUState, CPUSideEffect) a -> BusM r a
 withAPU f = MkBusM $ \bus cont -> do
-    (res, apuSt, cpuEff) <- runAPU (apuState bus) f
+    (!res, !apuSt, !cpuEff) <- runAPU (apuState bus) f
     cont (bus{apuState = apuSt, cpuSideEffect = cpuEff}) res
 
 {-# INLINE withController #-}

From 96889dcc852b7766fa5e8971d2b3c8c819147306 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Tue, 11 Nov 2025 13:24:15 +0000
Subject: [PATCH 23/37] APU: Frame Counter: Reset timer after delay

---
 src/Nes/APU/BusInterface/FrameCounter.hs |  7 ++---
 src/Nes/APU/State/FrameCounter.hs        |  3 +-
 src/Nes/APU/Tick.hs                      | 37 ++++++++++++++++++++----
 3 files changed, 36 insertions(+), 11 deletions(-)

diff --git a/src/Nes/APU/BusInterface/FrameCounter.hs b/src/Nes/APU/BusInterface/FrameCounter.hs
index 592b00b..6ec9d7c 100644
--- a/src/Nes/APU/BusInterface/FrameCounter.hs
+++ b/src/Nes/APU/BusInterface/FrameCounter.hs
@@ -12,14 +12,13 @@ import Nes.Memory
 {-# INLINE write4017 #-}
 write4017 :: Byte -> APU r ()
 write4017 byte = do
+    c <- withAPUState cycleDeltaSinceLastSample
     let seqMode = sequenceModeFromBool $ byte `testBit` 7
         inhibit = byte `testBit` 6
+        delay = if even c then 4 else 3 -- TODO Should use CPU cycle instead
     modifyAPUState $
         modifyFrameCounter $
-            \fc -> fc{sequenceMode = seqMode, inhibitInterrupt = inhibit}
+            \fc -> fc{sequenceMode = seqMode, inhibitInterrupt = inhibit, delayedWriteSideEffectCycle = Just delay}
     -- If the mode flag is set, then both "quarter frame" and "half frame" signals are also generated
-    when (seqMode == FiveStep) $ do
-        runQuarterFrameEvent
-        runHalfFrameEvent
     when inhibit $ do
         setFrameInterruptFlag False
diff --git a/src/Nes/APU/State/FrameCounter.hs b/src/Nes/APU/State/FrameCounter.hs
index 2c51e28..f77bbc4 100644
--- a/src/Nes/APU/State/FrameCounter.hs
+++ b/src/Nes/APU/State/FrameCounter.hs
@@ -59,10 +59,11 @@ data FrameCounter = MkFC
     , inhibitInterrupt :: {-# UNPACK #-} !Bool
     , sequenceStep :: {-# UNPACK #-} !Int
     , cycles :: {-# UNPACK #-} !Int
+    , delayedWriteSideEffectCycle :: !(Maybe Int)
     }
 
 newFrameCounter :: FrameCounter
-newFrameCounter = MkFC FourStep False False 0 0
+newFrameCounter = MkFC FourStep False False 0 0 Nothing
 
 {-# INLINE resetSequence #-}
 resetSequence :: FrameCounter -> FrameCounter
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index 5edba80..02724a1 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -44,6 +44,7 @@ tick b n = tickOnce b >> tick (not b) (n - 1)
 {-# INLINE tickOnce #-}
 tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
+    tickDelayedWriteBuffer
     modifyAPUStateWithSideEffect $ modifyDMC' tickDMC
     modifyAPUState $ modifyTriangle tickTriangle
     when isAPUCycle $ do
@@ -51,14 +52,20 @@ tickOnce isAPUCycle = do
             modifyPulse1 tickPulse
                 . modifyPulse2 tickPulse
         tickFrameCounter
+
     delta <- withAPUState cycleDeltaSinceLastSample
-    if delta > 40
+    sample <- runMixer
+    modifyAPUState $ setSampleBufferSum (+ sample)
+    isEven <- withAPUState evenSampleCallbackCall
+    if delta >= (if isEven then 40 else 41)
         then do
-            (sample, st'') <- withAPUState runMixer
-            modifyAPUState $ const st''
+            sampleSum <- withAPUState samplesBufferSum
             callback <- withAPUState pushSampleCallback
-            liftIO $ callback sample
-            modifyAPUState $ setCycleDeltaSinceLastSample (const 0)
+            liftIO $ callback (sampleSum / fromIntegral delta)
+            modifyAPUState $
+                setCycleDeltaSinceLastSample (const 0)
+                    . setSampleBufferSum (const 0)
+                    . (\st -> st{evenSampleCallbackCall = not isEven})
         else
             modifyAPUState $
                 setCycleDeltaSinceLastSample (+ 1)
@@ -81,6 +88,24 @@ tickFrameCounter = do
                 modifyAPUState $ modifyFrameCounter incrementSequenceStep
             modifyAPUState $ modifyFrameCounter $ setCycles (+ 1)
 
+tickDelayedWriteBuffer :: APU r ()
+tickDelayedWriteBuffer = do
+    fc <- withAPUState frameCounter
+    case delayedWriteSideEffectCycle fc of
+        Nothing -> return ()
+        Just 0 -> do
+            seqMode <- withAPUState $ sequenceMode . frameCounter
+            modifyAPUState $
+                modifyFrameCounter $
+                    const fc{delayedWriteSideEffectCycle = Nothing, FC.sequenceStep = 0, cycles = 0}
+            when (seqMode == FiveStep) $ do
+                runQuarterFrameEvent
+                runHalfFrameEvent
+        Just n ->
+            modifyAPUState $
+                modifyFrameCounter $
+                    const fc{delayedWriteSideEffectCycle = Just $ n - 1}
+
 resetFrameCounterSequence :: APU r ()
 resetFrameCounterSequence = do
     modifyAPUState $ modifyFrameCounter resetSequence
@@ -125,7 +150,7 @@ runHalfFrameEvent = modifyAPUState $ \st ->
 {-# INLINE setFrameInterruptFlag #-}
 setFrameInterruptFlag :: Bool -> APU r ()
 setFrameInterruptFlag b = do
-    setSideEffect $ mempty{setIRQ = True}
+    setSideEffect $ \st -> st{setIRQ = b}
     modifyAPUState $
         modifyFrameCounter $
             \fc -> fc{frameInterruptFlag = b}

From e8d3c35a73b6fb7f4246039458976e9742f13235 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Tue, 11 Nov 2025 13:25:01 +0000
Subject: [PATCH 24/37] APU: Length Counter: Explicit enabled flag

---
 src/Nes/APU/BusInterface/Status.hs | 45 +++++++++++++-----------------
 src/Nes/APU/State/LengthCounter.hs | 20 +++++++++----
 2 files changed, 34 insertions(+), 31 deletions(-)

diff --git a/src/Nes/APU/BusInterface/Status.hs b/src/Nes/APU/BusInterface/Status.hs
index f4e02f9..c420d8c 100644
--- a/src/Nes/APU/BusInterface/Status.hs
+++ b/src/Nes/APU/BusInterface/Status.hs
@@ -5,8 +5,9 @@ import Data.Bits
 import Nes.APU.Monad
 import Nes.APU.State
 import Nes.APU.State.DMC
-import Nes.APU.State.FrameCounter
 import Nes.APU.State.LengthCounter
+import Nes.APU.Tick (setFrameInterruptFlag)
+import Nes.Bus.SideEffect (CPUSideEffect (setIRQ, startDMCDMA))
 import Nes.Memory
 
 {-# INLINE write4015 #-}
@@ -17,31 +18,24 @@ write4015 byte = do
         enableTriangleLc = byte `testBit` 2
         enableNoiseLc = byte `testBit` 3
         enableDmc = byte `testBit` 4
-    unless enablePulse1Lc $
-        modifyAPUState $
-            modifyPulse1 $
-                withLengthCounter clearAndHaltLengthCounter
-
-    unless enablePulse2Lc $
-        modifyAPUState $
-            modifyPulse2 $
-                withLengthCounter clearAndHaltLengthCounter
-
-    unless enableTriangleLc $
-        modifyAPUState $
-            modifyTriangle $
-                withLengthCounter clearAndHaltLengthCounter
-
-    unless enableNoiseLc $
-        modifyAPUState $
-            modifyNoise $
-                withLengthCounter clearAndHaltLengthCounter
+    toggleLengthCounter enablePulse1Lc modifyPulse1
+    toggleLengthCounter enablePulse2Lc modifyPulse2
+    toggleLengthCounter enableTriangleLc modifyTriangle
+    toggleLengthCounter enableNoiseLc modifyNoise
     modifyAPUState $ modifyDMC $ \t ->
         if enableDmc
             -- TODO If there are bits remaining in the 1-byte sample buffer, these will finish playing before the next sample is fetched.
             then if sampleBytesRemaining t == 0 then restartSample t else t
             else t{sampleBytesRemaining = 0}
 
+{-# INLINE toggleLengthCounter #-}
+toggleLengthCounter :: (HasLengthCounter a) => Bool -> ((a -> a) -> APUState -> APUState) -> APU r ()
+toggleLengthCounter enable f =
+    modifyAPUState $
+        f $
+            withLengthCounter $
+                if enable then enableLengthCounter else disableLengthCounter . clearAndHaltLengthCounter
+
 {-# INLINE read4015 #-}
 read4015 :: APU r Byte
 read4015 = do
@@ -50,11 +44,10 @@ read4015 = do
     pulse1Bit <- withAPUState $ lengthCounterBit . pulse1
     pulse2Bit <- withAPUState $ lengthCounterBit . pulse2
     dmcBit <- withAPUState $ \st -> sampleBytesRemaining (dmc st) > 0
-    let frameInterruptBit = False -- TODO Should check if side effect if applied
-    let dmcInterruptBit = False -- TODO Should check if side effect if applied
-    -- TODO That Should be a CPUSideEffect
-    modifyAPUState $ modifyFrameCounter $ \fc -> fc{frameInterruptFlag = False}
-    -- TODO If an interrupt flag was set at the same moment of the read, it will read back as 1 but it will not be cleared.
+    frameInterruptBit <- withSideEffect setIRQ
+    dmcInterruptBit <- withSideEffect startDMCDMA
+    when frameInterruptBit $ do
+        setFrameInterruptFlag False
     return $
         setBit' dmcInterruptBit 7 $
             setBit' frameInterruptBit 6 $
@@ -68,4 +61,4 @@ read4015 = do
                                     0
   where
     setBit' b i a = if b then a `setBit` i else a `clearBit` i
-    lengthCounterBit st = let lc = getLengthCounter st in remainingLength lc > 0 && not (isHalted lc)
+    lengthCounterBit st = let lc = getLengthCounter st in isEnabled lc
diff --git a/src/Nes/APU/State/LengthCounter.hs b/src/Nes/APU/State/LengthCounter.hs
index 6db34bf..c276f65 100644
--- a/src/Nes/APU/State/LengthCounter.hs
+++ b/src/Nes/APU/State/LengthCounter.hs
@@ -4,6 +4,8 @@ module Nes.APU.State.LengthCounter (
     tickLengthCounter,
     loadLengthCounter,
     clearAndHaltLengthCounter,
+    enableLengthCounter,
+    disableLengthCounter,
 
     -- * Class
     HasLengthCounter (..),
@@ -16,11 +18,11 @@ import Data.List ((!?))
 data LengthCounter = MkLC
     { remainingLength :: {-# UNPACK #-} !Int
     , isHalted :: {-# UNPACK #-} !Bool
-    , tableIndex :: {-# UNPACK #-} !Int
+    , isEnabled :: {-# UNPACK #-} !Bool
     }
 
 newLengthCounter :: LengthCounter
-newLengthCounter = MkLC 0 False 0
+newLengthCounter = MkLC 0 False False
 
 tickLengthCounter :: LengthCounter -> LengthCounter
 tickLengthCounter lc =
@@ -36,9 +38,17 @@ clearAndHaltLengthCounter lc = lc{remainingLength = 0, isHalted = True}
 --
 -- Note: It must not be done when the enabled bit (4015) is clear
 loadLengthCounter :: Int -> LengthCounter -> LengthCounter
-loadLengthCounter idx lc = case lengthTable !? idx of
-    Just l -> lc{remainingLength = l, tableIndex = idx}
-    Nothing -> lc -- Index is invalid
+loadLengthCounter idx lc
+    | not $ isEnabled lc = lc
+    | otherwise = case lengthTable !? idx of
+        Just l -> lc{remainingLength = l}
+        Nothing -> lc -- Index is invalid
+
+disableLengthCounter :: LengthCounter -> LengthCounter
+disableLengthCounter lc = lc{isEnabled = False, remainingLength = 0}
+
+enableLengthCounter :: LengthCounter -> LengthCounter
+enableLengthCounter lc = lc{isEnabled = True}
 
 class HasLengthCounter a where
     getLengthCounter :: a -> LengthCounter

From 6d9fb2971579810ecc9f806c47eb4f71260e4012 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Tue, 11 Nov 2025 13:25:13 +0000
Subject: [PATCH 25/37] APU: Pulse: Fix sequence stepping

---
 src/Nes/APU/State/Pulse.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Nes/APU/State/Pulse.hs b/src/Nes/APU/State/Pulse.hs
index b693a66..92e9dc5 100644
--- a/src/Nes/APU/State/Pulse.hs
+++ b/src/Nes/APU/State/Pulse.hs
@@ -90,7 +90,7 @@ updateTargetPeriod p =
 tickPulse :: Pulse -> Pulse
 tickPulse p = p{dutyStep = newDutyStep, timer = newTimer}
   where
-    newDutyStep = if timer p == 0 then (dutyStep p - 1) `mod` 8 else dutyStep p
+    newDutyStep = if timer p == 0 then (dutyStep p + 1) `mod` 8 else dutyStep p
     newTimer = if timer p == 0 then period p else timer p - 1
 
 tickSweepUnit :: Pulse -> Pulse
@@ -110,7 +110,7 @@ tickSweepUnit p = p2
                             p
             else p
     p2 =
-        -- TODO Not sure if should use p1 or p2
+        -- TODO Not sure if should use p1 or p0
         if (reloadFlag . sweepUnit) p1 || (dividerCounter . sweepUnit) p1 == 0
             then
                 modifySweep
@@ -132,7 +132,7 @@ instance HasEnvelope Pulse where
 getPulseOutput :: Pulse -> Int
 getPulseOutput p =
     let dutyValue = fromMaybe 0 ((dutySequences !? dutyIndex p) >>= (!? dutyStep p))
-        periodOverflows = (targetPeriod . sweepUnit) p > 0x7ff
+        periodOverflows = not (negateDelta $ sweepUnit p) && (targetPeriod . sweepUnit) p > 0x7ff
         isSilenced =
             isSilencedByLengthCounter p
                 || (period p < 8)

From b3b21872509af1b75c9df1c5a00ec18f654dc36a Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Tue, 11 Nov 2025 13:26:03 +0000
Subject: [PATCH 26/37] APU: Better sampling

---
 app/Main.hs                          |  2 +-
 src/Nes/APU/BusInterface/Triangle.hs |  2 +-
 src/Nes/APU/Mixer.hs                 | 26 +++++++++++++++-----------
 src/Nes/APU/Monad.hs                 |  9 +++++++--
 src/Nes/APU/State.hs                 | 11 ++++++++++-
 5 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index e73ada0..b50bf14 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -43,7 +43,7 @@ main = do
                 { SDL.openDeviceFreq = Mandate 44100
                 , SDL.openDeviceFormat = Mandate FloatingLEAudio
                 , SDL.openDeviceChannels = Mandate Mono
-                , SDL.openDeviceSamples = 512
+                , SDL.openDeviceSamples = 735
                 , SDL.openDeviceCallback = audioCallback audioSamples
                 , SDL.openDeviceUsage = ForPlayback
                 , SDL.openDeviceName = Nothing
diff --git a/src/Nes/APU/BusInterface/Triangle.hs b/src/Nes/APU/BusInterface/Triangle.hs
index 112b019..136214e 100644
--- a/src/Nes/APU/BusInterface/Triangle.hs
+++ b/src/Nes/APU/BusInterface/Triangle.hs
@@ -33,7 +33,7 @@ write400B :: Byte -> APU r ()
 write400B byte = modifyAPUState $ modifyTriangle $ \t ->
     let timerHigh = byteToInt $ byte .&. 0b111
         newPeriod = (timerHigh `shiftL` 8) .|. (period t .&. 0b11111111)
-        newLcLoad = byteToInt byte `shiftR` 3
+        newLcLoad = byteToInt $ byte `shiftR` 3
      in withLengthCounter (loadLengthCounter newLcLoad) $
             t
                 { reloadFlag = True
diff --git a/src/Nes/APU/Mixer.hs b/src/Nes/APU/Mixer.hs
index e413129..1594a68 100644
--- a/src/Nes/APU/Mixer.hs
+++ b/src/Nes/APU/Mixer.hs
@@ -1,26 +1,30 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module Nes.APU.Mixer (runMixer) where
 
+import Nes.APU.Monad
 import Nes.APU.State
 import Nes.APU.State.DMC (getDMCOutput)
-import Nes.APU.State.Filter
 import Nes.APU.State.Noise (getNoiseOutput)
 import Nes.APU.State.Pulse (getPulseOutput)
 import Nes.APU.State.Triangle (getTriangleOutput)
 
-runMixer :: APUState -> (Float, APUState)
-runMixer st =
+runMixer :: APU r Float
+runMixer = do
+    MkAPUState{..} <- withAPUState id
     let
-        pulse1Out = getPulseOutput . pulse1 $ st
-        pulse2Out = getPulseOutput . pulse2 $ st
-        triangleOut = getTriangleOutput . triangle $ st
-        noiseOut = getNoiseOutput . noise $ st
-        dmcOut = getDMCOutput . dmc $ st
+        pulse1Out = getPulseOutput pulse1
+        pulse2Out = getPulseOutput pulse2
+        triangleOut = getTriangleOutput triangle
+        noiseOut = getNoiseOutput noise
+        dmcOut = getDMCOutput dmc
         pulseOut = pulseTable (pulse1Out + pulse2Out)
         tndOut = tndTable (3 * triangleOut + 2 * noiseOut + dmcOut)
         mixerOutput = pulseOut + tndOut
-        (res, newFilters) = processSample mixerOutput $ filterChain st
-     in
-        (res, st{filterChain = newFilters})
+    -- (res, newFilters) = processSample mixerOutput filterChain
+    -- TODO: With filter: too low
+    -- modifyAPUState $ \st' -> st'{filterChain = newFilters}
+    return mixerOutput
 
 {-# INLINE pulseTable #-}
 pulseTable :: Int -> Float
diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
index fc3584d..ca34304 100644
--- a/src/Nes/APU/Monad.hs
+++ b/src/Nes/APU/Monad.hs
@@ -5,6 +5,7 @@ module Nes.APU.Monad (
     modifyAPUStateWithSideEffect,
     withAPUState,
     setSideEffect,
+    withSideEffect,
 ) where
 
 import Control.Monad.IO.Class
@@ -55,5 +56,9 @@ withAPUState :: (APUState -> a) -> APU r a
 withAPUState f = MkAPU $ \(!st) !cpuEff cont -> cont st cpuEff (f st)
 
 {-# INLINE setSideEffect #-}
-setSideEffect :: CPUSideEffect -> APU r ()
-setSideEffect eff = MkAPU $ \(!st) !cpuEff cont -> cont st (cpuEff <> eff) ()
+setSideEffect :: (CPUSideEffect -> CPUSideEffect) -> APU r ()
+setSideEffect f = MkAPU $ \(!st) !cpuEff cont -> cont st (f cpuEff) ()
+
+{-# INLINE withSideEffect #-}
+withSideEffect :: (CPUSideEffect -> a) -> APU r a
+withSideEffect f = MkAPU $ \(!st) !cpuEff cont -> cont st cpuEff (f cpuEff)
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index c174746..3612d4e 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -12,6 +12,7 @@ module Nes.APU.State (
     modifyDMC,
     modifyDMC',
     setCycleDeltaSinceLastSample,
+    setSampleBufferSum,
 ) where
 
 import Nes.APU.State.DMC
@@ -31,17 +32,25 @@ data APUState = MkAPUState
     , dmc :: !DMC
     , filterChain :: !FilterChain
     , cycleDeltaSinceLastSample :: {-# UNPACK #-} !Int
+    , samplesBufferSum :: {-# UNPACK #-} !Float
+    , evenSampleCallbackCall :: {-# UNPACK #-} !Bool
     , pushSampleCallback :: !(Float -> IO ())
     }
 
 newAPUState :: (Float -> IO ()) -> APUState
 newAPUState =
-    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle newNoise newDMC newFilterChain 0
+    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle newNoise newDMC newFilterChain 0 0 True
 
+{-# INLINE setCycleDeltaSinceLastSample #-}
 setCycleDeltaSinceLastSample :: (Int -> Int) -> APUState -> APUState
 setCycleDeltaSinceLastSample f fc =
     fc{cycleDeltaSinceLastSample = f $ cycleDeltaSinceLastSample fc}
 
+{-# INLINE setSampleBufferSum #-}
+setSampleBufferSum :: (Float -> Float) -> APUState -> APUState
+setSampleBufferSum f fc =
+    fc{samplesBufferSum = f $ samplesBufferSum fc}
+
 {-# INLINE modifyPulse1 #-}
 modifyPulse1 :: (Pulse -> Pulse) -> APUState -> APUState
 modifyPulse1 f st = st{pulse1 = f (pulse1 st)}

From 54a5fa943d44e55d7208b7f0fa91f75a86eaba8d Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Wed, 12 Nov 2025 08:55:30 +0000
Subject: [PATCH 27/37] APU: Pulse: Fix divider period of sweep unit

---
 src/Nes/APU/BusInterface/Pulse.hs | 19 +++++++++++--------
 1 file changed, 11 insertions(+), 8 deletions(-)

diff --git a/src/Nes/APU/BusInterface/Pulse.hs b/src/Nes/APU/BusInterface/Pulse.hs
index f4713a2..12d3f7b 100644
--- a/src/Nes/APU/BusInterface/Pulse.hs
+++ b/src/Nes/APU/BusInterface/Pulse.hs
@@ -36,9 +36,16 @@ writePulseFirstByte setter byte = do
         constVol = byte `testBit` 4
         vol = byte .&. 0b1111
     modifyAPUState $ setter $ \p ->
-        withEnvelope (\e -> e{constantVolume = byteToInt vol, useConstantVolume = constVol, loopFlag = haltLC}) $
-            withLengthCounter (\lc -> lc{isHalted = haltLC}) $
-                p{dutyIndex = fromIntegral $ unByte duty}
+        withEnvelope
+            ( \e ->
+                e
+                    { constantVolume = byteToInt vol
+                    , useConstantVolume = constVol
+                    , loopFlag = haltLC
+                    }
+            )
+            $ withLengthCounter (\lc -> lc{isHalted = haltLC})
+            $ p{dutyIndex = fromIntegral $ unByte duty}
 
 {-# INLINE write4001 #-}
 write4001 :: Byte -> APU r ()
@@ -52,7 +59,7 @@ write4005 = writePulseSecondByte modifyPulse2
 writePulseSecondByte :: ((Pulse -> Pulse) -> APUState -> APUState) -> Byte -> APU r ()
 writePulseSecondByte setter byte = do
     let enabledFlag = byte `testBit` 7
-        divPeriod = (byte `shiftR` 4) .&. 0b111
+        divPeriod = 1 + ((byte `shiftR` 4) .&. 0b111)
         negateFlag = byte `testBit` 3
         shiftC = byte .&. 0b111
         sweepIsEnabled = enabledFlag && shiftC > 0
@@ -104,8 +111,4 @@ writePulseFourthByte setter byte = modifyAPUState $ setter $ \p ->
                     p
                         { period = newPeriod
                         , dutyStep = 0
-                        -- TODO Not sure
-                        -- https://www.nesdev.org/wiki/APU_Pulse#Registers
                         }
-
---

From b825feb146141fdd3a34b33ca6b39b0cd73820ac Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Wed, 12 Nov 2025 08:56:49 +0000
Subject: [PATCH 28/37] APU: Add missing tick for noise

---
 src/Nes/APU/State/Noise.hs | 16 +++++++++-------
 src/Nes/APU/Tick.hs        |  5 ++++-
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/src/Nes/APU/State/Noise.hs b/src/Nes/APU/State/Noise.hs
index 2a0f785..6851612 100644
--- a/src/Nes/APU/State/Noise.hs
+++ b/src/Nes/APU/State/Noise.hs
@@ -7,7 +7,7 @@ module Nes.APU.State.Noise (
     getNoiseOutput,
 
     -- * Clock
-    tickPulse,
+    tickNoise,
     tickShiftRegister,
 
     -- * Utils
@@ -46,14 +46,14 @@ getPeriodValue idx = fromMaybe 4 ([4, 8, 16, 32, 64, 96, 128, 160, 202, 254, 380
 
 instance HasLengthCounter Noise where
     getLengthCounter = lengthCounter
-    setLengthCounter lc t = t{lengthCounter = lc}
+    setLengthCounter lc n = n{lengthCounter = lc}
 
 instance HasEnvelope Noise where
     getEnvelope = envelope
-    setEnvelope e t = t{envelope = e}
+    setEnvelope e n = n{envelope = e}
 
-tickPulse :: Noise -> Noise
-tickPulse n = tickCallback $ n{timer = newTimer}
+tickNoise :: Noise -> Noise
+tickNoise n = tickCallback $ n{timer = newTimer}
   where
     newTimer = if timer n == 0 then period n else timer n - 1
     tickCallback = if timer n == 0 then tickShiftRegister else id
@@ -68,7 +68,9 @@ tickShiftRegister n = n{shiftRegister = shift2}
     shift2 = if feeback then shift1 `setBit` 14 else shift1
 
 getNoiseOutput :: Noise -> Int
-getNoiseOutput n = if shiftBit0IsSet || lengthCounterIsZero then 0 else getEnvelopeOutput $ envelope n
+getNoiseOutput n =
+    if shiftBit0IsSet || isSilencedByLengthCounter n
+        then 0
+        else getEnvelopeOutput $ envelope n
   where
     shiftBit0IsSet = shiftRegister n `testBit` 0
-    lengthCounterIsZero = remainingLength (lengthCounter n) == 0
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index 02724a1..9856261 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -22,6 +22,7 @@ import Nes.APU.State.Envelope
 import Nes.APU.State.FrameCounter
 import qualified Nes.APU.State.FrameCounter as FC
 import Nes.APU.State.LengthCounter
+import Nes.APU.State.Noise
 import Nes.APU.State.Pulse
 import Nes.APU.State.Triangle
 import Nes.Bus.SideEffect (CPUSideEffect (setIRQ))
@@ -46,7 +47,9 @@ tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
     tickDelayedWriteBuffer
     modifyAPUStateWithSideEffect $ modifyDMC' tickDMC
-    modifyAPUState $ modifyTriangle tickTriangle
+    modifyAPUState $
+        modifyTriangle tickTriangle
+            . modifyNoise tickNoise
     when isAPUCycle $ do
         modifyAPUState $
             modifyPulse1 tickPulse

From b9805a849ac1437800b5145c63b0a4ff4a0f3bbe Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 12:31:53 +0000
Subject: [PATCH 29/37] APU: State has current CPU cycle

---
 src/Nes/APU/BusInterface/FrameCounter.hs |  4 +--
 src/Nes/APU/State.hs                     | 43 +++++++++++++-----------
 src/Nes/APU/Tick.hs                      | 38 ++++++++++-----------
 3 files changed, 45 insertions(+), 40 deletions(-)

diff --git a/src/Nes/APU/BusInterface/FrameCounter.hs b/src/Nes/APU/BusInterface/FrameCounter.hs
index 6ec9d7c..638aaa0 100644
--- a/src/Nes/APU/BusInterface/FrameCounter.hs
+++ b/src/Nes/APU/BusInterface/FrameCounter.hs
@@ -12,10 +12,10 @@ import Nes.Memory
 {-# INLINE write4017 #-}
 write4017 :: Byte -> APU r ()
 write4017 byte = do
-    c <- withAPUState cycleDeltaSinceLastSample
+    c <- withAPUState Nes.APU.State.cycle
     let seqMode = sequenceModeFromBool $ byte `testBit` 7
         inhibit = byte `testBit` 6
-        delay = if even c then 4 else 3 -- TODO Should use CPU cycle instead
+        delay = if even c then 4 else 3
     modifyAPUState $
         modifyFrameCounter $
             \fc -> fc{sequenceMode = seqMode, inhibitInterrupt = inhibit, delayedWriteSideEffectCycle = Just delay}
diff --git a/src/Nes/APU/State.hs b/src/Nes/APU/State.hs
index 3612d4e..4f605ff 100644
--- a/src/Nes/APU/State.hs
+++ b/src/Nes/APU/State.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module Nes.APU.State (
     -- * Definition
     APUState (..),
@@ -11,17 +13,17 @@ module Nes.APU.State (
     modifyNoise,
     modifyDMC,
     modifyDMC',
-    setCycleDeltaSinceLastSample,
-    setSampleBufferSum,
 ) where
 
 import Nes.APU.State.DMC
-import Nes.APU.State.Filter
+import Nes.APU.State.Filter.Chain
+import Nes.APU.State.Filter.Constants (defaultOutputRate)
 import Nes.APU.State.FrameCounter
 import Nes.APU.State.Noise
 import Nes.APU.State.Pulse
 import Nes.APU.State.Triangle
 import Nes.Bus.SideEffect (CPUSideEffect)
+import Prelude hiding (cycle)
 
 data APUState = MkAPUState
     { frameCounter :: !FrameCounter
@@ -30,26 +32,29 @@ data APUState = MkAPUState
     , triangle :: !Triangle
     , noise :: !Noise
     , dmc :: !DMC
+    , cycle :: {-# UNPACK #-} !Int
+    -- ^ Number of CPU cycles since the start
     , filterChain :: !FilterChain
-    , cycleDeltaSinceLastSample :: {-# UNPACK #-} !Int
-    , samplesBufferSum :: {-# UNPACK #-} !Float
-    , evenSampleCallbackCall :: {-# UNPACK #-} !Bool
-    , pushSampleCallback :: !(Float -> IO ())
+    , sampleTimer :: {-# UNPACK #-} !Float
+    -- ^ The number of CPU cycles since the last call to 'pushSampleCallback'
+    , samplePeriod :: {-# UNPACK #-} !Float
+    -- ^ The number of CPU cycles between each call to 'pushSampleCallback'
+    , pushSampleCallback :: Float -> IO ()
     }
 
 newAPUState :: (Float -> IO ()) -> APUState
-newAPUState =
-    MkAPUState newFrameCounter (newPulse True) (newPulse False) newTriangle newNoise newDMC newFilterChain 0 0 True
-
-{-# INLINE setCycleDeltaSinceLastSample #-}
-setCycleDeltaSinceLastSample :: (Int -> Int) -> APUState -> APUState
-setCycleDeltaSinceLastSample f fc =
-    fc{cycleDeltaSinceLastSample = f $ cycleDeltaSinceLastSample fc}
-
-{-# INLINE setSampleBufferSum #-}
-setSampleBufferSum :: (Float -> Float) -> APUState -> APUState
-setSampleBufferSum f fc =
-    fc{samplesBufferSum = f $ samplesBufferSum fc}
+newAPUState pushSampleCallback = MkAPUState{..}
+  where
+    frameCounter = newFrameCounter
+    cycle = 0
+    pulse1 = newPulse True
+    pulse2 = newPulse False
+    triangle = newTriangle
+    noise = newNoise
+    dmc = newDMC
+    filterChain = newFilterChain defaultOutputRate
+    samplePeriod = (21477272 / 12) / defaultOutputRate
+    sampleTimer = samplePeriod
 
 {-# INLINE modifyPulse1 #-}
 modifyPulse1 :: (Pulse -> Pulse) -> APUState -> APUState
diff --git a/src/Nes/APU/Tick.hs b/src/Nes/APU/Tick.hs
index 9856261..7730d79 100644
--- a/src/Nes/APU/Tick.hs
+++ b/src/Nes/APU/Tick.hs
@@ -17,15 +17,19 @@ import Control.Monad.IO.Class
 import Nes.APU.Mixer
 import Nes.APU.Monad
 import Nes.APU.State
+import qualified Nes.APU.State as S
 import Nes.APU.State.DMC
 import Nes.APU.State.Envelope
+import Nes.APU.State.Filter.Class
 import Nes.APU.State.FrameCounter
 import qualified Nes.APU.State.FrameCounter as FC
 import Nes.APU.State.LengthCounter
 import Nes.APU.State.Noise
 import Nes.APU.State.Pulse
 import Nes.APU.State.Triangle
-import Nes.Bus.SideEffect (CPUSideEffect (setIRQ))
+import Nes.Bus.SideEffect
+import Nes.FlagRegister
+import Prelude hiding (cycle)
 
 -- $use
 --     The APU being a part of the CPU, they both tick at the same time. However, some ticks are updated every other CPU cycles.
@@ -37,7 +41,6 @@ type IsAPUCycle = Bool
 -- | Calls 'tick' n amount of time
 --
 -- the first parameter says whether the first tick is an APU cycle or not
-{-# INLINE tick #-}
 tick :: IsAPUCycle -> Int -> APU r ()
 tick _ 0 = return ()
 tick b n = tickOnce b >> tick (not b) (n - 1)
@@ -45,6 +48,7 @@ tick b n = tickOnce b >> tick (not b) (n - 1)
 {-# INLINE tickOnce #-}
 tickOnce :: IsAPUCycle -> APU r ()
 tickOnce isAPUCycle = do
+    -- Ticks
     tickDelayedWriteBuffer
     modifyAPUStateWithSideEffect $ modifyDMC' tickDMC
     modifyAPUState $
@@ -56,22 +60,18 @@ tickOnce isAPUCycle = do
                 . modifyPulse2 tickPulse
         tickFrameCounter
 
-    delta <- withAPUState cycleDeltaSinceLastSample
-    sample <- runMixer
-    modifyAPUState $ setSampleBufferSum (+ sample)
-    isEven <- withAPUState evenSampleCallbackCall
-    if delta >= (if isEven then 40 else 41)
-        then do
-            sampleSum <- withAPUState samplesBufferSum
-            callback <- withAPUState pushSampleCallback
-            liftIO $ callback (sampleSum / fromIntegral delta)
-            modifyAPUState $
-                setCycleDeltaSinceLastSample (const 0)
-                    . setSampleBufferSum (const 0)
-                    . (\st -> st{evenSampleCallbackCall = not isEven})
-        else
-            modifyAPUState $
-                setCycleDeltaSinceLastSample (+ 1)
+    -- Mixing
+    sample <- withAPUState getMixerOutput
+    modifyFilterChain $ consume sample
+    modifyAPUState $ \st -> st{sampleTimer = sampleTimer st - 1}
+    sampleTimer' <- withAPUState sampleTimer
+    when (sampleTimer' <= 1) $ do
+        filterOut <- withAPUState $ output . filterChain
+        callback <- withAPUState pushSampleCallback
+        liftIO $ callback filterOut
+        modifyAPUState $
+            \st -> st{sampleTimer = S.sampleTimer st + S.samplePeriod st}
+    modifyAPUState $ \st -> st{cycle = cycle st + 1}
 
 -- | Tells the frame counter to tick channels
 --
@@ -153,7 +153,7 @@ runHalfFrameEvent = modifyAPUState $ \st ->
 {-# INLINE setFrameInterruptFlag #-}
 setFrameInterruptFlag :: Bool -> APU r ()
 setFrameInterruptFlag b = do
-    setSideEffect $ \st -> st{setIRQ = b}
+    setSideEffect $ setFlag IRQ
     modifyAPUState $
         modifyFrameCounter $
             \fc -> fc{frameInterruptFlag = b}

From 49a6bf33f07a1c03e37d97e5ea5ddafd4875cab1 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 12:32:27 +0000
Subject: [PATCH 30/37] APU: Split filters into smaller files

---
 funes.cabal                           |  7 +-
 src/Nes/APU/State/DMC.hs              |  7 +-
 src/Nes/APU/State/Filter.hs           | 75 ----------------------
 src/Nes/APU/State/Filter/Chain.hs     | 81 +++++++++++++++++++++++
 src/Nes/APU/State/Filter/Class.hs     | 11 ++++
 src/Nes/APU/State/Filter/Constants.hs | 18 ++++++
 src/Nes/APU/State/Filter/Fir.hs       | 92 +++++++++++++++++++++++++++
 src/Nes/APU/State/Filter/Iir.hs       | 67 +++++++++++++++++++
 src/Nes/APU/State/Filter/Sampled.hs   | 32 ++++++++++
 9 files changed, 311 insertions(+), 79 deletions(-)
 delete mode 100644 src/Nes/APU/State/Filter.hs
 create mode 100644 src/Nes/APU/State/Filter/Chain.hs
 create mode 100644 src/Nes/APU/State/Filter/Class.hs
 create mode 100644 src/Nes/APU/State/Filter/Constants.hs
 create mode 100644 src/Nes/APU/State/Filter/Fir.hs
 create mode 100644 src/Nes/APU/State/Filter/Iir.hs
 create mode 100644 src/Nes/APU/State/Filter/Sampled.hs

diff --git a/funes.cabal b/funes.cabal
index a35bd62..6567e60 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -36,7 +36,12 @@ library
       Nes.APU.State
       Nes.APU.State.DMC
       Nes.APU.State.Envelope
-      Nes.APU.State.Filter
+      Nes.APU.State.Filter.Chain
+      Nes.APU.State.Filter.Class
+      Nes.APU.State.Filter.Constants
+      Nes.APU.State.Filter.Fir
+      Nes.APU.State.Filter.Iir
+      Nes.APU.State.Filter.Sampled
       Nes.APU.State.FrameCounter
       Nes.APU.State.LengthCounter
       Nes.APU.State.Noise
diff --git a/src/Nes/APU/State/DMC.hs b/src/Nes/APU/State/DMC.hs
index c5a9efb..39c4219 100644
--- a/src/Nes/APU/State/DMC.hs
+++ b/src/Nes/APU/State/DMC.hs
@@ -18,7 +18,8 @@ import Data.Array
 import Data.Bits
 import Data.List ((!?))
 import Data.Maybe (fromMaybe, isNothing)
-import Nes.Bus.SideEffect (CPUSideEffect (setIRQ, startDMCDMA))
+import Nes.Bus.SideEffect
+import Nes.FlagRegister
 import Nes.Memory
 
 data DMC = MkDMC
@@ -110,7 +111,7 @@ onOutputCycleEnd dmc = (dmc1, sideEffect)
     dmc1 = case sampleBuffer dmc0 of
         Nothing -> dmc0{silentFlag = True}
         Just b -> dmc0{shiftRegister = b, sampleBuffer = Nothing}
-    sideEffect = mempty{startDMCDMA = isNothing (sampleBuffer dmc1) && sampleBytesRemaining dmc1 > 0}
+    sideEffect = setFlag' DMCDMA (isNothing (sampleBuffer dmc1) && sampleBytesRemaining dmc1 > 0) mempty
 
 -- | Loads the byte into the sample buffer and shift the sample buffer-related values
 loadSampleBuffer :: Byte -> DMC -> (DMC, CPUSideEffect)
@@ -130,4 +131,4 @@ loadSampleBuffer byte dmc =
      in
         if shouldRestartSample
             then (restartSample dmc1, mempty)
-            else (dmc1, mempty{setIRQ = shouldIRQ})
+            else (dmc1, setFlag' IRQ shouldIRQ mempty)
diff --git a/src/Nes/APU/State/Filter.hs b/src/Nes/APU/State/Filter.hs
deleted file mode 100644
index 4c84766..0000000
--- a/src/Nes/APU/State/Filter.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-
-module Nes.APU.State.Filter (
-    -- * Filter chain
-    FilterChain (..),
-    newFilterChain,
-    processSample,
-
-    -- * Filter
-    lowPassFilter,
-    highPassFilter,
-    filterProcessSample,
-) where
-
-import Prelude hiding (filter)
-
--- Source: https://github.com/luckasRanarison/mes/blob/main/crates/mes-core/src/apu/filters.rs#L58
-
-newtype FilterChain = MkFC {unFC :: [Filter]}
-
-newFilterChain :: FilterChain
-newFilterChain = MkFC [highPassFilter 44100 90, highPassFilter 44100 440, lowPassFilter 44100 14000]
-
-processSample :: Float -> FilterChain -> (Float, FilterChain)
-processSample sample chain =
-    let
-        (res, newChain) =
-            foldl
-                ( \(sample', newFilters) filter ->
-                    let
-                        (filteredSample, filter') = filterProcessSample sample' filter
-                     in
-                        (filteredSample, newFilters ++ [filter'])
-                )
-                (sample, [])
-                $ unFC chain
-     in
-        (res, MkFC newChain)
-
-data Filter = MkF
-    { b0 :: {-# UNPACK #-} !Float
-    , b1 :: {-# UNPACK #-} !Float
-    , a1 :: {-# UNPACK #-} !Float
-    , prevX :: {-# UNPACK #-} !Float
-    , prevY :: {-# UNPACK #-} !Float
-    }
-
-lowPassFilter :: Float -> Float -> Filter
-lowPassFilter sampleRate freq = MkF{..}
-  where
-    b0 = a0
-    b1 = a0
-    a1 = (1.0 - c) * a0
-    prevX = 0.0
-    prevY = 0.0
-    c = sampleRate / (freq * pi)
-    a0 = 1.0 / (1.0 + c)
-
-highPassFilter :: Float -> Float -> Filter
-highPassFilter sampleRate freq = MkF{..}
-  where
-    b0 = c * a0
-    b1 = (-c) * a0
-    a1 = (1.0 - c) * a0
-    prevX = 0.0
-    prevY = 0.0
-    c = sampleRate / (freq * pi)
-    a0 = 1.0 / (1.0 + c)
-
-{-# INLINE filterProcessSample #-}
-filterProcessSample :: Float -> Filter -> (Float, Filter)
-filterProcessSample sample f@MkF{..} = (res, newFilter)
-  where
-    res = b0 * sample + b1 * prevX - a1 * prevY
-    newFilter = f{prevX = sample, prevY = res}
diff --git a/src/Nes/APU/State/Filter/Chain.hs b/src/Nes/APU/State/Filter/Chain.hs
new file mode 100644
index 0000000..efa729b
--- /dev/null
+++ b/src/Nes/APU/State/Filter/Chain.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Nes.APU.State.Filter.Chain (FilterChain (..), newFilterChain) where
+
+import Nes.APU.State.Filter.Class
+import Nes.APU.State.Filter.Constants
+import Nes.APU.State.Filter.Fir
+import Nes.APU.State.Filter.Iir
+import Nes.APU.State.Filter.Sampled
+import Prelude hiding (filter)
+
+data FilterChain = MkFC
+    { filters :: ![SampledFilter]
+    , dt :: {-# UNPACK #-} !Float
+    }
+
+newFilterChain :: OutputRate -> FilterChain
+newFilterChain outputRate = MkFC{..}
+  where
+    clockRate = 21477272 / 12
+    intermediateSampleRate = outputRate * 2 + (pi / 32)
+    intermediateCutoff = outputRate * 0.4
+    dt = 1 / clockRate
+    filters =
+        [ newSampledFilter (Left identityIirFilter) 1.0
+        , newSampledFilter (Left $ lowPassIirFilter clockRate intermediateCutoff) clockRate
+        , newSampledFilter (Left $ highPassIirFilter intermediateSampleRate 90) intermediateSampleRate
+        , newSampledFilter (Left $ highPassIirFilter intermediateSampleRate 440) intermediateSampleRate
+        , newSampledFilter (Left $ lowPassIirFilter intermediateSampleRate 14000) intermediateSampleRate
+        , newSampledFilter (Right $ lowPassFirFilter intermediateSampleRate (outputRate * 0.45) 160) intermediateSampleRate
+        ]
+
+instance Filter FilterChain where
+    consume = filterChainConsumeSample
+    output = filterChainOutput
+
+filterChainConsumeSample :: Sample -> FilterChain -> FilterChain
+filterChainConsumeSample sample fc =
+    let
+        fc1 = modifyFilterAtIndex 0 (consume sample) fc
+        updatedFilters = go (filters fc1) (dt fc1)
+     in
+        fc1{filters = updatedFilters}
+  where
+    go :: [SampledFilter] -> Float -> [SampledFilter]
+    go [] _ = []
+    go [a] _ = [a]
+    go (prev : curr : rest) dt =
+        let
+            newCurr = filterChainConsumeIteration prev curr dt
+         in
+            prev : go (newCurr : rest) dt
+
+filterChainConsumeIteration :: SampledFilter -> SampledFilter -> Float -> SampledFilter
+filterChainConsumeIteration prev current dt =
+    if periodCounter current >= samplePeriod current
+        then
+            let
+                newPeriodCounter = periodCounter current - samplePeriod current
+                previousOutput = output $ filter prev
+                newCurrent = consume previousOutput $ current{periodCounter = newPeriodCounter}
+             in
+                filterChainConsumeIteration
+                    prev
+                    newCurrent
+                    dt
+        else
+            let newPeriodCounter = periodCounter current + dt
+             in current{periodCounter = newPeriodCounter}
+
+{-# INLINE modifyFilterAtIndex #-}
+modifyFilterAtIndex :: Int -> (SampledFilter -> SampledFilter) -> FilterChain -> FilterChain
+modifyFilterAtIndex idx f fc = case splitAt idx $ filters fc of
+    (_, []) -> fc
+    (left, item : right) -> fc{filters = left ++ (f item : right)}
+
+{-# INLINE filterChainOutput #-}
+filterChainOutput :: FilterChain -> Sample
+filterChainOutput fc = case filters fc of
+    [] -> 0
+    l -> either output output . filter $ last l
diff --git a/src/Nes/APU/State/Filter/Class.hs b/src/Nes/APU/State/Filter/Class.hs
new file mode 100644
index 0000000..966fcf2
--- /dev/null
+++ b/src/Nes/APU/State/Filter/Class.hs
@@ -0,0 +1,11 @@
+module Nes.APU.State.Filter.Class (Filter (..)) where
+
+import Nes.APU.State.Filter.Constants
+
+class Filter a where
+    consume :: Sample -> a -> a
+    output :: a -> Sample
+
+instance (Filter a, Filter b) => Filter (Either a b) where
+    consume sample = either (Left . consume sample) (Right . consume sample)
+    output = either output output
diff --git a/src/Nes/APU/State/Filter/Constants.hs b/src/Nes/APU/State/Filter/Constants.hs
new file mode 100644
index 0000000..f55bd17
--- /dev/null
+++ b/src/Nes/APU/State/Filter/Constants.hs
@@ -0,0 +1,18 @@
+module Nes.APU.State.Filter.Constants (
+    -- * Constants
+    defaultOutputRate,
+
+    -- * Type alias
+    Sample,
+    SampleRate,
+    Cutoff,
+    OutputRate,
+) where
+
+type Sample = Float
+type SampleRate = Float
+type Cutoff = Float
+type OutputRate = Float
+
+defaultOutputRate :: OutputRate
+defaultOutputRate = 44100
diff --git a/src/Nes/APU/State/Filter/Fir.hs b/src/Nes/APU/State/Filter/Fir.hs
new file mode 100644
index 0000000..46c9c34
--- /dev/null
+++ b/src/Nes/APU/State/Filter/Fir.hs
@@ -0,0 +1,92 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoStrict #-}
+
+-- Using laziness to build cyclic lists for the output
+
+module Nes.APU.State.Filter.Fir (FirFilter (..), lowPassFirFilter) where
+
+import Data.Functor ((<&>))
+import qualified Data.Vector.Unboxed as V
+import Nes.APU.State.Filter.Class
+import Nes.APU.State.Filter.Constants
+
+-- | Finite impulse response (FIR) filter
+data FirFilter = MkFirF
+    { kernel :: !(V.Vector Float)
+    , inputs :: !(V.Vector Float)
+    , inputIndex :: {-# UNPACK #-} !Int
+    }
+
+instance Filter FirFilter where
+    output f =
+        let
+            kernelL = V.toList $ kernel f
+            inputsL = drop (inputIndex f) $ Prelude.cycle $ V.toList $ inputs f
+         in
+            sum (zipWith (*) kernelL inputsL)
+    consume sample f =
+        f
+            { inputIndex = newInputIndex
+            , inputs = newInputs
+            }
+      where
+        newInputIndex = (inputIndex f + 1) `mod` V.length (inputs f)
+        newInputs = inputs f V.// [(inputIndex f, sample)]
+
+lowPassFirFilter :: SampleRate -> Cutoff -> Int -> FirFilter
+lowPassFirFilter sampleRate cutoff windowSize = MkFirF{..}
+  where
+    inputIndex = 0
+    inputs = V.replicate (windowSize + 1) 0
+    kernel = windowedSincKernel sampleRate cutoff windowSize
+
+windowedSincKernel :: SampleRate -> Cutoff -> Int -> V.Vector Float
+windowedSincKernel sampleRate cutoff windowSize =
+    let
+        fc = cutoff / sampleRate
+        kernelL :: [Float]
+        kernelL =
+            [0 .. windowSize] <&> \i ->
+                (sinc i fc windowSize) * blackmanWindow i windowSize
+        kernelV = V.fromList kernelL
+     in
+        normalise kernelV
+  where
+    blackmanWindow :: Int -> Int -> Float
+    blackmanWindow idx winSize =
+        let
+            fIdx = fromIntegral idx
+            fWinSize = fromIntegral winSize
+            tau = 2 * pi
+         in
+            0.42
+                - 0.5
+                    * ((cos ((tau * fIdx) / fWinSize)) + 0.08 * (cos ((2 * tau * fIdx / fWinSize))))
+    sinc :: Int -> Float -> Int -> Float
+    sinc idx fc winSize =
+        let
+            fIdx = fromIntegral idx
+            fWinSize = fromIntegral winSize
+            shiftedIndex = fIdx - (fWinSize / 2)
+            tau = 2 * pi
+         in
+            if idx == (windowSize `div` 2)
+                then tau * fc
+                else (mySin (tau * fc * shiftedIndex)) / shiftedIndex
+    normalise :: V.Vector Float -> V.Vector Float
+    normalise vec =
+        let
+            vecSum = V.sum vec
+         in
+            V.map (/ vecSum) vec
+
+-- | Faster implementation of the sin function,
+--
+-- Stolen from https://www.youtube.com/watch?v=72dI7dB3ZvQ
+mySin :: Float -> Float
+mySin t =
+    let
+        j0 = t * 0.15915
+        j1 = j0 - fromIntegral (floor j0 :: Int)
+     in
+        20.785 * j1 * (j1 - 0.5) * (j1 - 1)
diff --git a/src/Nes/APU/State/Filter/Iir.hs b/src/Nes/APU/State/Filter/Iir.hs
new file mode 100644
index 0000000..d291b78
--- /dev/null
+++ b/src/Nes/APU/State/Filter/Iir.hs
@@ -0,0 +1,67 @@
+module Nes.APU.State.Filter.Iir (
+    IirFilter (..),
+
+    -- * Build predefined filters
+    identityIirFilter,
+    highPassIirFilter,
+    lowPassIirFilter,
+) where
+
+import Nes.APU.State.Filter.Class
+import Nes.APU.State.Filter.Constants
+
+-- | Infinite impulse response (IIR) filter
+data IirFilter = MkIirF
+    { alpha :: {-# UNPACK #-} !Float
+    , previousOutput :: {-# UNPACK #-} !Sample
+    , previousInput :: {-# UNPACK #-} !Sample
+    , delta :: {-# UNPACK #-} !Float
+    , outputF :: !(IirFilter -> Sample)
+    }
+
+identityIirFilter :: IirFilter
+identityIirFilter =
+    MkIirF
+        { alpha = 0
+        , previousInput = 0
+        , previousOutput = 0
+        , delta = 0
+        , outputF = previousInput
+        }
+
+highPassIirFilter :: SampleRate -> Cutoff -> IirFilter
+highPassIirFilter sampleRate cutoff =
+    MkIirF
+        { alpha = cutoffPeriod / (cutoffPeriod + period)
+        , previousOutput = 0
+        , previousInput = 0
+        , delta = 0
+        , outputF = \f -> alpha f * previousOutput f + alpha f * delta f
+        }
+  where
+    period = 1 / sampleRate
+    cutoffPeriod = 1 / cutoff
+
+lowPassIirFilter :: SampleRate -> Cutoff -> IirFilter
+lowPassIirFilter sampleRate cutoff =
+    MkIirF
+        { alpha = cutoffPeriod / (cutoffPeriod + period)
+        , previousOutput = 0
+        , previousInput = 0
+        , delta = 0
+        , outputF = \f -> previousOutput f + alpha f * delta f
+        }
+  where
+    period = 1 / sampleRate
+    cutoffPeriod = 1 / (2 * pi * cutoff)
+
+instance Filter IirFilter where
+    {-# INLINE output #-}
+    output f = outputF f f
+    {-# INLINE consume #-}
+    consume sample f =
+        f
+            { previousOutput = output f
+            , delta = sample - previousInput f
+            , previousInput = sample
+            }
diff --git a/src/Nes/APU/State/Filter/Sampled.hs b/src/Nes/APU/State/Filter/Sampled.hs
new file mode 100644
index 0000000..02bb9e8
--- /dev/null
+++ b/src/Nes/APU/State/Filter/Sampled.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Nes.APU.State.Filter.Sampled (SampledFilter (..), newSampledFilter) where
+
+import Nes.APU.State.Filter.Class
+import Nes.APU.State.Filter.Constants
+import Nes.APU.State.Filter.Fir
+import Nes.APU.State.Filter.Iir
+import Prelude hiding (filter)
+
+data SampledFilter = MkSF
+    { filter :: Either IirFilter FirFilter
+    , samplePeriod :: {-# UNPACK #-} !Float
+    , periodCounter :: {-# UNPACK #-} !Float
+    }
+
+newSampledFilter :: Either IirFilter FirFilter -> SampleRate -> SampledFilter
+newSampledFilter filter sampleRate = MkSF{..}
+  where
+    periodCounter = 1
+    samplePeriod = 1 / sampleRate
+
+instance Filter SampledFilter where
+    consume = sampledFilterConsumeSample
+    output sf = output $ filter sf
+
+{-# INLINE sampledFilterConsumeSample #-}
+sampledFilterConsumeSample :: Sample -> SampledFilter -> SampledFilter
+sampledFilterConsumeSample sample sf =
+    sf
+        { filter = consume sample $ filter sf
+        }

From 019f523af3ae134b8372dd0e74430a6566b44bdf Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 12:33:24 +0000
Subject: [PATCH 31/37] APU: Mixer is a pure function

---
 src/Nes/APU/Mixer.hs | 31 ++++++++++++++-----------------
 1 file changed, 14 insertions(+), 17 deletions(-)

diff --git a/src/Nes/APU/Mixer.hs b/src/Nes/APU/Mixer.hs
index 1594a68..a45d7d5 100644
--- a/src/Nes/APU/Mixer.hs
+++ b/src/Nes/APU/Mixer.hs
@@ -1,30 +1,27 @@
 {-# LANGUAGE RecordWildCards #-}
 
-module Nes.APU.Mixer (runMixer) where
+module Nes.APU.Mixer (getMixerOutput) where
 
-import Nes.APU.Monad
 import Nes.APU.State
 import Nes.APU.State.DMC (getDMCOutput)
 import Nes.APU.State.Noise (getNoiseOutput)
 import Nes.APU.State.Pulse (getPulseOutput)
 import Nes.APU.State.Triangle (getTriangleOutput)
+import Prelude hiding (cycle)
 
-runMixer :: APU r Float
-runMixer = do
-    MkAPUState{..} <- withAPUState id
+getMixerOutput :: APUState -> Float
+getMixerOutput MkAPUState{..} =
     let
-        pulse1Out = getPulseOutput pulse1
-        pulse2Out = getPulseOutput pulse2
-        triangleOut = getTriangleOutput triangle
-        noiseOut = getNoiseOutput noise
-        dmcOut = getDMCOutput dmc
-        pulseOut = pulseTable (pulse1Out + pulse2Out)
-        tndOut = tndTable (3 * triangleOut + 2 * noiseOut + dmcOut)
-        mixerOutput = pulseOut + tndOut
-    -- (res, newFilters) = processSample mixerOutput filterChain
-    -- TODO: With filter: too low
-    -- modifyAPUState $ \st' -> st'{filterChain = newFilters}
-    return mixerOutput
+        !pulse1Out = getPulseOutput pulse1
+        !pulse2Out = getPulseOutput pulse2
+        !triangleOut = getTriangleOutput triangle
+        !noiseOut = getNoiseOutput noise
+        !dmcOut = getDMCOutput dmc
+        !pulseOut = pulseTable (pulse1Out + pulse2Out)
+        !tndOut = tndTable (3 * triangleOut + 2 * noiseOut + dmcOut)
+        !mixerOutput = pulseOut + tndOut
+     in
+        mixerOutput
 
 {-# INLINE pulseTable #-}
 pulseTable :: Int -> Float

From 9590d4095cbc9f4b3666f3d9740cba5f20628c78 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 12:34:40 +0000
Subject: [PATCH 32/37] CPU Side effect is a flag register

---
 src/Nes/APU/BusInterface/Status.hs |  7 ++++---
 src/Nes/APU/Monad.hs               | 11 +++++++++--
 src/Nes/Bus/SideEffect.hs          | 26 ++++++++++++++++++--------
 src/Nes/CPU/Monad.hs               |  6 +++---
 4 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/src/Nes/APU/BusInterface/Status.hs b/src/Nes/APU/BusInterface/Status.hs
index c420d8c..48aa36a 100644
--- a/src/Nes/APU/BusInterface/Status.hs
+++ b/src/Nes/APU/BusInterface/Status.hs
@@ -7,7 +7,8 @@ import Nes.APU.State
 import Nes.APU.State.DMC
 import Nes.APU.State.LengthCounter
 import Nes.APU.Tick (setFrameInterruptFlag)
-import Nes.Bus.SideEffect (CPUSideEffect (setIRQ, startDMCDMA))
+import Nes.Bus.SideEffect
+import Nes.FlagRegister (getFlag)
 import Nes.Memory
 
 {-# INLINE write4015 #-}
@@ -44,8 +45,8 @@ read4015 = do
     pulse1Bit <- withAPUState $ lengthCounterBit . pulse1
     pulse2Bit <- withAPUState $ lengthCounterBit . pulse2
     dmcBit <- withAPUState $ \st -> sampleBytesRemaining (dmc st) > 0
-    frameInterruptBit <- withSideEffect setIRQ
-    dmcInterruptBit <- withSideEffect startDMCDMA
+    frameInterruptBit <- withSideEffect $ getFlag IRQ
+    dmcInterruptBit <- withSideEffect $ getFlag DMCDMA
     when frameInterruptBit $ do
         setFrameInterruptFlag False
     return $
diff --git a/src/Nes/APU/Monad.hs b/src/Nes/APU/Monad.hs
index ca34304..d870f8d 100644
--- a/src/Nes/APU/Monad.hs
+++ b/src/Nes/APU/Monad.hs
@@ -4,12 +4,14 @@ module Nes.APU.Monad (
     modifyAPUState,
     modifyAPUStateWithSideEffect,
     withAPUState,
+    modifyFilterChain,
     setSideEffect,
     withSideEffect,
 ) where
 
 import Control.Monad.IO.Class
 import Nes.APU.State
+import Nes.APU.State.Filter.Chain (FilterChain)
 import Nes.Bus.SideEffect
 
 newtype APU r a = MkAPU
@@ -27,8 +29,8 @@ instance Applicative (APU r) where
 
 instance Monad (APU r) where
     {-# INLINE (>>=) #-}
-    (MkAPU a) >>= next = MkAPU $ \(!st) !cpuEff cont ->
-        a st cpuEff $ \(!st') (!cpuEff') (!a') -> unAPU (next a') st' (cpuEff <> cpuEff') cont
+    (MkAPU a) >>= next = MkAPU $ \st cpuEff cont ->
+        a st cpuEff $ \(!st') (!cpuEff') (!a') -> unAPU (next a') st' cpuEff' cont
 
 instance MonadIO (APU r) where
     {-# INLINE liftIO #-}
@@ -55,6 +57,11 @@ modifyAPUStateWithSideEffect f = MkAPU $ \(!st) !cpuEff cont ->
 withAPUState :: (APUState -> a) -> APU r a
 withAPUState f = MkAPU $ \(!st) !cpuEff cont -> cont st cpuEff (f st)
 
+{-# INLINE modifyFilterChain #-}
+modifyFilterChain :: (FilterChain -> FilterChain) -> APU r ()
+modifyFilterChain f = MkAPU $ \(!st) !cpuEff cont ->
+    cont st{filterChain = f $ filterChain st} cpuEff ()
+
 {-# INLINE setSideEffect #-}
 setSideEffect :: (CPUSideEffect -> CPUSideEffect) -> APU r ()
 setSideEffect f = MkAPU $ \(!st) !cpuEff cont -> cont st (f cpuEff) ()
diff --git a/src/Nes/Bus/SideEffect.hs b/src/Nes/Bus/SideEffect.hs
index c9b1a5e..d737768 100644
--- a/src/Nes/Bus/SideEffect.hs
+++ b/src/Nes/Bus/SideEffect.hs
@@ -1,13 +1,23 @@
-module Nes.Bus.SideEffect (CPUSideEffect (..)) where
+module Nes.Bus.SideEffect (CPUSideEffect (..), CPUSideEffectFlag (..)) where
 
-data CPUSideEffect = MkSE
-    { setIRQ :: {-# UNPACK #-} !Bool
-    , startDMCDMA :: {-# UNPACK #-} !Bool
-    }
-    deriving (Eq, Show)
+import Data.Bits ((.|.))
+import Nes.FlagRegister
+import Nes.Memory
+
+newtype CPUSideEffect = MkSE {unSE :: Byte}
+
+data CPUSideEffectFlag = IRQ | DMCDMA deriving (Eq, Show, Enum)
+
+instance FlagRegister CPUSideEffect where
+    type Flag CPUSideEffect = CPUSideEffectFlag
+    fromByte = MkSE
+    toByte = unSE
+    flagToBitOffset = fromEnum
 
 instance Semigroup CPUSideEffect where
-    (MkSE !irq1 !dma1) <> (MkSE !irq2 !dma2) = MkSE (irq1 || irq2) (dma1 || dma2)
+    {-# INLINE (<>) #-}
+    MkSE se1 <> MkSE se2 = MkSE (se1 .|. se2)
 
 instance Monoid CPUSideEffect where
-    mempty = MkSE False False
+    {-# INLINE mempty #-}
+    mempty = MkSE 0
diff --git a/src/Nes/CPU/Monad.hs b/src/Nes/CPU/Monad.hs
index 24701ef..455c840 100644
--- a/src/Nes/CPU/Monad.hs
+++ b/src/Nes/CPU/Monad.hs
@@ -47,7 +47,7 @@ import Nes.Bus (Bus (..))
 import Nes.Bus.Constants
 import Nes.Bus.Monad (BusM, runBusM)
 import qualified Nes.Bus.Monad as BusM
-import Nes.Bus.SideEffect (CPUSideEffect (startDMCDMA))
+import Nes.Bus.SideEffect
 import Nes.CPU.State
 import Nes.FlagRegister
 import Nes.Interrupt
@@ -217,9 +217,9 @@ tickOnce = Nes.CPU.Monad.tick 1
 
 handleSideEffect :: CPU r ()
 handleSideEffect = do
-    hasDMCDMA <- withBusState $ startDMCDMA . cpuSideEffect
+    hasDMCDMA <- withBusState $ getFlag DMCDMA . cpuSideEffect
     when hasDMCDMA $ withBus $ do
         sampleByteAddr <- BusM.withBus $ sampleBufferAddr . dmc . apuState
         sample <- Nes.Memory.readByte sampleByteAddr ()
         BusM.withAPU $ modifyAPUState $ modifyDMC $ \d -> d{sampleBuffer = Just sample}
-        BusM.modifyBus $ \b -> b{cpuSideEffect = (cpuSideEffect b){startDMCDMA = False}}
+        BusM.modifyBus $ \b -> b{cpuSideEffect = clearFlag DMCDMA (cpuSideEffect b)}

From 2eadea1da55eaaa5237da4724d46c62063eb185b Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 12:35:39 +0000
Subject: [PATCH 33/37] Bus: Remove unpack pragmas in state

---
 src/Nes/Bus.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/src/Nes/Bus.hs b/src/Nes/Bus.hs
index d65864e..9d6444d 100644
--- a/src/Nes/Bus.hs
+++ b/src/Nes/Bus.hs
@@ -25,9 +25,9 @@ import Nes.Rom (Rom (..))
 data Bus = Bus
     { cpuVram :: {-# UNPACK #-} !MemoryPointer
     -- ^ Pointer to writeable memory
-    , cartridge :: {-# UNPACK #-} !Rom
+    , cartridge :: !Rom
     -- ^ Read-only memory, see 'Rom'
-    , controller :: {-# UNPACK #-} !Controller
+    , controller :: !Controller
     -- ^ Aka Joypad
     , cycles :: {-# UNPACK #-} !Integer
     , unsleptCycles :: {-# UNPACK #-} !Int
@@ -36,12 +36,12 @@ data Bus = Bus
     -- ^ The function to call 'threadDelay' according to 'unsleptCycles' (> 'unsleptCyclesThreshold')
     -- The return value is the new number of unslept cycles
     , lastSleepTime :: {-# UNPACK #-} !Double
-    , ppuState :: {-# UNPACK #-} !PPUState
+    , ppuState :: !PPUState
     -- ^ The state of the PPU
-    , ppuPointers :: {-# UNPACK #-} !PPUPointers
+    , ppuPointers :: !PPUPointers
     -- ^ Memory dedicated to PPU
     , onNewFrame :: Bus -> IO Bus
-    , lastReadByte :: Byte
+    , lastReadByte :: {-# UNPACK #-} !Byte
     -- ^ For open bus behaviour. Can be seen as data bus
     , apuState :: !APUState
     , cpuSideEffect :: {-# UNPACK #-} !CPUSideEffect

From 09ed6112cb4b22fca266487848f2a6ad272d2b7e Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 12:35:56 +0000
Subject: [PATCH 34/37] Use -XStrict and O3

---
 funes.cabal  | 15 ++++++++++-----
 package.yaml |  3 ++-
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/funes.cabal b/funes.cabal
index 6567e60..514ad7a 100644
--- a/funes.cabal
+++ b/funes.cabal
@@ -94,6 +94,7 @@ library
   hs-source-dirs:
       src
   default-extensions:
+      Strict
       BinaryLiterals
       LambdaCase
       GeneralizedNewtypeDeriving
@@ -104,7 +105,7 @@ library
       DeriveFunctor
       DataKinds
       QualifiedDo
-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O2
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O3
   build-depends:
       array
     , base >=4.7 && <5
@@ -123,6 +124,7 @@ executable fake-snake
   hs-source-dirs:
       examples
   default-extensions:
+      Strict
       BinaryLiterals
       LambdaCase
       GeneralizedNewtypeDeriving
@@ -133,7 +135,7 @@ executable fake-snake
       DeriveFunctor
       DataKinds
       QualifiedDo
-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O3 -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       array
     , base >=4.7 && <5
@@ -156,6 +158,7 @@ executable funes-exe
   hs-source-dirs:
       app
   default-extensions:
+      Strict
       BinaryLiterals
       LambdaCase
       GeneralizedNewtypeDeriving
@@ -166,7 +169,7 @@ executable funes-exe
       DeriveFunctor
       DataKinds
       QualifiedDo
-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O3 -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       array
     , base >=4.7 && <5
@@ -188,6 +191,7 @@ test-suite nestest
   hs-source-dirs:
       test/nestest
   default-extensions:
+      Strict
       BinaryLiterals
       LambdaCase
       GeneralizedNewtypeDeriving
@@ -198,7 +202,7 @@ test-suite nestest
       DeriveFunctor
       DataKinds
       QualifiedDo
-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O3 -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       array
     , base >=4.7 && <5
@@ -235,6 +239,7 @@ test-suite unit
   hs-source-dirs:
       test/unit
   default-extensions:
+      Strict
       BinaryLiterals
       LambdaCase
       GeneralizedNewtypeDeriving
@@ -245,7 +250,7 @@ test-suite unit
       DeriveFunctor
       DataKinds
       QualifiedDo
-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O2 -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -O3 -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       array
     , base >=4.7 && <5
diff --git a/package.yaml b/package.yaml
index ab47dc8..80ae1ac 100644
--- a/package.yaml
+++ b/package.yaml
@@ -19,6 +19,7 @@ dependencies:
   - vector
 
 default-extensions:
+  - Strict
   - BinaryLiterals
   - LambdaCase
   - GeneralizedNewtypeDeriving
@@ -40,7 +41,7 @@ ghc-options:
   - -Wmissing-home-modules
   - -Wpartial-fields
   - -Wredundant-constraints
-  - -O2
+  - -O3
 
 library:
   source-dirs: src

From c0db2307c39f7137f825c2922b8854b53c94d42c Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 12:36:05 +0000
Subject: [PATCH 35/37] Gitignore profiling files

---
 .gitignore | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.gitignore b/.gitignore
index 2a17dc5..c1c98b7 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,3 +2,4 @@
 *.log
 *.swp
 *.nes
+*.prof

From c48c9ca31d20f6a652b27bb480e038749924c1e0 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 12:36:41 +0000
Subject: [PATCH 36/37] APU: Sample Callback: Use mutable vectors instead of a
 list

---
 app/Main.hs | 60 +++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 45 insertions(+), 15 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index b50bf14..b15c07c 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,9 +1,12 @@
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
 module Main (main) where
 
 import Control.Monad
 import Data.IORef
 import qualified Data.Vector.Storable.Mutable as V
 import Events
+import Nes.APU.State.Filter.Constants
 import Nes.Bus
 import Nes.Bus.Monad (runBusM)
 import Nes.CPU.Interpreter
@@ -17,6 +20,12 @@ import SDL.Internal.Types
 import qualified SDL.Raw as Raw
 import System.Environment
 
+vectorSize :: Int
+vectorSize = 4 * sampleCount
+
+sampleCount :: Int
+sampleCount = 1024
+
 main :: IO ()
 main = do
     romPath <- do
@@ -27,8 +36,10 @@ main = do
     rom <- do
         res <- fromFile romPath
         either fail return res
-    audioSamples <- newIORef []
+    vectorCursor <- newIORef 0
+    sampleVector <- V.new vectorSize
     initializeAll
+
     let windowConfig =
             defaultWindow
                 { windowInitialSize =
@@ -40,11 +51,11 @@ main = do
     (device, _) <-
         openAudioDevice
             OpenDeviceSpec
-                { SDL.openDeviceFreq = Mandate 44100
+                { SDL.openDeviceFreq = Mandate $ floor defaultOutputRate
                 , SDL.openDeviceFormat = Mandate FloatingLEAudio
                 , SDL.openDeviceChannels = Mandate Mono
-                , SDL.openDeviceSamples = 735
-                , SDL.openDeviceCallback = audioCallback audioSamples
+                , SDL.openDeviceSamples = fromIntegral sampleCount
+                , SDL.openDeviceCallback = audioCallback sampleVector vectorCursor
                 , SDL.openDeviceUsage = ForPlayback
                 , SDL.openDeviceName = Nothing
                 }
@@ -54,14 +65,17 @@ main = do
             window
             (-1)
             defaultRenderer
-    _ <- setHintWithPriority NormalPriority HintRenderVSync DisableVSync
+    -- _ <- setHintWithPriority NormalPriority HintRenderVSync DisableVSync
     _ <- Raw.renderSetScale rendererPtr 3 3
     texture <- createTexture renderer RGB24 TextureAccessTarget (V2 256 240)
     setAudioDevicePlaybackState device Play
     frame <- newFrameState
-    let sampleCallback sample = do
-            modifyIORef audioSamples $ \array -> sample : array
-    bus <- newBus rom (onDrawFrame frame texture renderer) sampleCallback tickCallback
+    bus <-
+        newBus
+            rom
+            (onDrawFrame frame texture renderer)
+            (sampleCallback sampleVector vectorCursor)
+            tickCallback
     void $ runProgram bus (pure ())
     closeAudioDevice device
     destroyRenderer renderer
@@ -69,6 +83,13 @@ main = do
 tickCallback :: Double -> Int -> IO (Double, Int)
 tickCallback lastSleepTime_ ticks_ = return (lastSleepTime_, ticks_)
 
+sampleCallback :: V.IOVector Float -> IORef Int -> Float -> IO ()
+sampleCallback vec cursorRef sample = do
+    cursor <- readIORef cursorRef
+    when (cursor < vectorSize) $ do
+        V.write vec cursor sample
+        writeIORef cursorRef (cursor + 1)
+
 --   !currentTime <- getCPUTimeUs
 --   let !totalTickDurationUs = tickDurationUs * fromIntegral ticks_
 --       !deltaTimeUs = currentTime - lastSleepTime
@@ -94,14 +115,23 @@ tickCallback lastSleepTime_ ticks_ = return (lastSleepTime_, ticks_)
 --   -- Frequency in Hz
 --   cpuFrequency = 1.789773 * 1000000
 
-audioCallback :: IORef [Float] -> AudioFormat sampleType -> V.IOVector sampleType -> IO ()
-audioCallback samples fmt buffer = case fmt of
+audioCallback :: V.IOVector Float -> IORef Int -> AudioFormat sampleType -> V.IOVector sampleType -> IO ()
+audioCallback samples cursorRef fmt buffer = case fmt of
     FloatingLEAudio -> do
-        samples' <- readIORef samples
-        let n = V.length buffer
-            samples1 = reverse samples'
-        zipWithM_ (V.write buffer) [0 ..] (take n samples1)
-        writeIORef samples (reverse $ drop n samples1)
+        cursor <- readIORef cursorRef
+        let bufferLen = V.length buffer
+            nToCopy = min bufferLen cursor
+        when (cursor < bufferLen) $ do
+            V.set buffer 0
+        V.copy (V.slice 0 nToCopy buffer) (V.slice 0 nToCopy samples)
+        -- If more samples are ready
+        if cursor > bufferLen
+            then do
+                let toShift = cursor - bufferLen
+                V.unsafeCopy (V.slice 0 toShift samples) (V.slice (cursor - 1) toShift samples)
+                writeIORef cursorRef toShift
+            else
+                writeIORef cursorRef 0
     _ -> error "Unsupported audio format"
 
 onDrawFrame :: FrameState -> Texture -> Renderer -> Bus -> IO Bus

From fcb300a72f375681874942d275970a9c7ce16252 Mon Sep 17 00:00:00 2001
From: Arthur Jamet <arthur.jamet@gmail.com>
Date: Fri, 14 Nov 2025 13:00:26 +0000
Subject: [PATCH 37/37] Fix tests

---
 test/nestest/Spec.hs  | 2 +-
 test/unit/Internal.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/nestest/Spec.hs b/test/nestest/Spec.hs
index 793bc6e..821fba2 100644
--- a/test/nestest/Spec.hs
+++ b/test/nestest/Spec.hs
@@ -38,7 +38,7 @@ spec = it "Trace should match logfile" $ do
     rom <- do
         eitherRom <- fromFile "test/assets/rom.nes"
         either fail return eitherRom
-    bus <- newBus rom pure (\a b -> return (a, b))
+    bus <- newBus rom pure (\_ -> pure ()) (\a b -> return (a, b))
     traceRef <- newIORef (T [] 0)
     let st = newCPUState{programCounter = 0xc000}
     -- TODO why is the tick count set to 7 ? Reset?
diff --git a/test/unit/Internal.hs b/test/unit/Internal.hs
index 7027cec..58a8a32 100644
--- a/test/unit/Internal.hs
+++ b/test/unit/Internal.hs
@@ -21,7 +21,7 @@ withStateAndMemorySetup ::
     (CPUState -> Bus -> IO r') ->
     IO ()
 withStateAndMemorySetup program st memSetup post = do
-    bus <- newBus unsafeEmptyRom pure (\a b -> return (a, b))
+    bus <- newBus unsafeEmptyRom pure (\_ -> pure ()) (\a b -> return (a, b))
     loadProgramToMemory program bus
     _ <- memSetup bus
     -- Not we do not read 0xfffc because it's out of the bus read