Large amount of refactoring to make CPU use State monad and lenses.

smparsons · Sep 2, 2018 · b03d08a · b03d08a
1 parent fc7743b
commit b03d08a
Show file tree

Hide file tree

Showing 29 changed files with 870 additions and 979 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -5,7 +5,11 @@ import System.Environment
 import SDL
 import Linear (V4(..))
 import Control.Monad (unless)
+import qualified Data.ByteString as BS
+import Control.Monad.State
+import System.Random
 
+import Constants
 import Chip8
 import Types
 
@@ -19,8 +23,11 @@ main = do
 
 startEmulator :: String -> IO ()
 startEmulator filepath = do
-  chip8 <- initializeChip8
-  chip8WithGame <- loadGameByFilePath filepath chip8
+  newSeed <- newStdGen
+  let chip8State = execState (initializeChip8 newSeed) chip8InitialState
+  contents <- BS.readFile filepath
+  let game = BS.unpack contents
+  let chip8State' = execState (loadGameIntoMemory game) chip8State
   renderer <- setupEmulatorGraphics
   emulatorLoop renderer
 

diff --git a/lazy-chip8.cabal b/lazy-chip8.cabal
@@ -33,7 +33,8 @@ library
   build-depends: base >= 4.7 && < 5,
     vector,
     random,
-    bytestring
+    lens,
+    mtl
   default-language: Haskell2010
 
 executable lazy-chip8
@@ -43,14 +44,19 @@ executable lazy-chip8
   build-depends: base >= 4.7 && < 5, 
     sdl2,
     lazy-chip8,
-    linear
+    linear,
+    bytestring,
+    mtl,
+    random
 
 test-suite hspec
     build-depends: base, 
       hspec,
       lazy-chip8,
       vector,
-      random
+      random,
+      lens,
+      mtl
     default-language: Haskell2010
     hs-source-dirs: test
     main-is: Spec.hs

diff --git a/src/Chip8.hs b/src/Chip8.hs
@@ -1,48 +1,41 @@
 module Chip8 
 ( emulateCpuCycle,
   initializeChip8,
-  loadFontset,
-  loadGameByFilePath,
+  loadFontsetIntoMemory,
   loadGameIntoMemory
 ) where
 
 import System.Random
 import Data.Word
-import Data.ByteString as BS
 import qualified Data.Vector as V
+import Control.Monad.State
+import Control.Lens
 
 import Constants
 import Cpu
 import Types
 
-emulateCpuCycle :: Chip8 -> Chip8
-emulateCpuCycle = decrementSoundTimer . decrementDelayTimer . executeOpcode
-
-initializeChip8 :: IO Chip8
-initializeChip8 = do 
-  newSeed <- newStdGen  
-  let emptyMemory = memory chip8InitialState
-  let updatedMemory = loadFontset emptyMemory
-  return chip8InitialState { memory = updatedMemory, randomNumberSeed = newSeed }
-
-loadFontset :: V.Vector Word8 -> V.Vector Word8
-loadFontset givenMemory = V.update givenMemory fontsetAddresses
-  where
-    fontsetVector = V.fromList chip8Fontset
-    fontsetAddresses = V.imap (\currentIndex fontsetByte -> (currentIndex, fontsetByte)) fontsetVector
-
-loadGameByFilePath :: String -> Chip8 -> IO Chip8
-loadGameByFilePath filePath chip8State = do
-  contents <- BS.readFile filePath
-  let game = unpack contents
-  let initialMemory = memory chip8State
-  let updatedMemory = loadGameIntoMemory initialMemory game
-  return chip8State { memory = updatedMemory }
-
-loadGameIntoMemory :: V.Vector Word8 -> [Word8] -> V.Vector Word8
-loadGameIntoMemory givenMemory game = V.update givenMemory gameAddresses
-  where 
-    gameVector = V.fromList game
-    gameAddresses = V.imap (\currentIndex gameByte -> (currentIndex + 0x200, gameByte)) gameVector
-
-
+initializeChip8 :: StdGen -> Chip8 ()
+initializeChip8 newSeed = do 
+  modify (\givenState -> givenState & randomNumberSeed .~ newSeed)  
+  loadFontsetIntoMemory
+
+loadFontsetIntoMemory :: Chip8 ()
+loadFontsetIntoMemory = do
+  let fontsetVector = V.fromList chip8Fontset
+      fontsetAddresses = V.imap (\currentIndex fontsetByte -> (currentIndex, fontsetByte)) fontsetVector
+      loadFontset = flip V.update fontsetAddresses
+  modify (\givenState -> givenState & memory %~ loadFontset)
+
+loadGameIntoMemory :: [Word8] -> Chip8 ()
+loadGameIntoMemory game = do
+  let gameVector = V.fromList $ game
+      gameAddresses = V.imap (\currentIndex gameByte -> (currentIndex + 0x200, gameByte)) gameVector 
+      loadGame = flip V.update gameAddresses
+  modify (\givenState -> givenState & memory %~ loadGame)
+
+emulateCpuCycle :: Chip8 ()
+emulateCpuCycle = do
+  executeOpcode
+  decrementDelayTimer
+  decrementSoundTimer
diff --git a/src/Constants.hs b/src/Constants.hs
@@ -17,21 +17,21 @@ programCounterIncrement = 0x0002
 chip8NumberOfColumns :: Int
 chip8NumberOfColumns = 64
 
