{-# HLINT ignore "Redundant bracket" #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Nes.Rom (
    -- * Data type
    Rom,
    prgRom,
    chrRom,
    mapper,
    mirroring,
    Mirroring (..),

    -- * Parsing a Rom
    fromFile,
    fromByteString,
    RomParsingError,

    -- * Internal
    unsafeEmptyRom,
) where

import Control.Monad
import Data.Bits
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Word (Word8)
import Nes.Memory (Byte (Byte))

data Mirroring = Vertical | Horizontal | FourScreen deriving (Mirroring -> Mirroring -> Bool
(Mirroring -> Mirroring -> Bool)
-> (Mirroring -> Mirroring -> Bool) -> Eq Mirroring
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mirroring -> Mirroring -> Bool
== :: Mirroring -> Mirroring -> Bool
$c/= :: Mirroring -> Mirroring -> Bool
/= :: Mirroring -> Mirroring -> Bool
Eq, Int -> Mirroring -> ShowS
[Mirroring] -> ShowS
Mirroring -> RomParsingError
(Int -> Mirroring -> ShowS)
-> (Mirroring -> RomParsingError)
-> ([Mirroring] -> ShowS)
-> Show Mirroring
forall a.
(Int -> a -> ShowS)
-> (a -> RomParsingError) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mirroring -> ShowS
showsPrec :: Int -> Mirroring -> ShowS
$cshow :: Mirroring -> RomParsingError
show :: Mirroring -> RomParsingError
$cshowList :: [Mirroring] -> ShowS
showList :: [Mirroring] -> ShowS
Show)

data Rom = Rom
    { Rom -> ByteString
prgRom :: {-# UNPACK #-} !ByteString
    -- ^ The portion of the ROM that's connected to the CPU
    , Rom -> ByteString
chrRom :: {-# UNPACK #-} !ByteString
    -- ^ The portion of the ROM that's connected to the PPU
    , Rom -> Byte
mapper :: {-# UNPACK #-} !Byte
    , Rom -> Mirroring
mirroring :: {-# UNPACK #-} !Mirroring
    }

type RomParsingError = String

fromFile :: FilePath -> IO (Either RomParsingError Rom)
fromFile :: RomParsingError -> IO (Either RomParsingError Rom)
fromFile = (ByteString -> Either RomParsingError Rom)
-> IO ByteString -> IO (Either RomParsingError Rom)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either RomParsingError Rom
fromByteString (IO ByteString -> IO (Either RomParsingError Rom))
-> (RomParsingError -> IO ByteString)
-> RomParsingError
-> IO (Either RomParsingError Rom)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RomParsingError -> IO ByteString
BS.readFile

fromByteString :: ByteString -> (Either RomParsingError Rom)
fromByteString :: ByteString -> Either RomParsingError Rom
fromByteString ByteString
bs = do
    Either RomParsingError ()
guardHeader
    Either RomParsingError ()
guardINesVersion
    Byte
mapper <- Word8 -> Byte
Byte (Word8 -> Byte)
-> Either RomParsingError Word8 -> Either RomParsingError Byte
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RomParsingError Word8
getMapper
    Mirroring
mirroring <- Either RomParsingError Mirroring
getScreenMirroring
    ((Int
prgRomStart, Int
prgRomSize), (Int
chrRomStart, Int
chrRomSize)) <- Either RomParsingError ((Int, Int), (Int, Int))
getRomsRanges
    let prgRom :: ByteString
prgRom = Int -> ByteString -> ByteString
BS.take Int
prgRomSize (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
prgRomStart ByteString
bs
        chrRom :: ByteString
chrRom = Int -> ByteString -> ByteString
BS.take Int
chrRomSize (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
chrRomStart ByteString
bs
    Rom -> Either RomParsingError Rom
forall a. a -> Either RomParsingError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rom -> Either RomParsingError Rom)
-> Rom -> Either RomParsingError Rom
forall a b. (a -> b) -> a -> b
$ Rom{ByteString
Byte
Mirroring
prgRom :: ByteString
chrRom :: ByteString
mapper :: Byte
mirroring :: Mirroring
mapper :: Byte
mirroring :: Mirroring
prgRom :: ByteString
chrRom :: ByteString
..}
  where
    guardHeader :: Either RomParsingError ()
guardHeader =
        let header :: [Word8]
header = ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
4 ByteString
bs
         in Bool -> Either RomParsingError () -> Either RomParsingError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Word8]
header [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8]
nesHeader) (Either RomParsingError () -> Either RomParsingError ())
-> Either RomParsingError () -> Either RomParsingError ()
forall a b. (a -> b) -> a -> b
$
                RomParsingError -> Either RomParsingError ()
forall a b. a -> Either a b
Left RomParsingError
"File is not in iNES file format"
    guardINesVersion :: Either RomParsingError ()
guardINesVersion = do
        Word8
b7 <- Int -> Either RomParsingError Word8
getByte Int
7
        let inesVersion :: Word8
inesVersion = (Word8
b7 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
2) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11
        Bool -> Either RomParsingError () -> Either RomParsingError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
inesVersion Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (Either RomParsingError () -> Either RomParsingError ())
-> Either RomParsingError () -> Either RomParsingError ()
forall a b. (a -> b) -> a -> b
$ RomParsingError -> Either RomParsingError ()
forall a b. a -> Either a b
Left RomParsingError
"iNES 2.0 file format is not supported"
    getMapper :: Either RomParsingError Word8
getMapper = do
        Word8
b7 <- Int -> Either RomParsingError Word8
getByte Int
7
        Word8
b6 <- Int -> Either RomParsingError Word8
getByte Int
6
        Word8 -> Either RomParsingError Word8
forall a. a -> Either RomParsingError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Either RomParsingError Word8)
-> Word8 -> Either RomParsingError Word8
forall a b. (a -> b) -> a -> b
$ Word8
b7 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0b11110000 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (Word8
b6 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
    getScreenMirroring :: Either RomParsingError Mirroring
getScreenMirroring = do
        Word8
b6 <- Int -> Either RomParsingError Word8
getByte Int
6
        let isFourScreen :: Bool
isFourScreen = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
b6 Int
3
            isVerticalMirroring :: Bool
isVerticalMirroring = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
b6 Int
0
        Mirroring -> Either RomParsingError Mirroring
forall a. a -> Either RomParsingError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Mirroring -> Either RomParsingError Mirroring)
-> Mirroring -> Either RomParsingError Mirroring
forall a b. (a -> b) -> a -> b
$ case (Bool
isFourScreen, Bool
isVerticalMirroring) of
            (Bool
True, Bool
_) -> Mirroring
FourScreen
            (Bool
False, Bool
True) -> Mirroring
Vertical
            (Bool
False, Bool
False) -> Mirroring
Horizontal
    getRomsRanges :: Either RomParsingError ((Int, Int), (Int, Int))
getRomsRanges = do
        Int
prgRomSize <- (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
prgRomPageSize) (Int -> Int) -> (Word8 -> Int) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int)
-> Either RomParsingError Word8 -> Either RomParsingError Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Either RomParsingError Word8
getByte Int
4
        Int
chrRomSize <- (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
chrRomPageSize) (Int -> Int) -> (Word8 -> Int) -> Word8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int)
-> Either RomParsingError Word8 -> Either RomParsingError Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Either RomParsingError Word8
getByte Int
5
        Word8
