Putting helpers inside state monad as well.

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

Hide file tree

Showing 12 changed files with 146 additions and 145 deletions.
diff --git a/src/Helpers.hs b/src/Helpers.hs
@@ -3,6 +3,7 @@ module Helpers
   getRegisterXValue,
   parseRegisterYNumber,
   getRegisterYValue,
+  parseOneDigitConstant,
   parseTwoDigitConstant,
   parseThreeDigitConstant,
   incrementProgramCounter,
@@ -18,31 +19,34 @@ import Control.Lens
 import Types
 import Constants
 
---Given an opcode with the format 0x*XY*, return X
-parseRegisterXNumber :: Word16 -> Int 
-parseRegisterXNumber opcode = (fromIntegral $ shiftR (opcode .&. 0x0F00) 8) :: Int
+parseRegisterXNumber :: Chip8 Int 
+parseRegisterXNumber = 
+  gets (\givenState -> (fromIntegral $ (givenState^.currentOpcode .&. 0x0F00) `shiftR` 8) :: Int)
 
---Given an opcode with the format 0x*XY* and a vector of registers, return the value stored in register X
-getRegisterXValue :: Word16 -> V.Vector Word8 -> Word8
-getRegisterXValue opcode registers = registers V.! registerNumber where
-  registerNumber = parseRegisterXNumber opcode
+getRegisterXValue :: Chip8 Word8
+getRegisterXValue = do
+  chip8State <- get
+  registerNumber <- parseRegisterXNumber  
+  return $ (chip8State^.vRegisters) V.! registerNumber
 
---Given an opcode with the format 0x*XY*, return Y
-parseRegisterYNumber :: Word16 -> Int
-parseRegisterYNumber opcode = (fromIntegral $ shiftR (opcode .&. 0x00F0) 4) :: Int
+parseRegisterYNumber :: Chip8 Int
+parseRegisterYNumber = 
+  gets (\givenState -> (fromIntegral $ (givenState^.currentOpcode .&. 0x00F0) `shiftR` 4) :: Int)
 
---Given an opcode with the format 0x*XY* and a vector of registers, return the value stored in register Y
-getRegisterYValue :: Word16 -> V.Vector Word8 -> Word8
-getRegisterYValue opcode registers = registers V.! registerNumber where 
-  registerNumber = parseRegisterYNumber opcode
+getRegisterYValue :: Chip8 Word8
+getRegisterYValue = do
+  chip8State <- get
+  registerNumber <- parseRegisterYNumber 
+  return $ (chip8State^.vRegisters) V.! registerNumber 
 
---Given an opcode with the format 0x**NN, return NN
-parseTwoDigitConstant :: Word16 -> Word8
-parseTwoDigitConstant opcode = (fromIntegral $ opcode .&. 0x00FF) :: Word8
+parseOneDigitConstant :: Chip8 Word8
+parseOneDigitConstant = gets (\givenState -> (fromIntegral $ (givenState^.currentOpcode) .&. 0x000F) :: Word8)
 
---Given an opcode with the format 0x*NNN, return NNN
-parseThreeDigitConstant :: Word16 -> Word16
-parseThreeDigitConstant opcode = (fromIntegral $ opcode .&. 0x0FFF) :: Word16
+parseTwoDigitConstant :: Chip8 Word8
+parseTwoDigitConstant = gets (\givenState -> (fromIntegral $ (givenState^.currentOpcode) .&. 0x00FF) :: Word8)
+
+parseThreeDigitConstant :: Chip8 Word16
+parseThreeDigitConstant = gets (\givenState -> (givenState^.currentOpcode) .&. 0x0FFF)
 
 incrementProgramCounter :: Chip8 ()
 incrementProgramCounter = modify (\givenState -> givenState & programCounter +~ programCounterIncrement)

diff --git a/src/Opcodes/Assignment.hs b/src/Opcodes/Assignment.hs
@@ -15,9 +15,8 @@ import Types
 -}
 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)]
+  registerX <- parseRegisterXNumber
+  registerYValue <- getRegisterYValue
+  let storeAssignment = flip V.update $ V.fromList [(registerX,registerYValue)]
   modify (\givenState -> givenState & vRegisters %~ storeAssignment)
   incrementProgramCounter 
diff --git a/src/Opcodes/BitwiseOps.hs b/src/Opcodes/BitwiseOps.hs
@@ -23,11 +23,10 @@ import Types
 -}
 bitwiseOr :: Chip8 ()
 bitwiseOr = do
