Implemented listening to and storing key presses and releases

smparsons · Sep 4, 2018 · f1ec5c8 · f1ec5c8
1 parent 647a2a2
commit f1ec5c8
Show file tree

Hide file tree

Showing 8 changed files with 103 additions and 27 deletions.
diff --git a/app/Main.hs b/app/Main.hs
@@ -2,19 +2,43 @@
 module Main where
 
 import System.Environment
-import SDL
+import qualified SDL
 import Control.Monad (unless)
 import qualified Data.ByteString as BS
 import Control.Monad.State
 import Control.Lens
 import Control.Concurrent
 import System.Random
 import Foreign.C.Types
+import qualified Data.HashMap.Strict as M
+import Data.Maybe
+import Data.Hashable
 
 import Constants
 import Chip8
 import Types
 
+instance Hashable SDL.Keycode
+
+chip8KeyMapping :: M.HashMap SDL.Keycode Int
+chip8KeyMapping = M.fromList
+  [ (SDL.Keycode1, 0x1)
+  , (SDL.Keycode2, 0x2)
+  , (SDL.Keycode3, 0x3)
+  , (SDL.Keycode4, 0xC)
+  , (SDL.KeycodeQ, 0x4)
+  , (SDL.KeycodeW, 0x5)
+  , (SDL.KeycodeE, 0x6)
+  , (SDL.KeycodeR, 0xD)
+  , (SDL.KeycodeA, 0x7)
+  , (SDL.KeycodeS, 0x8)
+  , (SDL.KeycodeD, 0x9)
+  , (SDL.KeycodeF, 0xE)
+  , (SDL.KeycodeZ, 0xA)
+  , (SDL.KeycodeX, 0x0)
+  , (SDL.KeycodeC, 0xB)
+  , (SDL.KeycodeV, 0xF) ]
+
 main :: IO ()
 main = do
   args <- getArgs  
@@ -28,16 +52,16 @@ startEmulator filepath = do
   chip8State <- initializeChip8State
   chip8State' <- loadGameByFilePath filepath chip8State
 
-  initializeAll
-  window <- createWindow "Chip-8 Emulator" defaultWindow { windowInitialSize = V2 640 320 }
-  renderer <- createRenderer window (-1) defaultRenderer
-  texture <- createTexture renderer RGBA8888 TextureAccessStatic (V2 64 32)  
+  SDL.initializeAll
+  window <- SDL.createWindow "Chip-8 Emulator" SDL.defaultWindow { SDL.windowInitialSize = SDL.V2 640 320 }
+  renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer
+  texture <- SDL.createTexture renderer SDL.RGBA8888 SDL.TextureAccessStatic (SDL.V2 64 32)  
 
   emulatorLoop chip8State' renderer texture
 
-  destroyTexture texture
-  destroyRenderer renderer
-  destroyWindow window
+  SDL.destroyTexture texture
+  SDL.destroyRenderer renderer
+  SDL.destroyWindow window
 
 initializeChip8State :: IO Chip8State
 initializeChip8State = do
@@ -50,28 +74,46 @@ loadGameByFilePath filepath chip8State = do
   let game = BS.unpack contents
   return $ execState (loadGameIntoMemory game) chip8State
 
-emulatorLoop :: Chip8State -> Renderer -> Texture -> IO ()
+emulatorLoop :: Chip8State -> SDL.Renderer -> SDL.Texture -> IO ()
 emulatorLoop chip8State renderer texture = do
   let updatedChip8State = execState emulateCpuCycle chip8State
   updatedTexture <- drawGraphicsIfApplicable updatedChip8State renderer texture
-  threadDelay 1200
 
-  events <- pollEvents
+  events <- SDL.pollEvents
   let userHasQuit = any isQuitEvent events
+      keyPressChanges = getKeyPressChanges events
+      chip8StateWithKeyPresses = execState (storeKeyPressChanges keyPressChanges) updatedChip8State
+
+  threadDelay 1200
+
+  unless userHasQuit (emulatorLoop chip8StateWithKeyPresses renderer updatedTexture)
+
+getKeyPressChanges :: [SDL.Event] -> [(Int, KeyPressState)]
+getKeyPressChanges = catMaybes . map getMappingAndKeyPressState 
 
-  unless userHasQuit (emulatorLoop updatedChip8State renderer updatedTexture)
+getMappingAndKeyPressState :: SDL.Event -> Maybe (Int, KeyPressState)
+getMappingAndKeyPressState event = 
+  case SDL.eventPayload event of
+    SDL.KeyboardEvent keyboardEvent -> do
+      case M.lookup (SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent)) chip8KeyMapping of
+        Just keyMapping -> 
+          case SDL.keyboardEventKeyMotion keyboardEvent of
+            SDL.Pressed -> Just (keyMapping, Pressed)
+            SDL.Released -> Just (keyMapping, Released)
+        Nothing -> Nothing
+    _ -> Nothing 
 
-isQuitEvent :: Event -> Bool
-isQuitEvent event = eventPayload event == QuitEvent
+isQuitEvent :: SDL.Event -> Bool
+isQuitEvent event = SDL.eventPayload event == SDL.QuitEvent
 
-drawGraphicsIfApplicable :: Chip8State -> Renderer -> Texture -> IO Texture
+drawGraphicsIfApplicable :: Chip8State -> SDL.Renderer -> SDL.Texture -> IO SDL.Texture
 drawGraphicsIfApplicable chip8State renderer texture =
   if (chip8State^.drawFlag) then drawGraphics chip8State renderer texture else return texture
 
-drawGraphics :: Chip8State -> Renderer -> Texture -> IO Texture
+drawGraphics :: Chip8State -> SDL.Renderer -> SDL.Texture -> IO SDL.Texture
 drawGraphics chip8State renderer texture = do
   let pixels = evalState getGraphicsAsByteString chip8State
