module Nes.Controller (
    ControllerState (..),
    newControllerState,
    ControllerButtonStatus (..),
    ControllerButton (..),

    -- * Monad
    Controller (..),
    runController,
    setStrobe,
    setButtonAsPressed,
    readButtonStatus,
) where

import Data.Bits
import Nes.FlagRegister
import Nes.Memory (Byte (Byte, unByte))

data ControllerState = MkCS
    { ControllerState -> Bool
strobe :: {-# UNPACK #-} !Bool
    , ControllerState -> Byte
buttonIdx :: {-# UNPACK #-} !Byte
    , ControllerState -> ControllerButtonStatus
buttonStatus :: {-# UNPACK #-} !ControllerButtonStatus
    }

newControllerState :: ControllerState
newControllerState :: ControllerState
newControllerState = Bool -> Byte -> ControllerButtonStatus -> ControllerState
MkCS Bool
False Byte
0 (Byte -> ControllerButtonStatus
MkCBS Byte
0)

newtype ControllerButtonStatus = MkCBS {ControllerButtonStatus -> Byte
unStatus :: Byte}

data ControllerButton
    = A
    | B
    | Select
    | Start
    | Up
    | Down
    | Left
    | Right
    deriving (ControllerButton -> ControllerButton -> Bool
(ControllerButton -> ControllerButton -> Bool)
-> (ControllerButton -> ControllerButton -> Bool)
-> Eq ControllerButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ControllerButton -> ControllerButton -> Bool
== :: ControllerButton -> ControllerButton -> Bool
$c/= :: ControllerButton -> ControllerButton -> Bool
/= :: ControllerButton -> ControllerButton -> Bool
Eq, Int -> ControllerButton -> ShowS
[ControllerButton] -> ShowS
ControllerButton -> String
(Int -> ControllerButton -> ShowS)
-> (ControllerButton -> String)
-> ([ControllerButton] -> ShowS)
-> Show ControllerButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ControllerButton -> ShowS
showsPrec :: Int -> ControllerButton -> ShowS
$cshow :: ControllerButton -> String
show :: ControllerButton -> String
$cshowList :: [ControllerButton] -> ShowS
showList :: [ControllerButton] -> ShowS
Show, Int -> ControllerButton
ControllerButton -> Int
ControllerButton -> [ControllerButton]
ControllerButton -> ControllerButton
ControllerButton -> ControllerButton -> [ControllerButton]
ControllerButton
-> ControllerButton -> ControllerButton -> [ControllerButton]
(ControllerButton -> ControllerButton)
-> (ControllerButton -> ControllerButton)
-> (Int -> ControllerButton)
-> (ControllerButton -> Int)
-> (ControllerButton -> [ControllerButton])
-> (ControllerButton -> ControllerButton -> [ControllerButton])
-> (ControllerButton -> ControllerButton -> [ControllerButton])
-> (ControllerButton
    -> ControllerButton -> ControllerButton -> [ControllerButton])
-> Enum ControllerButton
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 :: ControllerButton -> ControllerButton
succ :: ControllerButton -> ControllerButton
$cpred :: ControllerButton -> ControllerButton
pred :: ControllerButton -> ControllerButton
$ctoEnum :: Int -> ControllerButton
toEnum :: Int -> ControllerButton
$cfromEnum :: ControllerButton -> Int
fromEnum :: ControllerButton -> Int
$cenumFrom :: ControllerButton -> [ControllerButton]
enumFrom :: ControllerButton -> [ControllerButton]
$cenumFromThen :: ControllerButton -> ControllerButton -> [ControllerButton]
enumFromThen :: ControllerButton -> ControllerButton -> [ControllerButton]
$cenumFromTo :: ControllerButton -> ControllerButton -> [ControllerButton]
enumFromTo :: ControllerButton -> ControllerButton -> [ControllerButton]
$cenumFromThenTo :: ControllerButton
-> ControllerButton -> ControllerButton -> [ControllerButton]
enumFromThenTo :: ControllerButton
-> ControllerButton -> ControllerButton -> [ControllerButton]
Enum)

instance FlagRegister ControllerButtonStatus where
    type Flag ControllerButtonStatus = ControllerButton
    fromByte :: Byte -> ControllerButtonStatus
fromByte = Byte -> ControllerButtonStatus
MkCBS
    toByte :: ControllerButtonStatus -> Byte
toByte = ControllerButtonStatus -> Byte
unStatus
    flagToBitOffset :: Flag ControllerButtonStatus -> Int
flagToBitOffset = Flag ControllerButtonStatus -> Int
ControllerButton -> Int
forall a. Enum a => a -> Int
fromEnum

newtype Controller r a = MkC {forall r a.
Controller r a
-> ControllerState -> (ControllerState -> a -> r) -> r
unC :: ControllerState -> (ControllerState -> a -> r) -> r}

runController :: Controller (a, ControllerState) a -> ControllerState -> (a, ControllerState)
runController :: forall a.
Controller (a, ControllerState) a
-> ControllerState -> (a, ControllerState)
runController (MkC ControllerState
-> (ControllerState -> a -> (a, ControllerState))
-> (a, ControllerState)
f) ControllerState
controller = ControllerState
-> (ControllerState -> a -> (a, ControllerState))
-> (a, ControllerState)
f ControllerState
controller (\ControllerState
controller' a
res -> (a
res, ControllerState
controller'))

-- | Sets the strobe state if the byte's first bit is set
setStrobe :: Byte -> Controller r ()
setStrobe :: forall r. Byte -> Controller r ()
setStrobe Byte
byte = (ControllerState -> (ControllerState -> () -> r) -> r)
-> Controller r ()
forall r a.
(ControllerState -> (ControllerState -> a -> r) -> r)
-> Controller r a
MkC ((ControllerState -> (ControllerState -> () -> r) -> r)
 -> Controller r ())
-> (ControllerState -> (ControllerState -> () -> r) -> r)
-> Controller r ()
forall a b. (a -> b) -> a -> b
$ \ControllerState
controller ControllerState -> () -> r
cont ->
    let
        strobe_ :: Bool
strobe_ = Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Byte
byte Int
0
        buttonIdx_ :: Byte
buttonIdx_ = if Bool
strobe_ then Byte
0 else ControllerState -> Byte
buttonIdx ControllerState
controller
     in
        ControllerState -> () -> r
cont (ControllerState
controller{strobe = strobe_, buttonIdx = buttonIdx_}) ()

-- | Returns 1 if the button at the 'buttonIdx' is pressed, or 0 if not.
--
-- Increments the buttonIdx
-- Always returns 1 when the offset if larger than the button count
readButtonStatus :: Controller r Byte
readButtonStatus :: forall r. Controller r Byte
readButtonStatus = (ControllerState -> (ControllerState -> Byte -> r) -> r)
-> Controller r Byte
forall r a.
(ControllerState -> (ControllerState -> a -> r) -> r)
-> Controller r a
MkC ((ControllerState -> (ControllerState -> Byte -> r) -> r)
 -> Controller r Byte)
-> (ControllerState -> (ControllerState -> Byte -> r) -> r)
-> Controller r Byte
forall a b. (a -> b) -> a -> b
$ \ControllerState
controller ControllerState -> Byte -> r
cont ->
    if ControllerState -> Byte
buttonIdx ControllerState
controller Byte -> Byte -> Bool
forall a. Ord a => a -> a -> Bool
> Byte
7
        then ControllerState -> Byte -> r
cont ControllerState
controller (Byte -> r) -> Byte -> r
forall a b. (a -> b) -> a -> b
$ Word8 -> Byte
Byte Word8
1
        else
            let
                res :: Byte
res =
                    Bool -> Byte
boolToByte (Bool -> Byte) -> Bool -> Byte
forall a b. (a -> b) -> a -> b
$
                        Byte -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit
                            (ControllerButtonStatus -> Byte
unStatus (ControllerButtonStatus -> Byte) -> ControllerButtonStatus -> Byte
forall a b. (a -> b) -> a -> b
$ ControllerState -> ControllerButtonStatus
buttonStatus ControllerState
controller)
                            (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> (Byte -> Word8) -> Byte -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Byte -> Word8
unByte (Byte -> Int) -> Byte -> Int
forall a b. (a -> b) -> a -> b
$ ControllerState -> Byte
buttonIdx ControllerState
controller)
                buttonIdx_ :: Byte
buttonIdx_ = ControllerState -> Byte
buttonIdx ControllerState
controller Byte -> Byte -> Byte
forall a. Num a => a -> a -> a
+ Bool -> Byte
boolToByte (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ControllerState -> Bool
strobe ControllerState
controller)
             in
                ControllerState -> Byte -> r
cont (ControllerState
controller{buttonIdx = buttonIdx_}) Byte
res
  where
    boolToByte :: Bool -> Byte
boolToByte = Word8 -> Byte
Byte (Word8 -> Byte) -> (Bool -> Word8) -> Bool -> Byte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Bool -> Int) -> Bool -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum

setButtonAsPressed :: ControllerButton -> Bool -> Controller r ()
setButtonAsPressed :: forall r. ControllerButton -> Bool -> Controller r ()
setButtonAsPressed ControllerButton
status Bool
pressed = (ControllerState -> (ControllerState -> () -> r) -> r)
-> Controller r ()
forall r a.
(ControllerState -> (ControllerState -> a -> r) -> r)
-> Controller r a
MkC ((ControllerState -> (ControllerState -> () -> r) -> r)
 -> Controller r ())
-> (ControllerState -> (ControllerState -> () -> r) -> r)
-> Controller r ()
forall a b. (a -> b) -> a -> b
$ \ControllerState
controller ControllerState -> () -> r
cont ->
    ControllerState -> () -> r
cont
        ControllerState
controller{buttonStatus = setFlag' status pressed (buttonStatus controller)}
        ()