Skip to content

Commit

Permalink
checkpoint
Browse files Browse the repository at this point in the history
  • Loading branch information
dbousamra committed Nov 5, 2017
1 parent 311613c commit c760d0f
Show file tree
Hide file tree
Showing 11 changed files with 354 additions and 64 deletions.
239 changes: 239 additions & 0 deletions .stylish-haskell.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,239 @@
# Default stylish-haskell configuration file in Serokell.
# It's based on default config provided by `stylish-haskell --defaults` but has some changes
# ==================================

# The stylish-haskell tool is mainly configured by specifying steps. These steps
# are a list, so they have an order, and one specific step may appear more than
# once (if needed). Each file is processed by these steps in the given order.
steps:
# Convert some ASCII sequences to their Unicode equivalents. This is disabled
# by default.
# - unicode_syntax:
# # In order to make this work, we also need to insert the UnicodeSyntax
# # language pragma. If this flag is set to true, we insert it when it's
# # not already present. You may want to disable it if you configure
# # language extensions using some other method than pragmas. Default:
# # true.
# add_language_pragma: true

# Align the right hand side of some elements. This is quite conservative
# and only applies to statements where each element occupies a single
# line.
- simple_align:
cases: true
top_level_patterns: true
records: true

# Import cleanup
- imports:
# There are different ways we can align names and lists.
#
# - global: Align the import names and import list throughout the entire
# file.
#
# - file: Like global, but don't add padding when there are no qualified
# imports in the file.
#
# - group: Only align the imports per group (a group is formed by adjacent
# import lines).
#
# - none: Do not perform any alignment.
#
# Default: global.
align: global

# The following options affect only import list alignment.
#
# List align has following options:
#
# - after_alias: Import list is aligned with end of import including
# 'as' and 'hiding' keywords.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# > init, last, length)
#
# - with_alias: Import list is aligned with start of alias or hiding.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# > init, last, length)
#
# - new_line: Import list starts always on new line.
#
# > import qualified Data.List as List
# > (concat, foldl, foldr, head, init, last, length)
#
# Default: after_alias
list_align: after_alias

# Right-pad the module names to align imports in a group:
#
# - true: a little more readable
#
# > import qualified Data.List as List (concat, foldl, foldr,
# > init, last, length)
# > import qualified Data.List.Extra as List (concat, foldl, foldr,
# > init, last, length)
#
# - false: diff-safe
#
# > import qualified Data.List as List (concat, foldl, foldr, init,
# > last, length)
# > import qualified Data.List.Extra as List (concat, foldl, foldr,
# > init, last, length)
#
# Default: true
pad_module_names: true

# Long list align style takes effect when import is too long. This is
# determined by 'columns' setting.
#
# - inline: This option will put as much specs on same line as possible.
#
# - new_line: Import list will start on new line.
#
# - new_line_multiline: Import list will start on new line when it's
# short enough to fit to single line. Otherwise it'll be multiline.
#
# - multiline: One line per import list entry.
# Type with constructor list acts like single import.
#
# > import qualified Data.Map as M
# > ( empty
# > , singleton
# > , ...
# > , delete
# > )
#
# Default: inline
long_list_align: inline

# Align empty list (importing instances)
#
# Empty list align has following options
#
# - inherit: inherit list_align setting
#
# - right_after: () is right after the module name:
#
# > import Vector.Instances ()
#
# Default: inherit
empty_list_align: inherit

# List padding determines indentation of import list on lines after import.
# This option affects 'long_list_align'.
#
# - <integer>: constant value
#
# - module_name: align under start of module name.
# Useful for 'file' and 'group' align settings.
list_padding: 4

# Separate lists option affects formatting of import list for type
# or class. The only difference is single space between type and list
# of constructors, selectors and class functions.
#
# - true: There is single space between Foldable type and list of it's
# functions.
#
# > import Data.Foldable (Foldable (fold, foldl, foldMap))
#
# - false: There is no space between Foldable type and list of it's
# functions.
#
# > import Data.Foldable (Foldable(fold, foldl, foldMap))
#
# Default: true
separate_lists: true

# Space surround option affects formatting of import lists on a single
# line. The only difference is single space after the initial
# parenthesis and a single space before the terminal parenthesis.
#
# - true: There is single space associated with the enclosing
# parenthesis.
#
# > import Data.Foo ( foo )
#
# - false: There is no space associated with the enclosing parenthesis
#
# > import Data.Foo (foo)
#
# Default: false
space_surround: false

# Language pragmas
- language_pragmas:
# We can generate different styles of language pragma lists.
#
# - vertical: Vertical-spaced language pragmas, one per line.
#
# - compact: A more compact style.
#
# - compact_line: Similar to compact, but wrap each line with
# `{-#LANGUAGE #-}'.
#
# Default: vertical.
style: vertical