b6 <- Int -> Either RomParsingError Word8
getByte Int
6
        let skipTrainer :: Bool
skipTrainer = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
b6 Int
2
            prgRomStart :: Int
prgRomStart = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
skipTrainer then Int
512 else Int
0)
            chrRomStart :: Int
chrRomStart = Int
prgRomStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
prgRomSize
        ((Int, Int), (Int, Int))
-> Either RomParsingError ((Int, Int), (Int, Int))
forall a. a -> Either RomParsingError a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
prgRomStart, Int
prgRomSize), (Int
chrRomStart, Int
chrRomSize))
    getByte :: Int -> Either RomParsingError Word8
getByte Int
n = case ByteString -> Int -> Maybe Word8
BS.indexMaybe ByteString
bs Int
n of
        Maybe Word8
Nothing -> RomParsingError -> Either RomParsingError Word8
forall a b. a -> Either a b
Left RomParsingError
"Truncated file"
        Just Word8
b -> Word8 -> Either RomParsingError Word8
forall a. a -> Either RomParsingError a
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
b

-- | For testing purposes, do not use
unsafeEmptyRom :: Rom
unsafeEmptyRom :: Rom
unsafeEmptyRom = ByteString -> ByteString -> Byte -> Mirroring -> Rom
Rom ByteString
BS.empty ByteString
BS.empty Byte
0 Mirroring
Horizontal

-- TODO Handle iNES2.0

-- Constants

nesHeader :: [Word8]
nesHeader :: [Word8]
nesHeader = [Word8
0x4e, Word8
0x45, Word8
0x53, Word8
0x1a]

prgRomPageSize :: Int
prgRomPageSize :: Int
prgRomPageSize = Int
16384

chrRomPageSize :: Int
chrRomPageSize :: Int
chrRomPageSize = Int
8192