From 9d875ab8fb539246e3aea0aae58d2c9f227c8276 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Wed, 17 Apr 2024 22:45:19 -0400 Subject: Some basic emulator graphics --- fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs | 152 ++++++++++++++--------------- 1 file changed, 74 insertions(+), 78 deletions(-) (limited to 'fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs') diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs b/fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs index 33c4ac3..40fd6c8 100644 --- a/fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs +++ b/fig-emulator-gb/src/Fig/Emulator/GB/CPU.hs @@ -1,30 +1,34 @@ {-# Language TemplateHaskell, ImplicitParams #-} -module Fig.Emulator.GB.CPU where +module Fig.Emulator.GB.CPU + ( CPU(..) + , Registers(..), initialRegs + , Emulating + , running, regs, bus, regPC + , updateComps + , decode + , step + , logCPUState + ) where import Control.Lens.TH (makeLenses) +import Data.Maybe (fromJust) + import Fig.Prelude import Prelude (fromIntegral) -import System.IO (withFile, IOMode (WriteMode)) - import qualified Text.Printf as Pr import Control.Lens ((.=), use, (^.)) -import Control.Monad (when, unless) -import Control.Monad.State (StateT(..)) +import Control.Monad (when) import Data.Word (Word8, Word16) +import Data.Int (Int8) import Data.Bits -import qualified SDL - import Fig.Emulator.GB.Utils import Fig.Emulator.GB.Bus (Bus(..), Addr(..)) import qualified Fig.Emulator.GB.Bus as Bus -import Fig.Emulator.GB.Component.RAM -import Fig.Emulator.GB.Component.ROM -import Fig.Emulator.GB.Component.Video import Fig.Emulator.GB.CPU.Instruction newtype CPUError = CPUError Text @@ -65,6 +69,7 @@ initialRegs = Registers data CPU m = CPU { _lastPC :: !Word16 , _lastIns :: !Instruction + , _running :: !Bool , _regs :: !Registers , _bus :: !(Bus m) } @@ -73,27 +78,15 @@ makeLenses 'CPU type EmulatingT f m = (MonadIO m, MonadThrow m, MonadState (CPU f) m, ?log :: Handle) type Emulating m = EmulatingT IO m -cpuDMG :: (MonadIO m, MonadThrow m) => ByteString -> CPU m -cpuDMG rom = CPU - { _lastPC = 0x0 - , _lastIns = Nop - , _regs = initialRegs - , _bus = Bus - [ compROM rom - , compWRAM 0x8000 $ 8 * 1024 -- vram placeholder - , compWRAM 0xc000 $ 8 * 1024 - , compLCD - ] - } - logCPUState :: Emulating m => m () logCPUState = do rs <- use regs let pc = rs ^. regPC - m0 <- read8 $ Addr pc - m1 <- read8 $ Addr pc + 1 - m2 <- read8 $ Addr pc + 2 - m3 <- read8 $ Addr pc + 3 + b <- use bus + m0 <- fromJust <$> liftIO (Bus.read b $ Addr pc) + m1 <- fromJust <$> liftIO (Bus.read b $ Addr pc + 1) + m2 <- fromJust <$> liftIO (Bus.read b $ Addr pc + 2) + m3 <- fromJust <$> liftIO (Bus.read b $ Addr pc + 3) liftIO . hPutStrLn ?log $ mconcat [ "A:", rreg8 $ rs ^. regA , " F:", rreg8 $ flagsw8 (rs ^. regFlagZ) (rs ^. regFlagN) (rs ^. regFlagH) (rs ^. regFlagC) @@ -111,8 +104,15 @@ logCPUState = do rreg8 = pack . Pr.printf "%02X" rreg16 = pack . Pr.printf "%04X" +updateComps :: Emulating m => Int -> m () +updateComps t = do + b <- use bus + b' <- liftIO $ Bus.update t b + bus .= b' + decode :: Emulating m => m Instruction decode = do + updateComps 4 b <- use bus pc <- use $ regs . regPC lastPC .= pc @@ -129,6 +129,7 @@ cond CondC = use (regs . regFlagC) read8 :: Emulating m => Addr -> m Word8 read8 a = do + updateComps 4 b <- use bus pc <- use lastPC ins <- use lastIns @@ -152,6 +153,7 @@ read16 a = do write8 :: Emulating m => Addr -> Word8 -> m () write8 a v = do + updateComps 4 b <- use bus b' <- liftIO $ Bus.write b a v bus .= b' @@ -239,22 +241,6 @@ r16Mem R16MemHLMinus = do setR16 R16HL $ hl - 1 pure hl -renderTile :: Emulating m => SDL.Renderer -> Addr -> Int -> Int -> m () -renderTile renderer a bx by = do - (ps :: [(Int, Int, Word8)]) <- mconcat <$> forM [0..8] \y -> do - mconcat <$> forM [0 .. 1] \x -> do - b <- read8 $ a + Addr (y * 2 + x) - pure - [ (bx + fromIntegral x, by + fromIntegral y, w8bits2 7 b) - , (bx + fromIntegral x, by + fromIntegral y, w8bits2 5 b) - , (bx + fromIntegral x, by + fromIntegral y, w8bits2 3 b) - , (bx + fromIntegral x, by + fromIntegral y, w8bits2 1 b) - ] - SDL.rendererDrawColor renderer SDL.$= SDL.V4 0 0 0 255 - forM_ ps \(x, y, p) -> do - unless (p == 0) do - SDL.drawPoint renderer . SDL.P $ SDL.V2 (fromIntegral x) (fromIntegral y) - step :: forall m. Emulating m => Instruction -> m () step ins = do let @@ -571,11 +557,51 @@ step ins = do CbRlcR8 _ -> unimplemented CbRrcR8 _ -> unimplemented CbRlR8 _ -> unimplemented - CbRrR8 _ -> unimplemented - CbSlaR8 _ -> unimplemented - CbSraR8 _ -> unimplemented - CbSwapR8 _ -> unimplemented - CbSrlR8 _ -> unimplemented + CbRrR8 r -> do + v <- r8 r + c <- use $ regs . regFlagC + regs . regFlagH .= False + regs . regFlagZ .= False + regs . regFlagN .= False + regs . regFlagC .= w8bit 0 v + setR8 R8A $ rotateR v 1 .|. if c then 0b10000000 else 0 + CbSlaR8 r -> do + v <- r8 r + let res = shiftL v 1 + regs . regFlagZ .= (res == 0) + regs . regFlagH .= False + regs . regFlagN .= False + regs . regFlagC .= w8bit 7 v + setR8 R8A res + CbSraR8 r -> do + v <- r8 r + let + vs :: Int8 + vs = fromIntegral v + ress = shiftR vs 1 + res :: Word8 + res = fromIntegral ress + regs . regFlagZ .= (res == 0) + regs . regFlagH .= False + regs . regFlagN .= False + regs . regFlagC .= w8bit 0 v + setR8 R8A res + CbSwapR8 r -> do + v <- r8 r + let res = rotate v 4 + regs . regFlagZ .= (res == 0) + regs . regFlagH .= False + regs . regFlagN .= False + regs . regFlagC .= False + setR8 R8A res + CbSrlR8 r -> do + v <- r8 r + let res = shiftR v 1 + regs . regFlagZ .= (res == 0) + regs . regFlagH .= False + regs . regFlagN .= False + regs . regFlagC .= w8bit 0 v + setR8 R8A res CbBitB3R8 _ _ -> unimplemented CbResB3R8 _ _ -> unimplemented CbSetB3R8 _ _ -> unimplemented @@ -589,33 +615,3 @@ step ins = do , "): " , tshow ins ] - -testRun :: forall m. (MonadIO m, MonadThrow m) => ByteString -> m () -testRun rom = do - SDL.initializeAll - window <- SDL.createWindow "taking" SDL.defaultWindow - renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer - let cpu = cpuDMG rom - let - loop :: forall m'. Emulating m' => Int -> m' () - loop cycle = do - -- pc <- use $ regs . regPC - ins <- decode - -- log $ mconcat - -- [ pretty $ Addr pc - -- , ": ", tshow ins - -- ] - step ins - -- logCPUState - when (rem cycle 70224 == 0) do - SDL.rendererDrawColor renderer SDL.$= SDL.V4 255 255 255 255 - SDL.clear renderer - forM_ ([0..255] :: [Int]) \i -> do - renderTile renderer (Addr . fromIntegral $ 0x8000 + i * 16) 0 0 - SDL.present renderer - loop $ cycle + 1 - liftIO $ withFile "log.txt" WriteMode \h -> do - let ?log = h - void $ flip runStateT cpu do - -- logCPUState - loop 0 -- cgit v1.2.3