{-# LANGUAGE ScopedTypeVariables #-}

module Nes.CPU.Instructions.Arith (
    -- * Operate on register A with carry
    adc,
    sbc,

    -- * Increment
    inc,
    inx,
    iny,
    isb,

    -- * Decrement
    dec,
    dex,
    dey,

    -- * Internal
    addToRegisterA,
) where

import Control.Monad
import Data.Bits
import Data.Word
import Nes.CPU.Instructions.Addressing
import Nes.CPU.Instructions.After (setZeroAndNegativeFlags)
import Nes.CPU.Monad
import Nes.CPU.State
import Nes.FlagRegister
import Nes.Internal.MonadState
import Nes.Memory

-- | Regisiter A + (_value in memory_) + Carry
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#ADC
adc :: AddressingMode -> CPU r ()
adc :: forall r. AddressingMode -> CPU r ()
adc AddressingMode
mode = do
    Byte
value <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode CPU r Addr -> (Addr -> CPU r Byte) -> CPU r Byte
forall a b. CPU r a -> (a -> CPU r b) -> CPU r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
addToRegisterA Byte
value

-- | Regisiter A - (_value in memory_) - (1 - Carry)
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#SBC
sbc :: AddressingMode -> CPU r ()
sbc :: forall r. AddressingMode -> CPU r ()
sbc AddressingMode
mode = do
    Byte
value <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode CPU r Addr -> (Addr -> CPU r Byte) -> CPU r Byte
forall a b. CPU r a -> (a -> CPU r b) -> CPU r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
`readByte` ())
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
addToRegisterA (Byte -> Byte
negateByte Byte
value)

-- | Does the computation and sets Carry and Overflow accordingly
--
-- Source: https://github.com/bugzmanov/nes_ebook/blob/785b9ed8b803d9f4bd51274f4d0c68c14a1b3a8b/code/ch3.3/src/cpu.rs#L261
{-# INLINE addToRegisterA #-}
addToRegisterA :: Byte -> CPU r ()
addToRegisterA :: forall r. Byte -> CPU r ()
addToRegisterA Byte
value = do
    Bool
carry <- Getting StatusRegister CPUState StatusRegister
-> (StatusRegister -> Bool) -> CPU r Bool
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses Getting StatusRegister CPUState StatusRegister
Lens' CPUState StatusRegister
status ((StatusRegister -> Bool) -> CPU r Bool)
-> (StatusRegister -> Bool) -> CPU 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
Carry
    Word16
regA :: Word16 <- Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> (Byte -> Word8) -> Byte -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Byte -> Word8
unByte (Byte -> Word16) -> CPU r Byte -> CPU r Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting Byte CPUState Byte -> CPU r Byte
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Byte CPUState Byte
Lens' CPUState Byte
registerA
    let sumInt :: Word16
sumInt =
            Word16
regA
                Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> (Byte -> Word8) -> Byte -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Byte -> Word8
unByte (Byte -> Word16) -> Byte -> Word16
forall a b. (a -> b) -> a -> b
$ Byte
value)
                Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ (if Bool
carry then Word16
1 else Word16
0)
    (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag' Flag StatusRegister
StatusRegisterFlag
Carry (Word16
sumInt Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
0x00ff)
    let sumByte :: Byte
sumByte = Word16 -> Byte
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
sumInt :: Byte
    (StatusRegister -> Identity StatusRegister)
-> CPUState -> Identity CPUState
Lens' CPUState StatusRegister
status
        ((StatusRegister -> Identity StatusRegister)
 -> CPUState -> Identity CPUState)
-> (StatusRegister -> StatusRegister) -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= Flag StatusRegister -> Bool -> StatusRegister -> StatusRegister
forall a. FlagRegister a => Flag a -> Bool -> a -> a
setFlag'
            Flag StatusRegister
StatusRegisterFlag
Overflow
            ((Byte
value Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
`xor` Byte
sumByte) Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. (Byte
sumByte Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
`xor` Word16 -> Byte
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
regA) Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
0x80 Byte -> Byte -> Bool
forall a. Eq a => a -> a -> Bool
/= Byte
0)
    (Byte -> Identity Byte) -> CPUState -> Identity CPUState
Lens' CPUState Byte
registerA ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
sumByte
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
sumByte

-- | Increment value in memory
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#INC
inc :: AddressingMode -> CPU r ()
inc :: forall r. AddressingMode -> CPU r ()
inc AddressingMode
mode = do
    CPU r Byte -> CPU r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CPU r Byte -> CPU r ()) -> CPU r Byte -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (Byte -> Byte) -> AddressingMode -> CPU r Byte
forall r. (Byte -> Byte) -> AddressingMode -> CPU r Byte
modifyValueInMemory (Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
1) AddressingMode
mode
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
== AddressingMode
AbsoluteX) CPU r ()
forall r. CPU r ()
tickOnce

