module Nes.PPU.Monad (
    -- * Monad
    PPU (..),
    runPPU,

    -- * Ticks
    tick,

    -- * State
    withPointers,

    -- * Vram
    readData,
    writeData,
    mirrorVramAddr,
    incrementVramAddr,

    -- * Registers
    writeToAddressRegister,
    writeToControlRegister,
    setScrollRegister,

    -- * Status
    readStatus,

    -- * OAM
    readOamData,
    writeOamData,
    writeListToOam,
) where

import Control.Monad
import Control.Monad.IO.Class
import Data.Bits
import qualified Data.ByteString as BS
import Data.Foldable (foldlM)
import Data.Functor ((<&>))
import Data.Ix
import Nes.FlagRegister
import Nes.Internal.MonadState
import Nes.Memory
import Nes.Memory.Unsafe ()
import Nes.PPU.Constants
import Nes.PPU.Pointers
import Nes.PPU.State
import Nes.Rom (Mirroring (..), Rom, chrRom)

newtype PPU r a = MkPPU
    { forall r a.
PPU r a
-> PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> a -> IO r)
-> IO r
unPPU ::
        PPUState ->
        PPUPointers ->
        Rom ->
        ( PPUState ->
          PPUPointers ->
          a ->
          IO r
        ) -> -- Continuation
        IO r
    }
    deriving ((forall a b. (a -> b) -> PPU r a -> PPU r b)
-> (forall a b. a -> PPU r b -> PPU r a) -> Functor (PPU r)
forall a b. a -> PPU r b -> PPU r a
forall a b. (a -> b) -> PPU r a -> PPU r b
forall r a b. a -> PPU r b -> PPU r a
forall r a b. (a -> b) -> PPU r a -> PPU r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r a b. (a -> b) -> PPU r a -> PPU r b
fmap :: forall a b. (a -> b) -> PPU r a -> PPU r b
$c<$ :: forall r a b. a -> PPU r b -> PPU r a
<$ :: forall a b. a -> PPU r b -> PPU r a
Functor)

{-# INLINE runPPU #-}
runPPU :: PPUState -> PPUPointers -> Rom -> PPU (a, PPUState) a -> IO (a, PPUState)
runPPU :: forall a.
PPUState
-> PPUPointers -> Rom -> PPU (a, PPUState) a -> IO (a, PPUState)
runPPU PPUState
st PPUPointers
ptrs Rom
rom PPU (a, PPUState) a
f = PPU (a, PPUState) (a, PPUState)
-> PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> (a, PPUState) -> IO (a, PPUState))
-> IO (a, PPUState)
forall r a.
PPU r a
-> PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> a -> IO r)
-> IO r
unPPU PPU (a, PPUState) (a, PPUState)
op PPUState
st PPUPointers
ptrs Rom
rom ((PPUState -> PPUPointers -> (a, PPUState) -> IO (a, PPUState))
 -> IO (a, PPUState))
-> (PPUState -> PPUPointers -> (a, PPUState) -> IO (a, PPUState))
-> IO (a, PPUState)
forall a b. (a -> b) -> a -> b
$ \PPUState
_ PPUPointers
_ (a, PPUState)
a -> (a, PPUState) -> IO (a, PPUState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a, PPUState)
a
  where
    op :: PPU (a, PPUState) (a, PPUState)