-  updatedTexture <- updateTexture texture Nothing pixels (256 :: CInt)
-  copy renderer updatedTexture Nothing Nothing
-  present renderer
+  updatedTexture <- SDL.updateTexture texture Nothing pixels (256 :: CInt)
+  SDL.copy renderer updatedTexture Nothing Nothing
+  SDL.present renderer
   return updatedTexture
diff --git a/lazy-chip8.cabal b/lazy-chip8.cabal
@@ -49,7 +49,9 @@ executable lazy-chip8
     bytestring,
     mtl,
     random,
-    lens
+    lens,
+    hashable,
+    unordered-containers
 
 test-suite hspec
     build-depends: base, 

diff --git a/src/Chip8.hs b/src/Chip8.hs
@@ -3,7 +3,8 @@ module Chip8
   initializeChip8,
   loadFontsetIntoMemory,
   loadGameIntoMemory,
-  getGraphicsAsByteString
+  getGraphicsAsByteString,
+  storeKeyPressChanges
 ) where
 
 import System.Random
@@ -51,3 +52,8 @@ getGraphicsAsByteString = do
       rgbaFormatGraphics = flatten $ map (\pixelState -> if pixelState == 1 then white else black) chip8Graphics
       graphicsByteString = BS.pack rgbaFormatGraphics
   return graphicsByteString
+
+storeKeyPressChanges :: [(Int, KeyPressState)] -> Chip8 ()
+storeKeyPressChanges keyPressChanges = do
+  let loadKeyPressChanges = flip V.update $ V.fromList keyPressChanges
+  modify (\givenState -> givenState & keyState %~ loadKeyPressChanges)
diff --git a/src/Constants.hs b/src/Constants.hs
@@ -29,7 +29,7 @@ chip8InitialState = Chip8State {
   _soundTimer = 0x00,
   _stack = V.replicate 16 0x00,
   _stackPointer = 0x0000,
-  _keyState = V.replicate 16 Unpressed,
+  _keyState = V.replicate 16 Released,
   _drawFlag = False,
   _randomNumberSeed = mkStdGen 0
 }

diff --git a/src/Opcodes/KeyOps.hs b/src/Opcodes/KeyOps.hs
@@ -36,7 +36,7 @@ keyIsNotPressed = do
   registerXValue <- getRegisterXValue
   let key = fromIntegral registerXValue :: Int
       keyValue = (chip8State^.keyState) V.! key
-  if keyValue == Unpressed then skipNextInstruction else incrementProgramCounter
+  if keyValue == Released then skipNextInstruction else incrementProgramCounter
 
 {-
   0xFX0A

diff --git a/src/Types.hs b/src/Types.hs
@@ -27,7 +27,7 @@ import Control.Lens
 
 data KeyPressState 
   = Pressed 
-  | Unpressed
+  | Released
   deriving (Eq, Show)
 
 data Chip8State = Chip8State {

diff --git a/test/Chip8Spec.hs b/test/Chip8Spec.hs
@@ -57,4 +57,30 @@ spec = do
         [0x0, 0x0, 0x0, 0x0, 0xFF, 0xFF, 0xFF, 0xFF, 0x0, 0x0, 0x0, 0x0, 0xFF, 0xFF, 0xFF, 0xFF]
 
       endingByteSlice `shouldMatchList`
-        [0xFF, 0xFF, 0xFF, 0xFF, 0x0, 0x0, 0x0, 0x0, 0xFF, 0xFF, 0xFF, 0xFF, 0x0, 0x0, 0x0, 0x0]
+        [0xFF, 0xFF, 0xFF, 0xFF, 0x0, 0x0, 0x0, 0x0, 0xFF, 0xFF, 0xFF, 0xFF, 0x0, 0x0, 0x0, 0x0]
+
+  describe "storeKeyPressChanges" $ do
+    it "stores key press changes" $ do
+      let chip8State = chip8InitialState {
+        _keyState = V.update (chip8InitialState^.keyState) $ V.fromList [(0x3, Pressed),(0x7, Pressed)]
+      }
+          keyPressChanges = [(0x0, Pressed), (0x3, Released), (0xC, Pressed), (0xF, Pressed)]
+          resultingState = execState (storeKeyPressChanges keyPressChanges) chip8State
+
+      (V.toList $ resultingState^.keyState) `shouldMatchList` 
+        [ Pressed
+        , Released
+        , Released
+        , Released
+        , Released
+        , Released
+        , Released
+        , Pressed
+        , Released
+        , Released
+        , Released
+        , Released
+        , Pressed
+        , Released
+        , Released
+        , Pressed ]
diff --git a/test/Opcodes/KeyOpsSpec.hs b/test/Opcodes/KeyOpsSpec.hs
@@ -35,7 +35,7 @@ spec = do
       let initialState = chip8InitialState {
         _currentOpcode = 0xE59E,
         _vRegisters = V.update originalVRegisters $ V.fromList [(0x5, 0xA)],
-        _keyState = V.update originalKeyState $ V.fromList [(0xA, Unpressed)],
+        _keyState = V.update originalKeyState $ V.fromList [(0xA, Released)],
         _programCounter = 0x250
       }
 
@@ -53,7 +53,7 @@ spec = do
       let initialState = chip8InitialState {
         _currentOpcode = 0xE7A1,
         _vRegisters = V.update originalVRegisters $ V.fromList [(0x7, 0x1)],
-        _keyState = V.update originalKeyState $ V.fromList [(0x1, Unpressed)],
+        _keyState = V.update originalKeyState $ V.fromList [(0x1, Released)],
         _programCounter = 0x220
       }