-- | (Unofficial) Equivalent to INC value then SBC value
--
-- Aka ISC
isb :: AddressingMode -> CPU r ()
isb :: forall r. AddressingMode -> CPU r ()
isb AddressingMode
mode = do
    Byte
byte <- (Byte -> Byte) -> AddressingMode -> CPU r Byte
forall r. (Byte -> Byte) -> AddressingMode -> CPU r Byte
modifyValueInMemory (Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
1) AddressingMode
mode
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
addToRegisterA (Byte -> Byte
negateByte Byte
byte)

-- | Decrement value in memory
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#DEC
dec :: AddressingMode -> CPU r ()
dec :: forall r. AddressingMode -> CPU r ()
dec AddressingMode
mode = do
    CPU r Byte -> CPU r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (CPU r Byte -> CPU r ()) -> CPU r Byte -> CPU r ()
forall a b. (a -> b) -> a -> b
$ (Byte -> Byte) -> AddressingMode -> CPU r Byte
forall r. (Byte -> Byte) -> AddressingMode -> CPU r Byte
modifyValueInMemory (Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ (-Byte
1)) AddressingMode
mode
    Bool -> CPU r () -> CPU r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (AddressingMode
mode AddressingMode -> AddressingMode -> Bool
forall a. Eq a => a -> a -> Bool
== AddressingMode
AbsoluteX) CPU r ()
forall r. CPU r ()
tickOnce

{-# INLINE modifyValueInMemory #-}
modifyValueInMemory :: (Byte -> Byte) -> AddressingMode -> CPU r Byte
modifyValueInMemory :: forall r. (Byte -> Byte) -> AddressingMode -> CPU r Byte
modifyValueInMemory Byte -> Byte
f AddressingMode
mode = do
    Addr
addr <- AddressingMode -> CPU r Addr
forall r. AddressingMode -> CPU r Addr
getOperandAddr AddressingMode
mode
    Byte
res <- Byte -> Byte
f (Byte -> Byte) -> CPU r Byte -> CPU r Byte
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr -> () -> CPU r Byte
forall a (m :: * -> *). MemoryInterface a m => Addr -> a -> m Byte
readByte Addr
addr ()
    CPU r ()
forall r. CPU r ()
tickOnce -- Is a Read-modify-write operation, we add one tick
    Byte -> Addr -> () -> CPU r ()
forall a (m :: * -> *).
MemoryInterface a m =>
Byte -> Addr -> a -> m ()
writeByte Byte
res Addr
addr ()
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
res
    Byte -> CPU r Byte
forall a. a -> CPU r a
forall (m :: * -> *) a. Monad m => a -> m a
return Byte
res

-- | Decrement X register
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#DEX
dex :: CPU r ()
dex :: forall r. CPU r ()
dex = Register -> CPU r ()
forall r. Register -> CPU r ()
decrementRegister Register
X

-- | Decrement Y register
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#DEY
dey :: CPU r ()
dey :: forall r. CPU r ()
dey = Register -> CPU r ()
forall r. Register -> CPU r ()
decrementRegister Register
Y

{-# INLINE decrementRegister #-}
decrementRegister :: Register -> CPU r ()
decrementRegister :: forall r. Register -> CPU r ()
decrementRegister Register
reg = do
    Byte
res <- Getting Byte CPUState Byte -> (Byte -> Byte) -> CPU r Byte
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses (Register -> Lens' CPUState Byte
register Register
reg) (\Byte
y -> Byte
y Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
- Byte
1)
    Register -> Lens' CPUState Byte
register Register
reg ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
res
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
res

-- | Increment the value of the X register
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#INX
inx :: CPU r ()
inx :: forall r. CPU r ()
inx = Register -> CPU r ()
forall r. Register -> CPU r ()
incrementRegister Register
X

-- | Increment the value of the Y register
--
-- https://www.nesdev.org/obelisk-6502-guide/reference.html#INY
iny :: CPU r ()
iny :: forall r. CPU r ()
iny = Register -> CPU r ()
forall r. Register -> CPU r ()
incrementRegister Register
Y

{-# INLINE incrementRegister #-}
incrementRegister :: Register -> CPU r ()
incrementRegister :: forall r. Register -> CPU r ()
incrementRegister Register
reg = do
    Byte
newRegY <- Getting Byte CPUState Byte -> (Byte -> Byte) -> CPU r Byte
forall s (m :: * -> *) a r.
MonadState s m =>
Getting a s a -> (a -> r) -> m r
uses (Register -> Lens' CPUState Byte
register Register
reg) (Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Byte
1)
    Register -> Lens' CPUState Byte
register Register
reg ((Byte -> Identity Byte) -> CPUState -> Identity CPUState)
-> Byte -> CPU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> a -> m ()
.= Byte
newRegY
    Byte -> CPU r ()
forall r. Byte -> CPU r ()
setZeroAndNegativeFlags Byte
newRegY