-  chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode 
-      registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      registerYValue = getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      bitwiseOrResult = registerXValue .|. registerYValue
+  registerX <- parseRegisterXNumber
+  registerXValue <- getRegisterXValue
+  registerYValue <- getRegisterYValue 
+  let bitwiseOrResult = registerXValue .|. registerYValue
       storeBitwiseOrResult = flip V.update $ V.fromList [(registerX,bitwiseOrResult)]
   modify (\givenState -> givenState & vRegisters %~ storeBitwiseOrResult)
   incrementProgramCounter 
@@ -38,11 +37,10 @@ bitwiseOr = do
 -}
 bitwiseAnd :: Chip8 ()
 bitwiseAnd = do
-  chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode 
-      registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      registerYValue = getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      bitwiseAndResult = registerXValue .&. registerYValue
+  registerX <- parseRegisterXNumber
+  registerXValue <- getRegisterXValue
+  registerYValue <- getRegisterYValue 
+  let bitwiseAndResult = registerXValue .&. registerYValue
       storeBitwiseAndResult = flip V.update $ V.fromList [(registerX,bitwiseAndResult)]
   modify (\givenState -> givenState & vRegisters %~ storeBitwiseAndResult)
   incrementProgramCounter
@@ -54,9 +52,9 @@ bitwiseAnd = do
 randomBitwiseAnd :: Chip8 ()
 randomBitwiseAnd = do
   chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode
-      constant = parseTwoDigitConstant $ chip8State^.currentOpcode
-      randomResultTuple = randomR (0, 255) (chip8State^.randomNumberSeed)
+  registerX <- parseRegisterXNumber
+  constant <- parseTwoDigitConstant
+  let randomResultTuple = randomR (0, 255) (chip8State^.randomNumberSeed)
       randomValue = fst randomResultTuple :: Word8
       newSeed = snd randomResultTuple
       bitwiseAndResult = constant .&. randomValue
@@ -71,11 +69,10 @@ randomBitwiseAnd = do
 -}
 bitwiseXor :: Chip8 ()
 bitwiseXor = do
-  chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode 
-      registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      registerYValue = getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      bitwiseXorResult = registerXValue `xor` registerYValue
+  registerX <- parseRegisterXNumber
+  registerXValue <- getRegisterXValue
+  registerYValue <- getRegisterYValue 
+  let bitwiseXorResult = registerXValue `xor` registerYValue
       storeBitwiseXorResult = flip V.update $ V.fromList [(registerX,bitwiseXorResult)]
   modify (\givenState -> givenState & vRegisters %~ storeBitwiseXorResult)
   incrementProgramCounter
@@ -86,10 +83,9 @@ bitwiseXor = do
 -}
 shiftRight :: Chip8 ()
 shiftRight = do
-  chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode 
-      registerYValue = getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      leastSignificantBit = registerYValue .&. 0x1
+  registerX <- parseRegisterXNumber
+  registerYValue <- getRegisterYValue 
+  let leastSignificantBit = registerYValue .&. 0x1
       bitShiftResult = registerYValue `shiftR` 1
       storeBitShiftResult = flip V.update $ V.fromList [(registerX,bitShiftResult),(0xF,leastSignificantBit)]
   modify (\givenState -> givenState & vRegisters %~ storeBitShiftResult)
@@ -101,11 +97,10 @@ shiftRight = do
 -}
 shiftLeft :: Chip8 ()
 shiftLeft = do
-  chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode 
-      registerY = parseRegisterYNumber $ chip8State^.currentOpcode
-      registerYValue = getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      mostSignificantBit = (registerYValue .&. 0x80) `shiftR` 7
+  registerX <- parseRegisterXNumber
+  registerY <- parseRegisterYNumber
+  registerYValue <- getRegisterYValue 
+  let mostSignificantBit = (registerYValue .&. 0x80) `shiftR` 7
       bitShiftResult = registerYValue `shiftL` 1
       storeBitShiftResult = flip V.update $ V.fromList
         [ (registerX,bitShiftResult)

diff --git a/src/Opcodes/Conditionals.hs b/src/Opcodes/Conditionals.hs
@@ -5,9 +5,6 @@ module Opcodes.Conditionals
   registersAreNotEqual
 ) where
 
-import Control.Monad.State
-import Control.Lens
-
 import Helpers
 import Types
 