# stylish-haskell can detect redundancy of some language pragmas. If this
# is set to true, it will remove those redundant pragmas. Default: true.
remove_redundant: true

# Replace tabs by spaces. This is disabled by default.
# - tabs:
# # Number of spaces to use for each tab. Default: 8, as specified by the
# # Haskell report.
# spaces: 8

# Remove trailing whitespace
- trailing_whitespace: {}

# A common setting is the number of columns (parts of) code will be wrapped
# to. Different steps take this into account. Default: 80.
columns: 90

# By default, line endings are converted according to the OS. You can override
# preferred format here.
#
# - native: Native newline format. CRLF on Windows, LF on other OSes.
#
# - lf: Convert to LF ("\n").
#
# - crlf: Convert to CRLF ("\r\n").
#
# Default: native.
newline: native

# These syntax-affecting language extensions are enabled so that
# stylish-haskell wouldn't fail with parsing errors when processing files
# in projects that have those extensions enabled in the .cabal file
# rather than locally.
#
# To my best knowledge, no harm should result from enabling an extension
# that isn't actually used in the file/project. —@neongreen
language_extensions:
- BangPatterns
- ConstraintKinds
- DataKinds
- DefaultSignatures
- DeriveDataTypeable
- DeriveGeneric
- FlexibleContexts
- FlexibleInstances
- FunctionalDependencies
- GADTs
- GeneralizedNewtypeDeriving
- LambdaCase
- MultiParamTypeClasses
- MultiWayIf
- NoImplicitPrelude
- OverloadedStrings
- RecordWildCards
- ScopedTypeVariables
- StandaloneDeriving
- TemplateHaskell
- TupleSections
- TypeApplications
- TypeFamilies
- ViewPatterns
Binary file added roms/MM.nes
Binary file not shown.
Binary file added roms/Zelda.NES
Binary file not shown.
Binary file added roms/ppu/Scrolldemo.nes
Binary file not shown.
Binary file added roms/ppu/full_palette.nes
Binary file not shown.
Binary file added roms/ppu/full_palette_alt.nes
Binary file not shown.
Binary file added roms/ppu/scroll.nes
Binary file not shown.
2 changes: 1 addition & 1 deletion src/Emulator.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ import Prelude hiding (and, compare)
step :: IOEmulator ()
step = do
cycles' <- CPU.step
replicateM_ (cycles' * 10) PPU.step
replicateM_ (cycles' * 3) PPU.step

stepFrame :: IOEmulator ()
stepFrame = do
Expand Down
11 changes: 5 additions & 6 deletions src/Emulator/Cartridge.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@ data INesFileHeader = INesFileHeader {
} deriving (Eq, Show)

data Cartridge = Cartridge {
header :: INesFileHeader,
chrRom :: VUM.MVector RealWorld Word8,
prgRom :: VUM.MVector RealWorld Word8,
sRam :: VUM.MVector RealWorld Word8,
Expand All @@ -46,8 +45,8 @@ parseHeader bs = INesFileHeader

parse :: BS.ByteString -> IO Cartridge
parse bs = do
let header @ (INesFileHeader _ numPrg numChr _ _ _) = parseHeader bs
let prgOffset = numPrg * prgRomSize
let (INesFileHeader _ numPrg numChr _ _ _) = parseHeader bs
let prgOffset = numPrg * prgRomSize
let prgRom = sliceBS headerSize (headerSize + prgOffset) bs
let chrOffset = numChr * chrRomSize
let chrRom = if numChr == 0 then (BS.replicate chrRomSize 0)
Expand All @@ -64,10 +63,10 @@ parse bs = do
let chrBanks = VUM.length chr `div` 0x2000
chrBank1 <- newIORef 0

pure $ Cartridge header chr prg sram prgBanks chrBanks prgBank1 prgBank2 chrBank1
pure $ Cartridge chr prg sram prgBanks chrBanks prgBank1 prgBank2 chrBank1

read :: Cartridge -> Word16 -> IO Word8
read (Cartridge _ chr prg _ _ _ prgBank1 prgBank2 _) addr
read (Cartridge chr prg _ _ _ prgBank1 prgBank2 _) addr
| addr' < 0x2000 = VUM.unsafeRead chr addr'
| addr' >= 0xC000 = do
prgBank2V <- readIORef prgBank2
Expand All @@ -80,7 +79,7 @@ read (Cartridge _ chr prg _ _ _ prgBank1 prgBank2 _) addr
where addr' = fromIntegral addr

write :: Cartridge -> Word16 -> Word8 -> IO ()
write (Cartridge _ chr _ sram _ _ prgBank1 _ _) addr v
write (Cartridge chr _ sram _ _ prgBank1 _ _) addr v
| addr' < 0x2000 = VUM.unsafeWrite chr addr' v
| addr' >= 0x8000 = modifyIORef prgBank1 (const $ toInt v)
| addr' >= 0x6000 = VUM.unsafeWrite sram (addr' - 0x6000) v
Expand Down
27 changes: 20 additions & 7 deletions src/Emulator/Nes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@

module Emulator.Nes (
Nes(..)
, Coords
, Flag(..)
, IncrementMode(..)
, SpriteTableAddr(..)
Expand Down Expand Up @@ -32,6 +33,8 @@ import Emulator.Util
import Prelude hiding (read, replicate)
import System.Random

type Coords = (Int, Int)

data IncrementMode = Horizontal | Vertical

data SpriteTableAddr = SpriteTable0000 | SpriteTable1000
Expand Down Expand Up @@ -143,9 +146,10 @@ data Ppu a where
HiTileByte :: Ppu Word8
TileData :: Ppu Word64
PaletteData :: Int -> Ppu Word8
OamData :: Word16 -> Ppu Word8
PpuMemory8 :: Word16 -> Ppu Word8
PpuMemory16 :: Word16 -> Ppu Word16
Screen :: (Int, Int) -> Ppu (Word8, Word8, Word8)
Screen :: Coords -> Ppu (Word8, Word8, Word8)
ScreenBuffer :: Ppu (VUM.IOVector Word8)

data Address a where
Expand Down Expand Up @@ -340,6 +344,7 @@ readPPU nes addr = case addr of
LoTileByte -> readIORef $ loTileByte $ ppu nes
HiTileByte -> readIORef $ hiTileByte $ ppu nes
TileData -> readIORef $ tileData $ ppu nes
OamData addr -> readOAMData' (ppu nes) addr
PaletteData i -> VUM.unsafeRead (paletteData $ ppu nes) i
ScreenBuffer -> pure $ screen $ ppu nes
PpuMemory8 r -> readPPUMemory nes r
Expand All @@ -357,7 +362,7 @@ writePPU ppu addr v = case addr of
TileData -> modifyIORef' (tileData ppu) (const v)
Screen coords -> do
let (r, g, b) = v
let offset = translateXY coords 256 * 3
let offset = fromIntegral $ translateXY coords 256 * 3
VUM.write (screen ppu) (offset + 0) r
VUM.write (screen ppu) (offset + 1) g
VUM.write (screen ppu) (offset + 2) b
Expand All @@ -381,7 +386,7 @@ writePPUMemory nes addr v
readPPURegister :: Nes -> Word16 -> IO Word8
readPPURegister nes addr = case 0x2000 + addr `mod` 8 of
0x2002 -> readStatus (ppu nes)
0x2004 -> readOAM (ppu nes)
0x2004 -> readOAMData (ppu nes)
0x2007 -> readData nes
other -> error $ "Unimplemented read at " ++ show other

Expand All @@ -392,8 +397,13 @@ readStatus ppu = do
modifyIORef' (verticalBlank ppu) (const False)
pure $ fromIntegral r

readOAM :: PPU -> IO Word8
readOAM ppu = error "Unimplemented PPU readOAM"
readOAMData :: PPU -> IO Word8
readOAMData ppu = do
addr <- readIORef $ oamAddress ppu
VUM.unsafeRead (oamData ppu) (fromIntegral $ addr)

readOAMData' :: PPU -> Word16 -> IO Word8
readOAMData' ppu addr = VUM.unsafeRead (oamData ppu) (fromIntegral $ addr)

readData :: Nes -> IO Word8
readData nes = do
Expand Down Expand Up @@ -455,7 +465,10 @@ writeOAMAddress :: PPU -> Word8 -> IO ()
writeOAMAddress ppu v = modifyIORef' (oamAddress ppu) (const v)

writeOAMData :: PPU -> Word8 -> IO ()
writeOAMData ppu v = error $ "Unimplemented writeOAMData at " ++ prettifyWord8 v
writeOAMData ppu v = do
addr <- readIORef $ oamAddress ppu
VUM.unsafeWrite (oamData ppu) (toInt addr) v
modifyIORef' (oamAddress ppu) (+ 1)

writeScroll :: PPU -> Word8 -> IO ()
writeScroll ppu v = do
Expand Down Expand Up @@ -497,5 +510,5 @@ writeData nes v = do
writeKeys :: Nes -> [Controller.Key] -> IO ()
writeKeys = Controller.setKeysDown . controller

translateXY :: (Int, Int) -> Int -> Int
translateXY :: Coords -> Int -> Int
translateXY (x, y) width = x + (y * width)
Loading

0 comments on commit c760d0f

Please sign in to comment.