summaryrefslogtreecommitdiff
path: root/fig-emulator-gb/src/Fig/Emulator/GB.hs
diff options
context:
space:
mode:
Diffstat (limited to 'fig-emulator-gb/src/Fig/Emulator/GB.hs')
-rw-r--r--fig-emulator-gb/src/Fig/Emulator/GB.hs57
1 files changed, 32 insertions, 25 deletions
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB.hs b/fig-emulator-gb/src/Fig/Emulator/GB.hs
index 76e6c85..6f32682 100644
--- a/fig-emulator-gb/src/Fig/Emulator/GB.hs
+++ b/fig-emulator-gb/src/Fig/Emulator/GB.hs
@@ -6,7 +6,7 @@ import System.IO (withFile, IOMode (WriteMode))
import Control.Lens ((.=), use)
import Control.Monad (when)
-import Control.Monad.State (StateT(..))
+import Control.Monad.State.Strict (StateT(..))
import qualified SDL
@@ -18,9 +18,10 @@ import Fig.Emulator.GB.Component.ROM
import Fig.Emulator.GB.Component.Video
import Fig.Emulator.GB.Component.Joystick
import Fig.Emulator.GB.Component.Serial
+import Fig.Emulator.GB.Component.Interrupt (compInterrupt)
-cpuDMG :: (MonadIO m, MonadThrow m) => Handle -> ByteString -> Framebuffer -> CPU m
-cpuDMG h rom fb = CPU
+cpuDMG :: (MonadIO m, MonadThrow m) => Maybe Handle -> ByteString -> Framebuffer -> CPU m
+cpuDMG serial rom fb = CPU
{ _lastPC = 0x0
, _lastIns = Nop
, _running = True
@@ -30,26 +31,30 @@ cpuDMG h rom fb = CPU
, compWRAM 0xc000 $ 8 * 1024
, compVideo fb
, compJoystick
- , compSerial h
+ , compSerial serial
+ , compInterrupt
, compWRAM 0xff80 0x7e -- HRAM
]
}
-testRun :: forall m. (MonadIO m, MonadThrow m) => FilePath -> ByteString -> m ()
+testRun :: forall m. (MonadIO m, MonadThrow m) => Maybe FilePath -> ByteString -> m ()
testRun serialOut rom = do
SDL.initializeAll
window <- SDL.createWindow "taking" SDL.defaultWindow
fb <- initializeFramebuffer
- liftIO $ withFile serialOut WriteMode \hserial -> do
+ let withSerial f = case serialOut of
+ Nothing -> f Nothing
+ Just p -> withFile p WriteMode $ f . Just
+ liftIO $ withSerial \hserial -> do
let cpu = cpuDMG hserial rom fb
let
loop :: forall m'. Emulating m' => Int -> m' ()
loop cycle = do
- events <- SDL.pollEvents
- forM_ events \ev ->
- case SDL.eventPayload ev of
- SDL.QuitEvent -> running .= False
- _else -> pure ()
+ -- events <- SDL.pollEvents
+ -- forM_ events \ev ->
+ -- case SDL.eventPayload ev of
+ -- SDL.QuitEvent -> running .= False
+ -- _else -> pure ()
pc <- use $ regs . regPC
ins <- decode
when (pc == 0x2817) do
@@ -58,20 +63,22 @@ testRun serialOut rom = do
, ": ", tshow ins
]
step ins
- when (rem cycle 70224 == 0) do
- ws <- SDL.getWindowSurface window
- SDL.surfaceFillRect ws Nothing $ SDL.V4 0x00 0x00 0x00 0xff
- void $
- SDL.surfaceBlitScaled
- (fbSurface fb)
- Nothing
- ws
- (Just $ SDL.Rectangle
- (SDL.P $ SDL.V2 0 0)
- (SDL.V2
- (fromIntegral screenWidth * 8)
- (fromIntegral screenHeight * 8)))
- SDL.updateWindowSurface window
+ when (rem cycle 1000000 == 0) do
+ log "1 million"
+ -- when (rem cycle 70224 == 0) do
+ -- ws <- SDL.getWindowSurface window
+ -- SDL.surfaceFillRect ws Nothing $ SDL.V4 0x00 0x00 0x00 0xff
+ -- void $
+ -- SDL.surfaceBlitScaled
+ -- (fbSurface fb)
+ -- Nothing
+ -- ws
+ -- (Just $ SDL.Rectangle
+ -- (SDL.P $ SDL.V2 0 0)
+ -- (SDL.V2
+ -- (fromIntegral screenWidth * 8)
+ -- (fromIntegral screenHeight * 8)))
+ -- SDL.updateWindowSurface window
r <- use running
when r . loop $ cycle + 1
void $ flip runStateT cpu do