@@ -18,9 +15,8 @@ import Types
 -}
 registerEqualsConstant :: Chip8 ()
 registerEqualsConstant = do
-  chip8State <- get
-  let registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      constant = parseTwoDigitConstant $ chip8State^.currentOpcode
+  registerXValue <- getRegisterXValue
+  constant <- parseTwoDigitConstant
   if registerXValue == constant then skipNextInstruction else incrementProgramCounter
 
 {-
@@ -30,9 +26,8 @@ registerEqualsConstant = do
 -}
 registerDoesNotEqualConstant :: Chip8 ()
 registerDoesNotEqualConstant = do
-  chip8State <- get
-  let registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      constant = parseTwoDigitConstant $ chip8State^.currentOpcode
+  registerXValue <- getRegisterXValue
+  constant <- parseTwoDigitConstant
   if registerXValue /= constant then skipNextInstruction else incrementProgramCounter
 
 {-
@@ -42,9 +37,8 @@ registerDoesNotEqualConstant = do
 -}
 registersAreEqual :: Chip8 ()
 registersAreEqual = do
-  chip8State <- get
-  let registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      registerYValue = getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
+  registerXValue <- getRegisterXValue
+  registerYValue <- getRegisterYValue
   if registerXValue == registerYValue then skipNextInstruction else incrementProgramCounter
 
 {-
@@ -54,7 +48,6 @@ registersAreEqual = do
 -}
 registersAreNotEqual :: Chip8 () 
 registersAreNotEqual = do
-  chip8State <- get
-  let registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      registerYValue = getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
+  registerXValue <- getRegisterXValue
+  registerYValue <- getRegisterYValue
   if registerXValue /= registerYValue then skipNextInstruction else incrementProgramCounter
diff --git a/src/Opcodes/ConstantOps.hs b/src/Opcodes/ConstantOps.hs
@@ -16,10 +16,9 @@ import Types
 -}
 setRegisterToConstant :: Chip8 ()
 setRegisterToConstant = do
-  chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode
-      constant = parseTwoDigitConstant $ chip8State^.currentOpcode
-      storeConstant = flip V.update $ V.fromList [(registerX,constant)]
+  registerX <- parseRegisterXNumber
+  constant <- parseTwoDigitConstant
+  let storeConstant = flip V.update $ V.fromList [(registerX,constant)]
   modify (\givenState -> givenState & vRegisters %~ storeConstant)
   incrementProgramCounter 
 
@@ -29,11 +28,10 @@ setRegisterToConstant = do
 -}
 addConstantToRegister :: Chip8 ()
 addConstantToRegister = do
-  chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode
-      registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      constant = parseTwoDigitConstant $ chip8State^.currentOpcode
-      total = registerXValue + constant
+  registerX <- parseRegisterXNumber
+  registerXValue <- getRegisterXValue
+  constant <- parseTwoDigitConstant
+  let total = registerXValue + constant
       storeTotal = flip V.update $ V.fromList [(registerX,total)]
   modify (\givenState -> givenState & vRegisters %~ storeTotal)
   incrementProgramCounter
diff --git a/src/Opcodes/Display.hs b/src/Opcodes/Display.hs
@@ -33,23 +33,26 @@ clearScreen = do
 drawGraphics :: Chip8 ()
 drawGraphics = do
   chip8State <- get
-  let coordinateX = (fromIntegral $ getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)) :: Int
-      coordinateY = (fromIntegral $ getRegisterYValue (chip8State^.currentOpcode) (chip8State^.vRegisters)) :: Int
-      spriteHeight = (fromIntegral $ chip8State^.currentOpcode .&. 0x000F) :: Int
+  coordinateX <- getRegisterXValue
+  coordinateY <- getRegisterYValue
+  spriteHeight <- parseOneDigitConstant
+  let coordinateX' = fromIntegral coordinateX :: Int
+      coordinateY' = fromIntegral coordinateY :: Int
+      spriteHeight' = fromIntegral spriteHeight :: Int
       spriteWidth = 8
       pixelChangesAndCollisions = 
         map
           (\(colOffset,rowOffset) -> 
             let convertedIndexRegisterValue = (fromIntegral $ chip8State^.indexRegister) :: Int
-                currentIndex = coordinateX + colOffset + ((coordinateY + rowOffset) * chip8NumberOfColumns)
+                currentIndex = coordinateX' + colOffset + ((coordinateY' + rowOffset) * chip8NumberOfColumns)
                 graphicsPixel = (chip8State^.graphics) V.! currentIndex
                 memoryValue = (chip8State^.memory) V.! (convertedIndexRegisterValue + rowOffset)
                 memoryPixel = 
                   (memoryValue .&. (0x80 `shiftR` colOffset)) `shiftR` ((spriteWidth - 1) - colOffset)
                 result = graphicsPixel `xor` memoryPixel
                 collision = graphicsPixel == 1 && memoryPixel == 1
                 in ((currentIndex, result), collision))
