{-# LANGUAGE TemplateHaskell #-}

module Nes.PPU.State (
    -- * State
    PPUState (..),
    newPPUState,

    -- *  Address Register
    AddressRegister (highPtr),
    newAddressRegister,
    addressRegisterGet,
    addressRegisterSet,
    addressRegisterIncrement,
    addressRegisterUpdate,
    addressRegisterResetLatch,

    -- * Control Register
    ControlRegister (..),
    ControlRegisterFlag (..),
    getBackgroundPatternAddr,
    getSpritePatternAddr,
    getNametableAddr,

    -- * Status Register
    StatusRegister (..),
    StatusRegisterFlag (..),

    -- * Scroll Register
    ScrollRegister (..),
    newScrollRegister,
    scrollRegisterWrite,
    scrollRegisterResetLatch,

    -- * Mask Register
    MaskRegister (..),
    MaskRegisterFlag (..),

    -- * VRAM
    vramAddrIncrement,

    -- * Lenses
    Nes.PPU.State.mirroring,
    controlRegister,
    addressRegister,
    statusRegister,
    scrollRegister,
    maskRegister,
    internalBuffer,
    oamOffset,
    cycles,
    scanline,
    nmiInterrupt,
    ioBus,
) where

import Control.Lens (makeLenses)
import Data.Bits
import Data.Word
import Nes.FlagRegister
import Nes.Memory (Addr (..), Byte (..), bytesToAddr)
import Nes.Rom

data PPUState = MkPPUState
    { PPUState -> Mirroring
_mirroring :: {-# UNPACK #-} !Mirroring
    , PPUState -> ControlRegister
_controlRegister :: {-# UNPACK #-} !ControlRegister
    , PPUState -> AddressRegister
_addressRegister :: {-# UNPACK #-} !AddressRegister
    , PPUState -> StatusRegister
_statusRegister :: {-# UNPACK #-} !StatusRegister
    , PPUState -> ScrollRegister
_scrollRegister :: {-# UNPACK #-} !ScrollRegister
    , PPUState -> MaskRegister
_maskRegister :: {-# UNPACK #-} !MaskRegister
    , PPUState -> Byte
_internalBuffer :: {-# UNPACK #-} !Byte
    , PPUState -> Byte
_oamOffset :: {-# UNPACK #-} !Byte
    , PPUState -> Int
_cycles :: {-# UNPACK #-} !Int
    , PPUState -> Word16
_scanline :: {-# UNPACK #-} !Word16
    , PPUState -> Bool
_nmiInterrupt :: {-# UNPACK #-} !Bool
    , PPUState -> Byte
_ioBus :: {-# UNPACK #-} !Byte
    }

newPPUState :: Mirroring -> PPUState
newPPUState :: Mirroring -> PPUState
newPPUState Mirroring
_mirroring =
    let _addressRegister :: AddressRegister
_addressRegister = AddressRegister
newAddressRegister
        _controlRegister :: ControlRegister
_controlRegister = Byte -> ControlRegister
MkCR Byte
0
        _statusRegister :: StatusRegister
_statusRegister = Byte -> StatusRegister
MkSR Byte
0
        _maskRegister :: MaskRegister
_maskRegister = Byte -> MaskRegister
MkMR Byte
0
        _scrollRegister :: ScrollRegister
_scrollRegister = ScrollRegister
newScrollRegister
        _internalBuffer :: Byte
_internalBuffer = Byte
0
        _oamOffset :: Byte
_oamOffset = Byte
0
        _cycles :: Int
_cycles = Int
0
        _scanline :: Word16
_scanline = Word16
0
        _nmiInterrupt :: Bool
_nmiInterrupt = Bool
False
        _ioBus :: Byte
_ioBus = Byte
0
     in MkPPUState{Bool
Int
Word16
Byte
Mirroring
MaskRegister
ScrollRegister
StatusRegister
ControlRegister
AddressRegister
_mirroring :: Mirroring
_controlRegister :: ControlRegister
_addressRegister :: AddressRegister
_statusRegister :: StatusRegister
_scrollRegister :: ScrollRegister
_maskRegister :: MaskRegister
_internalBuffer :: Byte
_oamOffset :: Byte
_cycles :: Int
_scanline :: Word16
_nmiInterrupt :: Bool
_ioBus :: Byte
_mirroring :: Mirroring
_addressRegister :: AddressRegister
_controlRegister :: ControlRegister
_statusRegister :: StatusRegister
_maskRegister :: MaskRegister
_scrollRegister :: ScrollRegister
_internalBuffer :: Byte
_oamOffset :: Byte
_cycles :: Int
_scanline :: Word16
_nmiInterrupt :: Bool
_ioBus :: Byte
..}

data AddressRegister = AddressRegister
    { AddressRegister -> Byte
low :: {-# UNPACK #-} !Byte
    , AddressRegister -> Byte
high :: {-# UNPACK #-} !Byte
    , AddressRegister -> Bool
highPtr :: {-# UNPACK #-} !Bool
    }

newAddressRegister :: AddressRegister
newAddressRegister :: AddressRegister
newAddressRegister = Byte -> Byte -> Bool -> AddressRegister
AddressRegister Byte
0 Byte
0 Bool
True

-- | Sets an Addr to the AddressRegister's value
{-# INLINE addressRegisterSet #-}
addressRegisterSet :: Addr -> AddressRegister -> AddressRegister
addressRegisterSet :: Addr -> AddressRegister -> AddressRegister
addressRegisterSet (Addr Word16
bytes) AddressRegister
ar = AddressRegister
ar{low = low, high = high}
  where
    low :: Byte
low = Word16 -> Byte
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
bytes Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xff)
    high :: Byte
high = Word16 -> Byte
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
bytes Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)

-- | Sets the high or lower byte of the AddressRegister's value,
-- depending on the highPtr state
{-# INLINE addressRegisterUpdate #-}
addressRegisterUpdate :: Byte -> AddressRegister -> AddressRegister
addressRegisterUpdate :: Byte -> AddressRegister -> AddressRegister
addressRegisterUpdate Byte
byte AddressRegister
ar0 =
    let
        ar1 :: AddressRegister
ar1 = if AddressRegister -> Bool
highPtr AddressRegister
ar0 then AddressRegister
ar0{high = byte} else AddressRegister
ar0{low = byte}
        ar2 :: AddressRegister
ar2 =
            let
                addr :: Addr
addr = AddressRegister -> Addr
addressRegisterGet AddressRegister
ar1
             in
                if Addr
addr Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
> Addr
0x3fff
                    then Addr -> AddressRegister -> AddressRegister
addressRegisterSet (Addr
addr Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.&. Addr
0x3fff) AddressRegister
ar1
                    else AddressRegister
ar1
     in
        AddressRegister
ar2{highPtr = not $ highPtr ar2}

-- | Increment the AddressRegister's value by the given Byte
{-# INLINE addressRegisterIncrement #-}
addressRegisterIncrement :: Byte -> AddressRegister -> AddressRegister
addressRegisterIncrement :: Byte -> AddressRegister -> AddressRegister
addressRegisterIncrement Byte
byte AddressRegister
ar =
    let
        oldLow :: Byte
oldLow = AddressRegister -> Byte
low AddressRegister
ar
        ar1 :: AddressRegister
ar1 = AddressRegister
ar{low = low ar + byte}
        ar2 :: AddressRegister
ar2 = if Byte
oldLow Byte -> Byte -> Bool
forall a. Ord a => a -> a -> Bool
> AddressRegister -> Byte
low AddressRegister
ar1 then AddressRegister
ar1{high = high ar1 + 1} else AddressRegister
ar1
        ar3 :: AddressRegister
ar3 = let addr :: Addr
addr = AddressRegister -> Addr
addressRegisterGet AddressRegister
ar2 in if Addr
addr Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
> Addr
0x3fff then Addr -> AddressRegister -> AddressRegister
addressRegisterSet (Addr
addr Addr -> Addr -> Addr
forall a. Bits a => a -> a -> a
.&. Addr
0x3fff) AddressRegister
ar2 else AddressRegister
ar2
     in
        AddressRegister
ar3

-- | Set highPtr to True
{-# INLINE addressRegisterResetLatch #-}
addressRegisterResetLatch :: AddressRegister -> AddressRegister
addressRegisterResetLatch :: AddressRegister -> AddressRegister
addressRegisterResetLatch AddressRegister
ar = AddressRegister
ar{highPtr = True}

-- | Get the AddressRegister's value as an Addr
{-# INLINE addressRegisterGet #-}
addressRegisterGet :: AddressRegister -> Addr
addressRegisterGet :: AddressRegister -> Addr
addressRegisterGet (AddressRegister Byte
low Byte
high Bool
_) = Byte -> Byte -> Addr
bytesToAddr Byte
low Byte
high

newtype ControlRegister = MkCR {ControlRegister -> Byte
unCR :: Byte} deriving (ControlRegister -> ControlRegister -> Bool
(ControlRegister -> ControlRegister -> Bool)
-> (ControlRegister -> ControlRegister -> Bool)
-> Eq ControlRegister
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControlRegister -> ControlRegister -> Bool
== :: ControlRegister -> ControlRegister -> Bool
$c/= :: ControlRegister -> ControlRegister -> Bool
/= :: ControlRegister -> ControlRegister -> Bool
Eq, Int -> ControlRegister -> ShowS
[ControlRegister] -> ShowS
ControlRegister -> String
(Int -> ControlRegister -> ShowS)
-> (ControlRegister -> String)
-> ([ControlRegister] -> ShowS)
-> Show ControlRegister
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControlRegister -> ShowS
showsPrec :: Int -> ControlRegister -> ShowS
$cshow :: ControlRegister -> String
show :: ControlRegister -> String
$cshowList :: [ControlRegister] -> ShowS
showList :: [ControlRegister] -> ShowS
Show)

-- | Flags from the control register
--
-- 7  bit  0
-- ---- ----
-- VPHB SINN
-- |||| ||||
-- |||| ||++- Base nametable address
-- |||| ||    (0 = $2000; 1 = $2400; 2 = $2800; 3 = $2C00)
-- |||| |+--- VRAM address increment per CPU read/write of PPUDATA
-- |||| |     (0: add 1, going across; 1: add 32, going down)
-- |||| +---- Sprite pattern table address for 8x8 sprites
-- ||||       (0: $0000; 1: $1000; ignored in 8x16 mode)
-- |||+------ Background pattern table address (0: $0000; 1: $1000)
-- ||+------- Sprite size (0: 8x8 pixels; 1: 8x16 pixels)
-- |+-------- PPU master/slave select
-- |          (0: read backdrop from EXT pins; 1: output color on EXT pins)
-- +--------- Generate an NMI at the start of the
--            vertical blanking interval (0: off; 1: on)
--
-- SRC: https://bugzmanov.github.io/nes_ebook/chapter_6_1.html
data ControlRegisterFlag
    = Nametable1
    | Nametable2
    | VramAddIncrement
    | SpritePatternAddr
    | BackgroundPatternAddr
    | SpriteSize
    | MasterSlaveSelect
    | GenerateNMI
    deriving (ControlRegisterFlag -> ControlRegisterFlag -> Bool
(ControlRegisterFlag -> ControlRegisterFlag -> Bool)
-> (ControlRegisterFlag -> ControlRegisterFlag -> Bool)
-> Eq ControlRegisterFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControlRegisterFlag -> ControlRegisterFlag -> Bool
== :: ControlRegisterFlag -> ControlRegisterFlag -> Bool
$c/= :: ControlRegisterFlag -> ControlRegisterFlag -> Bool
/= :: ControlRegisterFlag -> ControlRegisterFlag -> Bool
Eq, Int -> ControlRegisterFlag -> ShowS
[ControlRegisterFlag] -> ShowS
ControlRegisterFlag -> String
(Int -> ControlRegisterFlag -> ShowS)
-> (ControlRegisterFlag -> String)
-> ([ControlRegisterFlag] -> ShowS)
-> Show ControlRegisterFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControlRegisterFlag -> ShowS
showsPrec :: Int -> ControlRegisterFlag -> ShowS
$cshow :: ControlRegisterFlag -> String
show :: ControlRegisterFlag -> String
$cshowList :: [ControlRegisterFlag] -> ShowS
showList :: [ControlRegisterFlag] -> ShowS
Show, Int -> ControlRegisterFlag
ControlRegisterFlag -> Int
ControlRegisterFlag -> [ControlRegisterFlag]
ControlRegisterFlag -> ControlRegisterFlag
ControlRegisterFlag -> ControlRegisterFlag -> [ControlRegisterFlag]
ControlRegisterFlag
-> ControlRegisterFlag
-> ControlRegisterFlag
-> [ControlRegisterFlag]
(ControlRegisterFlag -> ControlRegisterFlag)
-> (ControlRegisterFlag -> ControlRegisterFlag)
-> (Int -> ControlRegisterFlag)
-> (ControlRegisterFlag -> Int)
-> (ControlRegisterFlag -> [ControlRegisterFlag])
-> (ControlRegisterFlag
    -> ControlRegisterFlag -> [ControlRegisterFlag])
-> (ControlRegisterFlag
    -> ControlRegisterFlag -> [ControlRegisterFlag])
-> (ControlRegisterFlag
    -> ControlRegisterFlag
    -> ControlRegisterFlag
    -> [ControlRegisterFlag])
-> Enum ControlRegisterFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ControlRegisterFlag -> ControlRegisterFlag
succ :: ControlRegisterFlag -> ControlRegisterFlag
$cpred :: ControlRegisterFlag -> ControlRegisterFlag
pred :: ControlRegisterFlag -> ControlRegisterFlag
$ctoEnum :: Int -> ControlRegisterFlag
toEnum :: Int -> ControlRegisterFlag
$cfromEnum :: ControlRegisterFlag -> Int
fromEnum :: ControlRegisterFlag -> Int
$cenumFrom :: ControlRegisterFlag -> [ControlRegisterFlag]
enumFrom :: ControlRegisterFlag -> [ControlRegisterFlag]
$cenumFromThen :: ControlRegisterFlag -> ControlRegisterFlag -> [ControlRegisterFlag]
enumFromThen :: ControlRegisterFlag -> ControlRegisterFlag -> [ControlRegisterFlag]
$cenumFromTo :: ControlRegisterFlag -> ControlRegisterFlag -> [ControlRegisterFlag]
enumFromTo :: ControlRegisterFlag -> ControlRegisterFlag -> [ControlRegisterFlag]
$cenumFromThenTo :: ControlRegisterFlag
-> ControlRegisterFlag
-> ControlRegisterFlag
-> [ControlRegisterFlag]
enumFromThenTo :: ControlRegisterFlag
-> ControlRegisterFlag
-> ControlRegisterFlag
-> [ControlRegisterFlag]
Enum)

instance FlagRegister ControlRegister where
    type Flag ControlRegister = ControlRegisterFlag
    fromByte :: Byte -> ControlRegister
fromByte = Byte -> ControlRegister
MkCR
    toByte :: ControlRegister -> Byte
toByte = ControlRegister -> Byte
unCR
    flagToBitOffset :: Flag ControlRegister -> Int
flagToBitOffset = Flag ControlRegister -> Int
ControlRegisterFlag -> Int
forall a. Enum a => a -> Int
fromEnum

{-# INLINE vramAddrIncrement #-}
vramAddrIncrement :: ControlRegister -> Byte
vramAddrIncrement :: ControlRegister -> Byte
vramAddrIncrement ControlRegister
st =
    if Flag ControlRegister -> ControlRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag ControlRegister
ControlRegisterFlag
VramAddIncrement ControlRegister
st then Byte
32 else Byte
1

{-# INLINE getBackgroundPatternAddr #-}
getBackgroundPatternAddr :: ControlRegister -> Addr
getBackgroundPatternAddr :: ControlRegister -> Addr
getBackgroundPatternAddr ControlRegister
st =
    if Flag ControlRegister -> ControlRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag ControlRegister
ControlRegisterFlag
BackgroundPatternAddr ControlRegister
st
        then Addr
0x1000
        else Addr
0

{-# INLINE getSpritePatternAddr #-}
getSpritePatternAddr :: ControlRegister -> Addr
getSpritePatternAddr :: ControlRegister -> Addr
getSpritePatternAddr ControlRegister
st =
    if Flag ControlRegister -> ControlRegister -> Bool
forall a. FlagRegister a => Flag a -> a -> Bool
getFlag Flag ControlRegister
ControlRegisterFlag
SpritePatternAddr ControlRegister
st
        then Addr
0x1000
        else Addr
0

{-# INLINE getNametableAddr #-}
getNametableAddr :: ControlRegister -> Addr
getNametableAddr :: ControlRegister -> Addr
getNametableAddr ControlRegister
st = case ControlRegister -> Byte
unCR ControlRegister
st Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
0b11 of
    Byte
0 -> Addr
0x2000
    Byte
1 -> Addr
0x2400
    Byte
2 -> Addr
0x2800
    Byte
3 -> Addr
0x2c00
    Byte
_ -> String -> Addr
forall a. HasCallStack => String -> a
error String
"Invalid Nametable Addr"

newtype StatusRegister = MkSR {StatusRegister -> Byte
unSR :: Byte} deriving (StatusRegister -> StatusRegister -> Bool
(StatusRegister -> StatusRegister -> Bool)
-> (StatusRegister -> StatusRegister -> Bool) -> Eq StatusRegister
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatusRegister -> StatusRegister -> Bool
== :: StatusRegister -> StatusRegister -> Bool
$c/= :: StatusRegister -> StatusRegister -> Bool
/= :: StatusRegister -> StatusRegister -> Bool
Eq, Int -> StatusRegister -> ShowS
[StatusRegister] -> ShowS
StatusRegister -> String
(Int -> StatusRegister -> ShowS)
-> (StatusRegister -> String)
-> ([StatusRegister] -> ShowS)
-> Show StatusRegister
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StatusRegister -> ShowS
showsPrec :: Int -> StatusRegister -> ShowS
$cshow :: StatusRegister -> String
show :: StatusRegister -> String
$cshowList :: [StatusRegister] -> ShowS
showList :: [StatusRegister] -> ShowS
Show)

data StatusRegisterFlag
    = NotUsed1
    | NotUsed2
    | NotUsed3
    | NotUsed4
    | NotUsed5
    | SpriteOverflow
    | SpriteZeroHit
    | VBlankStarted
    deriving (StatusRegisterFlag -> StatusRegisterFlag -> Bool
(StatusRegisterFlag -> StatusRegisterFlag -> Bool)
-> (StatusRegisterFlag -> StatusRegisterFlag -> Bool)
-> Eq StatusRegisterFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatusRegisterFlag -> StatusRegisterFlag -> Bool
== :: StatusRegisterFlag -> StatusRegisterFlag -> Bool
$c/= :: StatusRegisterFlag -> StatusRegisterFlag -> Bool
/= :: StatusRegisterFlag -> StatusRegisterFlag -> Bool
Eq, Int -> StatusRegisterFlag -> ShowS
[StatusRegisterFlag] -> ShowS
StatusRegisterFlag -> String
(Int -> StatusRegisterFlag -> ShowS)
-> (StatusRegisterFlag -> String)
-> ([StatusRegisterFlag] -> ShowS)
-> Show StatusRegisterFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StatusRegisterFlag -> ShowS
showsPrec :: Int -> StatusRegisterFlag -> ShowS
$cshow :: StatusRegisterFlag -> String
show :: StatusRegisterFlag -> String
$cshowList :: [StatusRegisterFlag] -> ShowS
showList :: [StatusRegisterFlag] -> ShowS
Show, Int -> StatusRegisterFlag
StatusRegisterFlag -> Int
StatusRegisterFlag -> [StatusRegisterFlag]
StatusRegisterFlag -> StatusRegisterFlag
StatusRegisterFlag -> StatusRegisterFlag -> [StatusRegisterFlag]
StatusRegisterFlag
-> StatusRegisterFlag -> StatusRegisterFlag -> [StatusRegisterFlag]
(StatusRegisterFlag -> StatusRegisterFlag)
-> (StatusRegisterFlag -> StatusRegisterFlag)
-> (Int -> StatusRegisterFlag)
-> (StatusRegisterFlag -> Int)
-> (StatusRegisterFlag -> [StatusRegisterFlag])
-> (StatusRegisterFlag
    -> StatusRegisterFlag -> [StatusRegisterFlag])
-> (StatusRegisterFlag
    -> StatusRegisterFlag -> [StatusRegisterFlag])
-> (StatusRegisterFlag
    -> StatusRegisterFlag
    -> StatusRegisterFlag
    -> [StatusRegisterFlag])
-> Enum StatusRegisterFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: StatusRegisterFlag -> StatusRegisterFlag
succ :: StatusRegisterFlag -> StatusRegisterFlag
$cpred :: StatusRegisterFlag -> StatusRegisterFlag
pred :: StatusRegisterFlag -> StatusRegisterFlag
$ctoEnum :: Int -> StatusRegisterFlag
toEnum :: Int -> StatusRegisterFlag
$cfromEnum :: StatusRegisterFlag -> Int
fromEnum :: StatusRegisterFlag -> Int
$cenumFrom :: StatusRegisterFlag -> [StatusRegisterFlag]
enumFrom :: StatusRegisterFlag -> [StatusRegisterFlag]
$cenumFromThen :: StatusRegisterFlag -> StatusRegisterFlag -> [StatusRegisterFlag]
enumFromThen :: StatusRegisterFlag -> StatusRegisterFlag -> [StatusRegisterFlag]
$cenumFromTo :: StatusRegisterFlag -> StatusRegisterFlag -> [StatusRegisterFlag]
enumFromTo :: StatusRegisterFlag -> StatusRegisterFlag -> [StatusRegisterFlag]
$cenumFromThenTo :: StatusRegisterFlag
-> StatusRegisterFlag -> StatusRegisterFlag -> [StatusRegisterFlag]
enumFromThenTo :: StatusRegisterFlag
-> StatusRegisterFlag -> StatusRegisterFlag -> [StatusRegisterFlag]
Enum)

instance FlagRegister StatusRegister where
    type Flag StatusRegister = StatusRegisterFlag
    fromByte :: Byte -> StatusRegister
fromByte = Byte -> StatusRegister
MkSR
    toByte :: StatusRegister -> Byte
toByte = StatusRegister -> Byte
unSR
    flagToBitOffset :: Flag StatusRegister -> Int
flagToBitOffset = Flag StatusRegister -> Int
StatusRegisterFlag -> Int
forall a. Enum a => a -> Int
fromEnum

data ScrollRegister = MkScrollR {ScrollRegister -> Byte
x :: Byte, ScrollRegister -> Byte
y :: Byte, ScrollRegister -> Bool
latch :: Bool}

newScrollRegister :: ScrollRegister
newScrollRegister :: ScrollRegister
newScrollRegister = Byte -> Byte -> Bool -> ScrollRegister
MkScrollR Byte
0 Byte
0 Bool
False

{-# INLINE scrollRegisterWrite #-}
scrollRegisterWrite :: Byte -> ScrollRegister -> ScrollRegister
scrollRegisterWrite :: Byte -> ScrollRegister -> ScrollRegister
scrollRegisterWrite Byte
byte ScrollRegister
sr =
    let
        sr1 :: ScrollRegister
sr1 = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ScrollRegister -> Bool
latch ScrollRegister
sr then ScrollRegister
sr{x = byte} else ScrollRegister
sr{y = byte}
        sr2 :: ScrollRegister
sr2 = ScrollRegister
sr1{latch = not (latch sr1)}
     in
        ScrollRegister
sr2

{-# INLINE scrollRegisterResetLatch #-}
scrollRegisterResetLatch :: ScrollRegister -> ScrollRegister
scrollRegisterResetLatch :: ScrollRegister -> ScrollRegister
scrollRegisterResetLatch ScrollRegister
st = ScrollRegister
st{latch = False}

newtype MaskRegister = MkMR {MaskRegister -> Byte
unMR :: Byte} deriving (MaskRegister -> MaskRegister -> Bool
(MaskRegister -> MaskRegister -> Bool)
-> (MaskRegister -> MaskRegister -> Bool) -> Eq MaskRegister
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaskRegister -> MaskRegister -> Bool
== :: MaskRegister -> MaskRegister -> Bool
$c/= :: MaskRegister -> MaskRegister -> Bool
/= :: MaskRegister -> MaskRegister -> Bool
Eq, Int -> MaskRegister -> ShowS
[MaskRegister] -> ShowS
MaskRegister -> String
(Int -> MaskRegister -> ShowS)
-> (MaskRegister -> String)
-> ([MaskRegister] -> ShowS)
-> Show MaskRegister
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaskRegister -> ShowS
showsPrec :: Int -> MaskRegister -> ShowS
$cshow :: MaskRegister -> String
show :: MaskRegister -> String
$cshowList :: [MaskRegister] -> ShowS
showList :: [MaskRegister] -> ShowS
Show)

data MaskRegisterFlag
    = GreyScale
    | LeftmostBackground
    | LeftmostSprite
    | ShowBackground
    | ShowSprites
    | EmphRed
    | EmphGree
    | EmphBlue
    deriving (MaskRegisterFlag -> MaskRegisterFlag -> Bool
(MaskRegisterFlag -> MaskRegisterFlag -> Bool)
-> (MaskRegisterFlag -> MaskRegisterFlag -> Bool)
-> Eq MaskRegisterFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaskRegisterFlag -> MaskRegisterFlag -> Bool
== :: MaskRegisterFlag -> MaskRegisterFlag -> Bool
$c/= :: MaskRegisterFlag -> MaskRegisterFlag -> Bool
/= :: MaskRegisterFlag -> MaskRegisterFlag -> Bool
Eq, Int -> MaskRegisterFlag -> ShowS
[MaskRegisterFlag] -> ShowS
MaskRegisterFlag -> String
(Int -> MaskRegisterFlag -> ShowS)
-> (MaskRegisterFlag -> String)
-> ([MaskRegisterFlag] -> ShowS)
-> Show MaskRegisterFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaskRegisterFlag -> ShowS
showsPrec :: Int -> MaskRegisterFlag -> ShowS
$cshow :: MaskRegisterFlag -> String
show :: MaskRegisterFlag -> String
$cshowList :: [MaskRegisterFlag] -> ShowS
showList :: [MaskRegisterFlag] -> ShowS
Show, Int -> MaskRegisterFlag
MaskRegisterFlag -> Int
MaskRegisterFlag -> [MaskRegisterFlag]
MaskRegisterFlag -> MaskRegisterFlag
MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag]
MaskRegisterFlag
-> MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag]
(MaskRegisterFlag -> MaskRegisterFlag)
-> (MaskRegisterFlag -> MaskRegisterFlag)
-> (Int -> MaskRegisterFlag)
-> (MaskRegisterFlag -> Int)
-> (MaskRegisterFlag -> [MaskRegisterFlag])
-> (MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag])
-> (MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag])
-> (MaskRegisterFlag
    -> MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag])
-> Enum MaskRegisterFlag
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MaskRegisterFlag -> MaskRegisterFlag
succ :: MaskRegisterFlag -> MaskRegisterFlag
$cpred :: MaskRegisterFlag -> MaskRegisterFlag
pred :: MaskRegisterFlag -> MaskRegisterFlag
$ctoEnum :: Int -> MaskRegisterFlag
toEnum :: Int -> MaskRegisterFlag
$cfromEnum :: MaskRegisterFlag -> Int
fromEnum :: MaskRegisterFlag -> Int
$cenumFrom :: MaskRegisterFlag -> [MaskRegisterFlag]
enumFrom :: MaskRegisterFlag -> [MaskRegisterFlag]
$cenumFromThen :: MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag]
enumFromThen :: MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag]
$cenumFromTo :: MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag]
enumFromTo :: MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag]
$cenumFromThenTo :: MaskRegisterFlag
-> MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag]
enumFromThenTo :: MaskRegisterFlag
-> MaskRegisterFlag -> MaskRegisterFlag -> [MaskRegisterFlag]
Enum)

instance FlagRegister MaskRegister where
    type Flag MaskRegister = MaskRegisterFlag
    fromByte :: Byte -> MaskRegister
fromByte = Byte -> MaskRegister
MkMR
    toByte :: MaskRegister -> Byte
toByte = MaskRegister -> Byte
unMR
    flagToBitOffset :: Flag MaskRegister -> Int
flagToBitOffset = Flag MaskRegister -> Int
MaskRegisterFlag -> Int
forall a. Enum a => a -> Int
fromEnum

makeLenses ''PPUState