{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}

module Nes.CPU.State (
    -- * State
    CPUState (..),
    newCPUState,

    -- * Accessing registers
    Register (..),
    register,

    -- * Accessing status flags
    StatusRegister (..),
    StatusRegisterFlag (..),

    -- * Lenses
    registerA,
    registerX,
    registerY,
    registerS,
    status,
    pc,
) where

import Control.Lens (Lens', makeLenses)
import Nes.Bus.Constants (stackReset)
import Nes.FlagRegister
import Nes.Memory

-- | Offset in the vram of the next instruction to execute

-- | State of the CPU
data CPUState = MkCPUState
    { CPUState -> Byte
_registerA :: {-# UNPACK #-} !Byte
    -- ^ Aka Accumulator
    , CPUState -> Byte
_registerX :: {-# UNPACK #-} !Byte
    , CPUState -> Byte
_registerY :: {-# UNPACK #-} !Byte
    , CPUState -> Byte
_registerS :: {-# UNPACK #-} !Byte
    -- ^ Aka Stack pointer
    , CPUState -> StatusRegister
_status :: {-# UNPACK #-} !StatusRegister
    , CPUState -> Addr
_pc :: {-# UNPACK #-} !Addr
    -- ^ Program counter
    }
    deriving (CPUState -> CPUState -> Bool
(CPUState -> CPUState -> Bool)
-> (CPUState -> CPUState -> Bool) -> Eq CPUState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CPUState -> CPUState -> Bool
== :: CPUState -> CPUState -> Bool
$c/= :: CPUState -> CPUState -> Bool
/= :: CPUState -> CPUState -> Bool
Eq, Int -> CPUState -> ShowS
[CPUState] -> ShowS
CPUState -> String
(Int -> CPUState -> ShowS)
-> (CPUState -> String) -> ([CPUState] -> ShowS) -> Show CPUState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CPUState -> ShowS
showsPrec :: Int -> CPUState -> ShowS
$cshow :: CPUState -> String
show :: CPUState -> String
$cshowList :: [CPUState] -> ShowS
showList :: [CPUState] -> ShowS
Show)

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)

makeLenses ''CPUState

-- | Get a brand new, clear CPU
--
-- Note: the PC will have to be set by reading value at 'programLocation'
newCPUState :: CPUState
newCPUState :: CPUState
newCPUState =
    MkCPUState
        { _registerA :: Byte
_registerA = Byte
0
        , _registerX :: Byte
_registerX = Byte
0
        , _registerY :: Byte
_registerY = Byte
0
        , _registerS :: Byte
_registerS = Byte
stackReset
        , -- see https://www.nesdev.org/wiki/Status_flags
          -- and https://bugzmanov.github.io/nes_ebook/chapter_4.html
          _status :: StatusRegister
_status = Byte -> StatusRegister
MkSR Byte
0b00100100
        , _pc :: Addr
_pc = Addr
0
        }

-- | Enumeration of the CPU's registers
data Register = A | X | Y | S deriving (Register -> Register -> Bool
(Register -> Register -> Bool)
-> (Register -> Register -> Bool) -> Eq Register
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Register -> Register -> Bool
== :: Register -> Register -> Bool
$c/= :: Register -> Register -> Bool
/= :: Register -> Register -> Bool
Eq, Int -> Register -> ShowS
[Register] -> ShowS
Register -> String
(Int -> Register -> ShowS)
-> (Register -> String) -> ([Register] -> ShowS) -> Show Register
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Register -> ShowS
showsPrec :: Int -> Register -> ShowS
$cshow :: Register -> String
show :: Register -> String
$cshowList :: [Register] -> ShowS
showList :: [Register] -> ShowS
Show)

register :: Register -> Lens' CPUState Byte
register :: Register -> Lens' CPUState Byte
register = \case
    Register
A -> (Byte -> f Byte) -> CPUState -> f CPUState
Lens' CPUState Byte
registerA
    Register
X -> (Byte -> f Byte) -> CPUState -> f CPUState
Lens' CPUState Byte
registerX
    Register
Y -> (Byte -> f Byte) -> CPUState -> f CPUState
Lens' CPUState Byte
registerY
    Register
S -> (Byte -> f Byte) -> CPUState -> f CPUState
Lens' CPUState Byte
registerS

-- | Flags for the CPU's status
--
-- https://www.nesdev.org/obelisk-6502-guide/registers.html#C
data StatusRegisterFlag
    = Carry
    | Zero
    | InterruptDisable
    | DecimalMode
    | BFlag
    | Unusued
    | Overflow
    | Negative
    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