op = PPU (a, PPUState) a
f PPU (a, PPUState) a
-> (a -> PPU (a, PPUState) (a, PPUState))
-> PPU (a, PPUState) (a, PPUState)
forall a b.
PPU (a, PPUState) a
-> (a -> PPU (a, PPUState) b) -> PPU (a, PPUState) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> (PPUState -> (a, PPUState)) -> PPU (a, PPUState) (a, PPUState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (a
a,)

instance Applicative (PPU r) where
    {-# INLINE pure #-}
    pure :: forall a. a -> PPU r a
pure a
a = (PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
forall r a.
(PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
MkPPU ((PPUState
  -> PPUPointers
  -> Rom
  -> (PPUState -> PPUPointers -> a -> IO r)
  -> IO r)
 -> PPU r a)
-> (PPUState
    -> PPUPointers
    -> Rom
    -> (PPUState -> PPUPointers -> a -> IO r)
    -> IO r)
-> PPU r a
forall a b. (a -> b) -> a -> b
$ \PPUState
st PPUPointers
ptr Rom
_ PPUState -> PPUPointers -> a -> IO r
cont -> PPUState -> PPUPointers -> a -> IO r
cont PPUState
st PPUPointers
ptr a
a

    {-# INLINE liftA2 #-}
    liftA2 :: forall a b c. (a -> b -> c) -> PPU r a -> PPU r b -> PPU r c
liftA2 a -> b -> c
f (MkPPU PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> a -> IO r)
-> IO r
a) (MkPPU PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> b -> IO r)
-> IO r
b) = (PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> c -> IO r)
 -> IO r)
-> PPU r c
forall r a.
(PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
MkPPU ((PPUState
  -> PPUPointers
  -> Rom
  -> (PPUState -> PPUPointers -> c -> IO r)
  -> IO r)
 -> PPU r c)
-> (PPUState
    -> PPUPointers
    -> Rom
    -> (PPUState -> PPUPointers -> c -> IO r)
    -> IO r)
-> PPU r c
forall a b. (a -> b) -> a -> b
$ \PPUState
st PPUPointers
ptr Rom
rom PPUState -> PPUPointers -> c -> IO r
cont ->
        PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> a -> IO r)
-> IO r
a PPUState
st PPUPointers
ptr Rom
rom ((PPUState -> PPUPointers -> a -> IO r) -> IO r)
-> (PPUState -> PPUPointers -> a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \PPUState
st' PPUPointers
ptr' a
aRes ->
            PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> b -> IO r)
-> IO r
b PPUState
st' PPUPointers
ptr' Rom
rom ((PPUState -> PPUPointers -> b -> IO r) -> IO r)
-> (PPUState -> PPUPointers -> b -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \PPUState
st'' PPUPointers
ptr'' b
bRes ->
                PPUState -> PPUPointers -> c -> IO r
cont PPUState
st'' PPUPointers
ptr'' (a -> b -> c
f a
aRes b
bRes)

instance Monad (PPU r) where
    {-# INLINE (>>=) #-}
    (MkPPU PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> a -> IO r)
-> IO r
a) >>= :: forall a b. PPU r a -> (a -> PPU r b) -> PPU r b
>>= a -> PPU r b
next = (PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> b -> IO r)
 -> IO r)
-> PPU r b
forall r a.
(PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
MkPPU ((PPUState
  -> PPUPointers
  -> Rom
  -> (PPUState -> PPUPointers -> b -> IO r)
  -> IO r)
 -> PPU r b)
-> (PPUState
    -> PPUPointers
    -> Rom
    -> (PPUState -> PPUPointers -> b -> IO r)
    -> IO r)
-> PPU r b
forall a b. (a -> b) -> a -> b
$ \PPUState
st PPUPointers
ptr Rom
rom PPUState -> PPUPointers -> b -> IO r
cont ->
        PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> a -> IO r)
-> IO r
a PPUState
st PPUPointers
ptr Rom
rom ((PPUState -> PPUPointers -> a -> IO r) -> IO r)
-> (PPUState -> PPUPointers -> a -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \PPUState
st' PPUPointers
ptr' a
aRes ->
            PPU r b
-> PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> b -> IO r)
-> IO r
forall r a.
PPU r a
-> PPUState
-> PPUPointers
-> Rom
-> (PPUState -> PPUPointers -> a -> IO r)
-> IO r
unPPU (a -> PPU r b
next a
aRes) PPUState
st' PPUPointers
ptr' Rom
rom PPUState -> PPUPointers -> b -> IO r
cont

instance (MonadIO (PPU r)) where
    {-# INLINE liftIO #-}
    liftIO :: forall a. IO a -> PPU r a
liftIO IO a
io = (PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
forall r a.
(PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
MkPPU ((PPUState
  -> PPUPointers
  -> Rom
  -> (PPUState -> PPUPointers -> a -> IO r)
  -> IO r)
 -> PPU r a)
-> (PPUState
    -> PPUPointers
    -> Rom
    -> (PPUState -> PPUPointers -> a -> IO r)
    -> IO r)
-> PPU r a
forall a b. (a -> b) -> a -> b
$ \PPUState
st PPUPointers
ptr Rom
_ PPUState -> PPUPointers -> a -> IO r
cont ->
        IO a
io IO a -> (a -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PPUState -> PPUPointers -> a -> IO r
cont PPUState
st PPUPointers
ptr

instance (MonadFail (PPU r)) where
    {-# INLINE fail #-}
    fail :: forall a. String -> PPU r a
fail String
s = IO a -> PPU r a
forall a. IO a -> PPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> PPU r a) -> IO a -> PPU r a
forall a b. (a -> b) -> a -> b
$ String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
s

instance MonadState PPUState (PPU r) where
    {-# INLINE get #-}
    get :: PPU r PPUState
get = (PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> PPUState -> IO r)
 -> IO r)
-> PPU r PPUState
forall r a.
(PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
MkPPU ((PPUState
  -> PPUPointers
  -> Rom
  -> (PPUState -> PPUPointers -> PPUState -> IO r)
  -> IO r)
 -> PPU r PPUState)
-> (PPUState
    -> PPUPointers
    -> Rom
    -> (PPUState -> PPUPointers -> PPUState -> IO r)
    -> IO r)
-> PPU r PPUState
forall a b. (a -> b) -> a -> b
$ \PPUState
st PPUPointers
ptr Rom
_ PPUState -> PPUPointers -> PPUState -> IO r
cont -> PPUState -> PPUPointers -> PPUState -> IO r
cont PPUState
st PPUPointers
ptr PPUState
st
    {-# INLINE set #-}
    set :: PPUState -> PPU r ()
set PPUState
st' = (PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> () -> IO r)
 -> IO r)
-> PPU r ()
forall r a.
(PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
MkPPU ((PPUState
  -> PPUPointers
  -> Rom
  -> (PPUState -> PPUPointers -> () -> IO r)
  -> IO r)
 -> PPU r ())
-> (PPUState
    -> PPUPointers
    -> Rom
    -> (PPUState -> PPUPointers -> () -> IO r)
    -> IO r)
-> PPU r ()
forall a b. (a -> b) -> a -> b
$ \PPUState
_ PPUPointers
ptr Rom
_ PPUState -> PPUPointers -> () -> IO r
cont -> PPUState -> PPUPointers -> () -> IO r
cont PPUState
st' PPUPointers
ptr ()

tick :: Int -> PPU r Bool
tick :: forall r. Int -> PPU r Bool
tick Int
cycles_ = do
    (Int -> Identity Int) -> PPUState -> Identity PPUState
Lens' PPUState Int
cycles ((Int -> Identity Int) -> PPUState -> Identity PPUState)
-> Int -> PPU r ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int
cycles_
    Int
newCycles <- Getting Int PPUState Int -> PPU r Int
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Int PPUState Int
Lens' PPUState Int
cycles
    if Int
newCycles Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
341
        then do
            Bool
hits <- Int -> PPU r Bool
forall r. Int -> PPU r Bool
isSpriteZeroHit Int
newCycles
            Bool -> PPU r () -> PPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hits (PPU r () -> PPU r ()) -> PPU r () -> PPU r ()
forall a b. (a -> b) -> a -> b
$ (StatusRegister -> Identity StatusRegister)
-> PPUState -> Identity PPUState
Lens' PPUState StatusRegister
statusRegister ((StatusRegister -> Identity StatusRegister)
 -> PPUState -> Identity PPUState)
-> (StatusRegister -> StatusRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
setFlag Flag StatusRegister
StatusRegisterFlag
SpriteZeroHit
            (Int -> Identity Int) -> PPUState -> Identity PPUState
Lens' PPUState Int
cycles ((Int -> Identity Int) -> PPUState -> Identity PPUState)
-> Int -> PPU r ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= (-Int
341)
            (Word16 -> Identity Word16) -> PPUState -> Identity PPUState
Lens' PPUState Word16
scanline ((Word16 -> Identity Word16) -> PPUState -> Identity PPUState)
-> Word16 -> PPU r ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Word16
1
            Word16
scanline_ <- Getting Word16 PPUState Word16 -> PPU r Word16
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Word16 PPUState Word16
Lens' PPUState Word16
scanline
            Bool -> PPU r () -> PPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
scanline_ Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
241) (PPU r () -> PPU r ()) -> PPU r () -> PPU r ()
forall a b. (a -> b) -> a -> b
$ do
                (StatusRegister -> Identity StatusRegister)
-> PPUState -> Identity PPUState
Lens' PPUState StatusRegister
statusRegister ((StatusRegister -> Identity StatusRegister)
 -> PPUState -> Identity PPUState)
-> (StatusRegister -> StatusRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
setFlag Flag StatusRegister
StatusRegisterFlag
VBlankStarted (StatusRegister -> StatusRegister)
-> (StatusRegister -> StatusRegister)
-> StatusRegister
-> StatusRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
clearFlag Flag StatusRegister
StatusRegisterFlag
SpriteZeroHit)
                Bool
shouldStartNmi <- Getting ControlRegister PPUState ControlRegister
-> (ControlRegister -> Bool) -> PPU r Bool
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting ControlRegister PPUState ControlRegister
Lens' PPUState ControlRegister
controlRegister ((ControlRegister -> Bool) -> PPU r Bool)
-> (ControlRegister -> Bool) -> PPU r Bool
forall a b. (a -> b) -> a -> b
$ Flag ControlRegister -> ControlRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag ControlRegister
ControlRegisterFlag
GenerateNMI
                (Bool -> Identity Bool) -> PPUState -> Identity PPUState
Lens' PPUState Bool
nmiInterrupt ((Bool -> Identity Bool) -> PPUState -> Identity PPUState)
-> Bool -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Bool
shouldStartNmi
            if Word16
scanline_ Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
262
                then do
                    (Word16 -> Identity Word16) -> PPUState -> Identity PPUState
Lens' PPUState Word16
scanline ((Word16 -> Identity Word16) -> PPUState -> Identity PPUState)
-> Word16 -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Word16
0
                    (Bool -> Identity Bool) -> PPUState -> Identity PPUState
Lens' PPUState Bool
nmiInterrupt ((Bool -> Identity Bool) -> PPUState -> Identity PPUState)
-> Bool -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Bool
False
                    (StatusRegister -> Identity StatusRegister)
-> PPUState -> Identity PPUState
Lens' PPUState StatusRegister
statusRegister ((StatusRegister -> Identity StatusRegister)
 -> PPUState -> Identity PPUState)
-> (StatusRegister -> StatusRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
clearFlag Flag StatusRegister
StatusRegisterFlag
SpriteZeroHit (StatusRegister -> StatusRegister)
-> (StatusRegister -> StatusRegister)
-> StatusRegister
-> StatusRegister
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
clearFlag Flag StatusRegister
StatusRegisterFlag
VBlankStarted)
                    Bool -> PPU r Bool
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                else Bool -> PPU r Bool
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        else Bool -> PPU r Bool
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

isSpriteZeroHit :: Int -> PPU r Bool
isSpriteZeroHit :: forall r. Int -> PPU r Bool
isSpriteZeroHit Int
cycle_ = do
    Word16
scanline_ <- Getting Word16 PPUState Word16 -> PPU r Word16
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Word16 PPUState Word16
Lens' PPUState Word16
scanline
    Word16
line <- Addr -> Word16
unAddr (Addr -> Word16) -> (Byte -> Addr) -> Byte -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Byte -> Addr
byteToAddr (Byte -> Word16) -> PPU r Byte -> PPU r Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Addr -> MemoryPointer -> PPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
0 (MemoryPointer -> PPU r Byte) -> PPU r MemoryPointer -> PPU r Byte
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PPUPointers -> MemoryPointer) -> PPU r MemoryPointer
forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> MemoryPointer
oamData)
    Int
col <- Byte -> Int
byteToInt (Byte -> Int) -> PPU r Byte -> PPU r Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Addr -> MemoryPointer -> PPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
3 (MemoryPointer -> PPU r Byte) -> PPU r MemoryPointer -> PPU r Byte
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PPUPointers -> MemoryPointer) -> PPU r MemoryPointer
forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> MemoryPointer
oamData)
    Bool
showSprites <- Getting MaskRegister PPUState MaskRegister
-> (MaskRegister -> Bool) -> PPU r Bool
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting MaskRegister PPUState MaskRegister
Lens' PPUState MaskRegister
maskRegister ((MaskRegister -> Bool) -> PPU r Bool)
-> (MaskRegister -> Bool) -> PPU r Bool
forall a b. (a -> b) -> a -> b
$ Flag MaskRegister -> MaskRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag MaskRegister
MaskRegisterFlag
ShowSprites
    Bool -> PPU r Bool
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> PPU r Bool) -> Bool -> PPU r Bool
forall a b. (a -> b) -> a -> b
$ (Word16
line Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
scanline_) Bool -> Bool -> Bool
&& Int
col Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
cycle_ Bool -> Bool -> Bool
&& Bool
showSprites

{-# INLINE withPointers #-}
withPointers :: (PPUPointers -> a) -> PPU r a
withPointers :: forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> a
f = (PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
forall r a.
(PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
MkPPU ((PPUState
  -> PPUPointers
  -> Rom
  -> (PPUState -> PPUPointers -> a -> IO r)
  -> IO r)
 -> PPU r a)
-> (PPUState
    -> PPUPointers
    -> Rom
    -> (PPUState -> PPUPointers -> a -> IO r)
    -> IO r)
-> PPU r a
forall a b. (a -> b) -> a -> b
$ \PPUState
st PPUPointers
ptr Rom
_ PPUState -> PPUPointers -> a -> IO r
cont ->
    PPUState -> PPUPointers -> a -> IO r
cont PPUState
st PPUPointers
ptr (PPUPointers -> a
f PPUPointers
ptr)

{-# INLINE incrementVramAddr #-}
incrementVramAddr :: PPU r ()
incrementVramAddr :: forall r. PPU r ()
incrementVramAddr = do
    Byte
incr <- Getting ControlRegister PPUState ControlRegister
-> (ControlRegister -> Byte) -> PPU r Byte
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting ControlRegister PPUState ControlRegister
Lens' PPUState ControlRegister
controlRegister ControlRegister -> Byte
vramAddrIncrement
    (AddressRegister -> Identity AddressRegister)
-> PPUState -> Identity PPUState
Lens' PPUState AddressRegister
addressRegister ((AddressRegister -> Identity AddressRegister)
 -> PPUState -> Identity PPUState)
-> (AddressRegister -> AddressRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Byte -> AddressRegister -> AddressRegister
addressRegisterIncrement Byte
incr

readStatus :: PPU r Byte
readStatus :: forall r. PPU r Byte
readStatus = do
    Byte
byte <- Getting StatusRegister PPUState StatusRegister
-> (StatusRegister -> Byte) -> PPU r Byte
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting StatusRegister PPUState StatusRegister
Lens' PPUState StatusRegister
statusRegister StatusRegister -> Byte
unSR
    (StatusRegister -> Identity StatusRegister)
-> PPUState -> Identity PPUState
Lens' PPUState StatusRegister
statusRegister ((StatusRegister -> Identity StatusRegister)
 -> PPUState -> Identity PPUState)
-> (StatusRegister -> StatusRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> a -> a
clearFlag Flag StatusRegister
StatusRegisterFlag
VBlankStarted
    (AddressRegister -> Identity AddressRegister)
-> PPUState -> Identity PPUState
Lens' PPUState AddressRegister
addressRegister ((AddressRegister -> Identity AddressRegister)
 -> PPUState -> Identity PPUState)
-> (AddressRegister -> AddressRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= AddressRegister -> AddressRegister
addressRegisterResetLatch
    (ScrollRegister -> Identity ScrollRegister)
-> PPUState -> Identity PPUState
Lens' PPUState ScrollRegister
scrollRegister ((ScrollRegister -> Identity ScrollRegister)
 -> PPUState -> Identity PPUState)
-> (ScrollRegister -> ScrollRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= ScrollRegister -> ScrollRegister
scrollRegisterResetLatch
    Byte -> PPU r Byte
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
byte

readOamData :: PPU r Byte
readOamData :: forall r. PPU r Byte
readOamData = do
    MemoryPointer
oam <- (PPUPointers -> MemoryPointer) -> PPU r MemoryPointer
forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> MemoryPointer
oamData
    Byte
addr <- Getting Byte PPUState Byte -> PPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte PPUState Byte
Lens' PPUState Byte
oamOffset
    Addr -> MemoryPointer -> PPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte (Byte -> Addr
byteToAddr Byte
addr) MemoryPointer
oam

writeOamData :: Byte -> PPU r ()
writeOamData :: forall r. Byte -> PPU r ()
writeOamData Byte
byte = do
    MemoryPointer
oam <- (PPUPointers -> MemoryPointer) -> PPU r MemoryPointer
forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> MemoryPointer
oamData
    Byte
addr <- Getting Byte PPUState Byte -> PPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte PPUState Byte
Lens' PPUState Byte
oamOffset
    Byte -> Addr -> MemoryPointer -> PPU r ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
byte (Byte -> Addr
byteToAddr Byte
addr) MemoryPointer
oam
    (Byte -> Identity Byte) -> PPUState -> Identity PPUState
Lens' PPUState Byte
oamOffset ((Byte -> Identity Byte) -> PPUState -> Identity PPUState)
-> Byte -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= (Byte
addr Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
1)

{-# INLINE writeListToOam #-}
writeListToOam :: [Byte] -> PPU r ()
writeListToOam :: forall r. [Byte] -> PPU r ()
writeListToOam = (() -> Byte -> PPU r ()) -> () -> [Byte] -> PPU r ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\()
_ Byte
item -> Byte -> PPU r ()
forall r. Byte -> PPU r ()
writeOamData Byte
item) ()

{-# INLINE writeToAddressRegister #-}
writeToAddressRegister :: Byte -> PPU r ()
writeToAddressRegister :: forall r. Byte -> PPU r ()
writeToAddressRegister Byte
byte = (AddressRegister -> Identity AddressRegister)
-> PPUState -> Identity PPUState
Lens' PPUState AddressRegister
addressRegister ((AddressRegister -> Identity AddressRegister)
 -> PPUState -> Identity PPUState)
-> (AddressRegister -> AddressRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Byte -> AddressRegister -> AddressRegister
addressRegisterUpdate Byte
byte

writeToControlRegister :: Byte -> PPU r ()
writeToControlRegister :: forall r. Byte -> PPU r ()
writeToControlRegister Byte
byte = do
    Bool
oldNmi <- Getting ControlRegister PPUState ControlRegister
-> (ControlRegister -> Bool) -> PPU r Bool
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting ControlRegister PPUState ControlRegister
Lens' PPUState ControlRegister
controlRegister ((ControlRegister -> Bool) -> PPU r Bool)
-> (ControlRegister -> Bool) -> PPU r Bool
forall a b. (a -> b) -> a -> b
$ Flag ControlRegister -> ControlRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag ControlRegister
ControlRegisterFlag
GenerateNMI
    let newCR :: ControlRegister
newCR = Byte -> ControlRegister
MkCR Byte
byte
        newNmi :: Bool
newNmi = Flag ControlRegister -> ControlRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag ControlRegister
ControlRegisterFlag
GenerateNMI ControlRegister
newCR
    (ControlRegister -> Identity ControlRegister)
-> PPUState -> Identity PPUState
Lens' PPUState ControlRegister
controlRegister ((ControlRegister -> Identity ControlRegister)
 -> PPUState -> Identity PPUState)
-> ControlRegister -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= ControlRegister
newCR
    Bool
isInVBlank <- Getting StatusRegister PPUState StatusRegister
-> (StatusRegister -> Bool) -> PPU r Bool
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting StatusRegister PPUState StatusRegister
Lens' PPUState StatusRegister
statusRegister ((StatusRegister -> Bool) -> PPU r Bool)
-> (StatusRegister -> Bool) -> PPU r Bool
forall a b. (a -> b) -> a -> b
$ Flag StatusRegister -> StatusRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag StatusRegister
StatusRegisterFlag
VBlankStarted
    Bool -> PPU r () -> PPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
oldNmi Bool -> Bool -> Bool
&& Bool
newNmi Bool -> Bool -> Bool
&& Bool
isInVBlank) (PPU r () -> PPU r ()) -> PPU r () -> PPU r ()
forall a b. (a -> b) -> a -> b
$
        (Bool -> Identity Bool) -> PPUState -> Identity PPUState
Lens' PPUState Bool
nmiInterrupt ((Bool -> Identity Bool) -> PPUState -> Identity PPUState)
-> Bool -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Bool
True

{-# INLINE setScrollRegister #-}
setScrollRegister :: Byte -> PPU r ()
setScrollRegister :: forall r. Byte -> PPU r ()
setScrollRegister Byte
byte = (ScrollRegister -> Identity ScrollRegister)
-> PPUState -> Identity PPUState
Lens' PPUState ScrollRegister
scrollRegister ((ScrollRegister -> Identity ScrollRegister)
 -> PPUState -> Identity PPUState)
-> (ScrollRegister -> ScrollRegister) -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Byte -> ScrollRegister -> ScrollRegister
scrollRegisterWrite Byte
byte

{-# INLINE withCartridge #-}
withCartridge :: (Rom -> a) -> PPU r a
withCartridge :: forall a r. (Rom -> a) -> PPU r a
withCartridge Rom -> a
f = (PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
forall r a.
(PPUState
 -> PPUPointers
 -> Rom
 -> (PPUState -> PPUPointers -> a -> IO r)
 -> IO r)
-> PPU r a
MkPPU ((PPUState
  -> PPUPointers
  -> Rom
  -> (PPUState -> PPUPointers -> a -> IO r)
  -> IO r)
 -> PPU r a)
-> (PPUState
    -> PPUPointers
    -> Rom
    -> (PPUState -> PPUPointers -> a -> IO r)
    -> IO r)
-> PPU r a
forall a b. (a -> b) -> a -> b
$ \PPUState
st PPUPointers
ptrs Rom
rom PPUState -> PPUPointers -> a -> IO r
cont -> PPUState -> PPUPointers -> a -> IO r
cont PPUState
st PPUPointers
ptrs (Rom -> a
f Rom
rom)

readData :: PPU r Byte
readData :: forall r. PPU r Byte
readData = do
    Addr
addr <- Getting AddressRegister PPUState AddressRegister
-> (AddressRegister -> Addr) -> PPU r Addr
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting AddressRegister PPUState AddressRegister
Lens' PPUState AddressRegister
addressRegister AddressRegister -> Addr
addressRegisterGet
    Byte
res <- Addr -> PPU r Byte
forall {r}. Addr -> PPU r Byte
go Addr
addr
    PPU r ()
forall r. PPU r ()
incrementVramAddr
    Byte -> PPU r Byte
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res
  where
    go :: Addr -> PPU r Byte
go Addr
addr
        | (Addr, Addr) -> Addr -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Addr, Addr)
chrRomRange Addr
addr = do
            Byte
res <- Getting Byte PPUState Byte -> PPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte PPUState Byte
Lens' PPUState Byte
internalBuffer
            Byte
value <- Word8 -> Byte
Byte (Word8 -> Byte) -> PPU r Word8 -> PPU r Byte
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Rom -> ByteString) -> PPU r ByteString
forall a r. (Rom -> a) -> PPU r a
withCartridge Rom -> ByteString
chrRom PPU r ByteString -> (ByteString -> Word8) -> PPU r Word8
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
`BS.index` Addr -> Int
addrToInt Addr
addr))
            (Byte -> Identity Byte) -> PPUState -> Identity PPUState
Lens' PPUState Byte
internalBuffer ((Byte -> Identity Byte) -> PPUState -> Identity PPUState)
-> Byte -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
value
            Byte -> PPU r Byte
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res
        | (Addr, Addr) -> Addr -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Addr, Addr)
vramRange Addr
addr = do
            Byte
res <- Getting Byte PPUState Byte -> PPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte PPUState Byte
Lens' PPUState Byte
internalBuffer
            Mirroring
mirr <- Getting Mirroring PPUState Mirroring -> PPU r Mirroring
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mirroring PPUState Mirroring
Lens' PPUState Mirroring
mirroring
            Byte
value <- Addr -> MemoryPointer -> PPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte (Mirroring -> Addr -> Addr
mirrorVramAddr Mirroring
mirr Addr
addr) (MemoryPointer -> PPU r Byte) -> PPU r MemoryPointer -> PPU r Byte
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PPUPointers -> MemoryPointer) -> PPU r MemoryPointer
forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> MemoryPointer
vram
            (Byte -> Identity Byte) -> PPUState -> Identity PPUState
Lens' PPUState Byte
internalBuffer ((Byte -> Identity Byte) -> PPUState -> Identity PPUState)
-> Byte -> PPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
value
            Byte -> PPU r Byte
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res
        | (Addr, Addr) -> Addr -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Addr, Addr)
unusedAddrRange Addr
addr = do
            IO () -> PPU r ()
forall a. IO a -> PPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PPU r ()) -> IO () -> PPU r ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Address range should not be accessed"
            Byte -> PPU r Byte
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
0
        | (Addr, Addr) -> Addr -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Addr, Addr)
paletteTableRange Addr
addr = do
            MemoryPointer
plt <- (PPUPointers -> MemoryPointer) -> PPU r MemoryPointer
forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> MemoryPointer
paletteTable
            -- https://github.com/bugzmanov/nes_ebook/blob/785b9ed8b803d9f4bd51274f4d0c68c14a1b3a8b/code/ch6.1/src/ppu/mod.rs#L169
            let addr1 :: Addr
addr1 =
                    if Addr
addr Addr -> [Addr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Addr]
paletteIndexes
                        then Addr
addr Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x10
                        else Addr
addr
            IO Byte -> PPU r Byte
forall a. IO a -> PPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Byte -> PPU r Byte) -> IO Byte -> PPU r Byte
forall a b. (a -> b) -> a -> b
$ Addr -> MemoryPointer -> IO Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte (Addr
addr1 Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x3f00) MemoryPointer
plt
        | Bool
otherwise = do
            IO () -> PPU r ()
forall a. IO a -> PPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PPU r ()) -> IO () -> PPU r ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Unexpected access to mirrored space"
            Byte -> PPU r Byte
forall a. a -> PPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
0

writeData :: Byte -> PPU r ()
writeData :: forall r. Byte -> PPU r ()
writeData Byte
byte = do
    Addr
addr <- Getting AddressRegister PPUState AddressRegister
-> (AddressRegister -> Addr) -> PPU r Addr
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting AddressRegister PPUState AddressRegister
Lens' PPUState AddressRegister
addressRegister AddressRegister -> Addr
addressRegisterGet
    PPU r ()
forall r. PPU r ()
incrementVramAddr
    Addr -> PPU r ()
go Addr
addr
  where
    go :: Addr -> PPU r ()
go Addr
addr
        | (Addr, Addr) -> Addr -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Addr, Addr)
chrRomRange Addr
addr = IO () -> PPU r ()
forall a. IO a -> PPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PPU r ()) -> IO () -> PPU r ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Invalid write to CHR Rom"
        | (Addr, Addr) -> Addr -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Addr, Addr)
vramRange Addr
addr = do
            Mirroring
mirr <- Getting Mirroring PPUState Mirroring -> PPU r Mirroring
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Mirroring PPUState Mirroring
Lens' PPUState Mirroring
mirroring
            Byte -> Addr -> MemoryPointer -> PPU r ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
byte (Mirroring -> Addr -> Addr
mirrorVramAddr Mirroring
mirr Addr
addr) (MemoryPointer -> PPU r ()) -> PPU r MemoryPointer -> PPU r ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PPUPointers -> MemoryPointer) -> PPU r MemoryPointer
forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> MemoryPointer
vram
        | (Addr, Addr) -> Addr -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Addr, Addr)