-          [(colOffset,rowOffset) | colOffset <- [0..spriteWidth-1], rowOffset <- [0..spriteHeight-1]]
+          [(colOffset,rowOffset) | colOffset <- [0..spriteWidth-1], rowOffset <- [0..spriteHeight'-1]]
       pixelChanges = map (\((currentIndex, result), _) -> (currentIndex, result)) pixelChangesAndCollisions
       collisionResult = if (any (\((_, _), collision) -> collision) pixelChangesAndCollisions) then 0x1 else 0x0
       updateGraphics = flip V.update $ V.fromList pixelChanges

diff --git a/src/Opcodes/Flow.hs b/src/Opcodes/Flow.hs
@@ -33,8 +33,7 @@ returnFromSubroutine = do
 -}
 jumpToAddress :: Chip8 ()
 jumpToAddress = do
-  chip8State <- get
-  let newAddress = parseThreeDigitConstant $ chip8State^.currentOpcode
+  newAddress <- parseThreeDigitConstant
   modify (\givenState -> givenState & programCounter .~ newAddress)
 
 {-
@@ -47,7 +46,7 @@ callSubroutine = do
   let storeAddressInStack = flip V.snoc $ chip8State^.programCounter  
   modify (\givenState -> givenState & stack %~ storeAddressInStack)
   modify (\givenState -> givenState & stackPointer +~ 1)
-  let newAddress = parseThreeDigitConstant $ chip8State^.currentOpcode 
+  newAddress <- parseThreeDigitConstant
   modify (\givenState -> givenState & programCounter .~ newAddress)
 
 {-
@@ -57,8 +56,8 @@ callSubroutine = do
 jumpToAddressPlusRegisterZero :: Chip8 () 
 jumpToAddressPlusRegisterZero = do
   chip8State <- get
-  let constant = parseThreeDigitConstant $ chip8State^.currentOpcode
-      registerZeroValue = (chip8State^.vRegisters) V.! 0x0
+  constant <- parseThreeDigitConstant
+  let registerZeroValue = (chip8State^.vRegisters) V.! 0x0
       convertedRegisterValue = fromIntegral registerZeroValue :: Word16
       newAddress = constant + convertedRegisterValue
   modify (\givenState -> givenState & programCounter .~ newAddress)
diff --git a/src/Opcodes/KeyOps.hs b/src/Opcodes/KeyOps.hs
@@ -19,9 +19,9 @@ import Types
 -}
 keyIsPressed :: Chip8 ()
 keyIsPressed = do
-  chip8State <- get 
-  let registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      key = fromIntegral registerXValue :: Int
+  chip8State <- get
+  registerXValue <- getRegisterXValue 
+  let key = fromIntegral registerXValue :: Int
       keyValue = (chip8State^.keyState) V.! key
   if keyValue == 0x1 then skipNextInstruction else incrementProgramCounter
 
@@ -33,8 +33,8 @@ keyIsPressed = do
 keyIsNotPressed :: Chip8 ()
 keyIsNotPressed = do
   chip8State <- get
-  let registerXValue = getRegisterXValue (chip8State^.currentOpcode) (chip8State^.vRegisters)
-      key = fromIntegral registerXValue :: Int
+  registerXValue <- getRegisterXValue
+  let key = fromIntegral registerXValue :: Int
       keyValue = (chip8State^.keyState) V.! key
   if keyValue == 0x0 then skipNextInstruction else incrementProgramCounter
 
@@ -46,8 +46,8 @@ keyIsNotPressed = do
 awaitKeyPress :: Chip8 ()
 awaitKeyPress = do
   chip8State <- get
-  let registerX = parseRegisterXNumber $ chip8State^.currentOpcode
-      pressedKey = V.findIndex (\key -> key == 0x1) (chip8State^.keyState)
+  registerX <- parseRegisterXNumber
+  let pressedKey = V.findIndex (\key -> key == 0x1) (chip8State^.keyState)
   case pressedKey of
     Nothing -> return ()
     Just key -> do