-chip8InitialState :: Chip8
-chip8InitialState = Chip8 {
-  currentOpcode = 0x0000,
-  memory = V.replicate 4096 0x00,
-  vRegisters = V.replicate 16 0x00,
-  indexRegister = 0x0000,
-  programCounter = 0x200,
-  graphics = V.replicate 2048 0x00,
-  delayTimer = 0x00,
-  soundTimer = 0x00,
-  stack = V.replicate 16 0x00,
-  stackPointer = 0x0000,
-  keyState = V.replicate 16 0x00,
-  drawFlag = False,
-  randomNumberSeed = mkStdGen 0
+chip8InitialState :: Chip8State
+chip8InitialState = Chip8State {
+  _currentOpcode = 0x0000,
+  _memory = V.replicate 4096 0x00,
+  _vRegisters = V.replicate 16 0x00,
+  _indexRegister = 0x0000,
+  _programCounter = 0x200,
+  _graphics = V.replicate 2048 0x00,
+  _delayTimer = 0x00,
+  _soundTimer = 0x00,
+  _stack = V.replicate 16 0x00,
+  _stackPointer = 0x0000,
+  _keyState = V.replicate 16 0x00,
+  _drawFlag = False,
+  _randomNumberSeed = mkStdGen 0
 }
 
 chip8Fontset :: [Word8] 

diff --git a/src/Cpu.hs b/src/Cpu.hs
@@ -1,7 +1,6 @@
 module Cpu
 ( executeOpcode,
   extractOpcodeFromMemory,
-  decodeOpcode,
   parseDigitsFromOpcode,
   decrementDelayTimer,
   decrementSoundTimer
@@ -10,6 +9,8 @@ module Cpu
 import Data.Word
 import Data.Bits
 import qualified Data.Vector as V
+import Control.Monad.State
+import Control.Lens
 
 import Types
 import Opcodes.Assignment
@@ -23,26 +24,11 @@ import Opcodes.Math
 import Opcodes.Memory
 import Opcodes.Timer
 
-executeOpcode :: Chip8 -> Chip8
-executeOpcode chip8State = operation chip8State 
-  where 
-    originalProgramCounter = programCounter chip8State
-    originalMemory = memory chip8State
-    opcode = extractOpcodeFromMemory originalMemory originalProgramCounter
-    operation = decodeOpcode opcode
-
-extractOpcodeFromMemory :: V.Vector Word8 -> Word16 -> Word16
-extractOpcodeFromMemory givenMemory givenProgramCounter = 
-  leftShiftedOpcodeFirstHalf .|. opcodeSecondHalf
-  where
-    memoryIndex = fromIntegral givenProgramCounter :: Int
-    opcodeFirstHalf = (fromIntegral $ givenMemory V.! memoryIndex) :: Word16
-    opcodeSecondHalf = (fromIntegral $ givenMemory V.! (memoryIndex + 1)) :: Word16 
-    leftShiftedOpcodeFirstHalf = opcodeFirstHalf `shiftL` 8
-
-decodeOpcode :: Word16 -> (Chip8 -> Chip8)
-decodeOpcode opcode =
-  case parseDigitsFromOpcode opcode of
+executeOpcode :: Chip8 ()
+executeOpcode = do
+  extractOpcodeFromMemory
+  opcodeDigits <- parseDigitsFromOpcode
+  case opcodeDigits of
     (0x0, _, 0x0) -> clearScreen
     (0x0, _, 0xE) -> returnFromSubroutine
     (0x1, _, _) -> jumpToAddress
@@ -79,25 +65,34 @@ decodeOpcode opcode =
     (0xF, 0x6, 0x5) -> registerLoad
     _ -> error "Invalid Opcode"
 
-parseDigitsFromOpcode :: Word16 -> (Word16, Word16, Word16)
-parseDigitsFromOpcode opcode = (firstDigit, thirdDigit, lastDigit)
-  where 
-    firstDigit = (opcode .&. 0xF000) `shiftR` 12
-    thirdDigit = (opcode .&. 0x00F0) `shiftR` 4
-    lastDigit = opcode .&. 0x000F
+extractOpcodeFromMemory :: Chip8 ()
+extractOpcodeFromMemory = do
+  chip8State <- get
+  let memoryIndex = (fromIntegral $ chip8State^.programCounter) :: Int
+      opcodeFirstHalf = (fromIntegral $ (chip8State^.memory) V.! memoryIndex) :: Word16
+      opcodeSecondHalf = (fromIntegral $ (chip8State^.memory) V.! (memoryIndex + 1)) :: Word16
+      leftShiftedOpcodeFirstHalf = opcodeFirstHalf `shiftL` 8
+  modify (\givenState -> givenState & currentOpcode .~ (leftShiftedOpcodeFirstHalf .|. opcodeSecondHalf))
+
+parseDigitsFromOpcode :: Chip8 (Word16, Word16, Word16)
+parseDigitsFromOpcode = do
+  chip8State <- get
+  let opcode = chip8State^.currentOpcode
+      firstDigit = (opcode .&. 0xF000) `shiftR` 12
+      thirdDigit = (opcode .&. 0x00F0) `shiftR` 4
+      lastDigit = opcode .&. 0x000F
+  return (firstDigit, thirdDigit, lastDigit)
 
-decrementDelayTimer :: Chip8 -> Chip8
-decrementDelayTimer chip8State = 
-  chip8State { 
-    delayTimer = if originalDelayTimer > 0 then originalDelayTimer - 1 else originalDelayTimer 
-  }
-  where 
-    originalDelayTimer = delayTimer chip8State
+decrementDelayTimer :: Chip8 ()
+decrementDelayTimer = do 
+  chip8State <- get
+  let originalDelayTimer = chip8State^.delayTimer
+      newDelayTimer = if originalDelayTimer > 0 then originalDelayTimer - 1 else originalDelayTimer
+  modify (\givenState -> givenState & delayTimer .~ newDelayTimer)    
 
-decrementSoundTimer :: Chip8 -> Chip8
-decrementSoundTimer chip8State = 
-  chip8State { 
-    soundTimer = if originalSoundTimer > 0 then originalSoundTimer - 1 else originalSoundTimer 
-  }
-  where 
-    originalSoundTimer = soundTimer chip8State
+decrementSoundTimer :: Chip8 ()
+decrementSoundTimer = do
+  chip8State <- get
+  let originalSoundTimer = chip8State^.soundTimer
+      newSoundTimer = if originalSoundTimer > 0 then originalSoundTimer - 1 else originalSoundTimer
+  modify (\givenState -> givenState & soundTimer .~ newSoundTimer)
diff --git a/src/Helpers.hs b/src/Helpers.hs
@@ -4,12 +4,19 @@ module Helpers
   parseRegisterYNumber,
   getRegisterYValue,
   parseTwoDigitConstant,
-  parseThreeDigitConstant
+  parseThreeDigitConstant,
+  incrementProgramCounter,
+  skipNextInstruction
 ) where
 
 import Data.Word
 import Data.Bits
 import qualified Data.Vector as V
+import Control.Monad.State
+import Control.Lens
+
+import Types
+import Constants
 
 --Given an opcode with the format 0x*XY*, return X
 parseRegisterXNumber :: Word16 -> Int 
@@ -35,4 +42,10 @@ parseTwoDigitConstant opcode = (fromIntegral $ opcode .&. 0x00FF) :: Word8
 
 --Given an opcode with the format 0x*NNN, return NNN
 parseThreeDigitConstant :: Word16 -> Word16
-parseThreeDigitConstant opcode = (fromIntegral $ opcode .&. 0x0FFF) :: Word16
+parseThreeDigitConstant opcode = (fromIntegral $ opcode .&. 0x0FFF) :: Word16
+
+incrementProgramCounter :: Chip8 ()
+incrementProgramCounter = modify (\givenState -> givenState & programCounter +~ programCounterIncrement)
+
+skipNextInstruction :: Chip8 ()
+skipNextInstruction = modify (\givenState -> givenState & programCounter +~ (programCounterIncrement * 2))
diff --git a/src/Opcodes/Assignment.hs b/src/Opcodes/Assignment.hs
@@ -3,24 +3,21 @@ module Opcodes.Assignment
 ) where
 
 import qualified Data.Vector as V
+import Control.Monad.State
+import Control.Lens
 
 import Helpers
 import Types
-import Constants
 
 {-
   0x8XY0
   Sets VX to the value of VY.
 -}
-assignToRegister :: Chip8 -> Chip8 
-assignToRegister chip8State =
-  chip8State {
-    vRegisters = V.update originalVRegisters $ V.fromList [(registerX,registerYValue)],
-    programCounter = originalProgramCounter + programCounterIncrement
-  }
-  where 
-    originalVRegisters = vRegisters chip8State
-    originalProgramCounter = programCounter chip8State
-    opcode = currentOpcode chip8State 
-    registerX = parseRegisterXNumber opcode 
-    registerYValue = getRegisterYValue opcode originalVRegisters
+assignToRegister :: Chip8 ()
+assignToRegister = do
+  chip8State <- get
+  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode
+      registerYValue = getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
+      storeAssignment = flip V.update $ V.fromList [(registerX,registerYValue)]
+  modify (\givenState -> givenState & vRegisters %~ storeAssignment)
+  incrementProgramCounter