unusedAddrRange Addr
addr = IO () -> PPU r ()
forall a. IO a -> PPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PPU r ()) -> IO () -> PPU r ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Invalid write in address space"
        | (Addr, Addr) -> Addr -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Addr, Addr)
paletteTableRange Addr
addr = do
            MemoryPointer
plt <- (PPUPointers -> MemoryPointer) -> PPU r MemoryPointer
forall a r. (PPUPointers -> a) -> PPU r a
withPointers PPUPointers -> MemoryPointer
paletteTable
            let addr1 :: Addr
addr1 =
                    if Addr
addr Addr -> [Addr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Addr]
paletteIndexes
                        then Addr
addr Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x10
                        else Addr
addr
            IO () -> PPU r ()
forall a. IO a -> PPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PPU r ()) -> IO () -> PPU r ()
forall a b. (a -> b) -> a -> b
$ Byte -> Addr -> MemoryPointer -> IO ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
byte (Addr
addr1 Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x3f00) MemoryPointer
plt
        | Bool
otherwise = IO () -> PPU r ()
forall a. IO a -> PPU r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PPU r ()) -> IO () -> PPU r ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Unexpected access to mirrored space"

{-# INLINE mirrorVramAddr #-}
mirrorVramAddr :: Mirroring -> Addr -> Addr
mirrorVramAddr :: Mirroring -> Addr -> Addr
mirrorVramAddr Mirroring
mirr Addr
addr = case (Mirroring
mirr, Word16
nameTable) of
    (Mirroring
Vertical, Word16
2) -> Addr
vramIndex Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x800
    (Mirroring
Vertical, Word16
3) -> Addr
vramIndex Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x800
    (Mirroring
Horizontal, Word16
2) -> Addr
vramIndex Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x400
    (Mirroring
Horizontal, Word16
1) -> Addr
vramIndex Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x400
    (Mirroring
Horizontal, Word16
3) -> Addr
vramIndex Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x800
    (Mirroring, Word16)
_ -> Addr
vramIndex
  where
    mirroredVram :: Addr
mirroredVram = Addr
addr Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.&. Addr
0b10111111111111
    vramIndex :: Addr
vramIndex = Addr
mirroredVram Addr -> Addr -> Addr
forall a. Num a => a -> a -> a
- Addr
0x2000
    nameTable :: Word16
nameTable = Addr -> Word16
unAddr Addr
vramIndex Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`div` Word16
0x400

-- TODO It is a memory interface