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.Internal.MonadState
import Nes.Memory

{-# INLINE write4008 #-}
write4008 :: Byte -> APU r ()
write4008 :: forall r. Byte -> APU r ()
write4008 Byte
byte = do
    let control :: Bool
control = Byte
byte Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
7
        reload :: Int
reload = Byte -> Int
byteToInt (Byte -> Int) -> Byte -> Int
forall a b. (a -> b) -> a -> b
$ Byte
byte Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
`clearBit` Int
7
    (Triangle -> Identity Triangle) -> APUState -> Identity APUState
Lens' APUState Triangle
triangle ((Triangle -> Identity Triangle) -> APUState -> Identity APUState)
-> (Triangle -> Triangle) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (LengthCounter -> LengthCounter) -> Triangle -> Triangle
forall a.
HasLengthCounter a =>
(LengthCounter -> LengthCounter) -> a -> a
withLengthCounter (\LengthCounter
lc -> LengthCounter
lc{isHalted = control})
    (Triangle -> Identity Triangle) -> APUState -> Identity APUState
Lens' APUState Triangle
triangle ((Triangle -> Identity Triangle) -> APUState -> Identity APUState)
-> (Triangle -> Triangle) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= (\Triangle
t -> Triangle
t{controlFlag = control, reloadValue = reload})

{-# INLINE write400A #-}
write400A :: Byte -> APU r ()
write400A :: forall r. Byte -> APU r ()
write400A Byte
periodLow =
    (Triangle -> Identity Triangle) -> APUState -> Identity APUState
Lens' APUState Triangle
triangle ((Triangle -> Identity Triangle) -> APUState -> Identity APUState)
-> (Triangle -> Triangle) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= \Triangle
t ->
        let newPeriod :: Int
newPeriod = (Triangle -> Int
period Triangle
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0b11100000000) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Byte -> Int
byteToInt Byte
periodLow
         in Triangle
t{period = newPeriod}

{-# INLINE write400B #-}
write400B :: Byte -> APU r ()
write400B :: forall r. Byte -> APU r ()
write400B Byte
byte =
    (Triangle -> Identity Triangle) -> APUState -> Identity APUState
Lens' APUState Triangle
triangle ((Triangle -> Identity Triangle) -> APUState -> Identity APUState)
-> (Triangle -> Triangle) -> APU r ()
forall s (m :: * -> *) a.
MonadState s m =>
ASetter' s a -> (a -> a) -> m ()
%= \Triangle
t ->
        let timerHigh :: Int
timerHigh = Byte -> Int
byteToInt (Byte -> Int) -> Byte -> Int
forall a b. (a -> b) -> a -> b
$ Byte
byte Byte -> Byte -> Byte
forall a. Bits a => a -> a -> a
.&. Byte
0b111
            newPeriod :: Int
newPeriod = (Int
timerHigh Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Triangle -> Int
period Triangle
t Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0b11111111)
            newLcLoad :: Int
newLcLoad = Byte -> Int
byteToInt (Byte -> Int) -> Byte -> Int
forall a b. (a -> b) -> a -> b
$ Byte
byte Byte -> Int -> Byte
forall a. Bits a => a -> Int -> a
`shiftR` Int
3
         in (LengthCounter -> LengthCounter) -> Triangle -> Triangle
forall a.
HasLengthCounter a =>
(LengthCounter -> LengthCounter) -> a -> a
withLengthCounter (Int -> LengthCounter -> LengthCounter
loadLengthCounter Int
newLcLoad) (Triangle -> Triangle) -> Triangle -> Triangle
forall a b. (a -> b) -> a -> b
$
                Triangle
t
                    { reloadFlag = True
                    , period = newPeriod
                    }