1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
module Fig.Emulator.GB where
import Fig.Prelude
import System.IO (withFile, IOMode (WriteMode))
import Control.Lens ((.=), use)
import Control.Monad (when)
import Control.Monad.State.Strict (StateT(..))
import qualified SDL
import Fig.Emulator.GB.CPU
import Fig.Emulator.GB.CPU.Instruction
import Fig.Emulator.GB.Bus (Bus(..), Addr(..))
import Fig.Emulator.GB.Component.RAM
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) => Maybe Handle -> ByteString -> Framebuffer -> CPU m
cpuDMG serial rom fb = CPU
{ _lastPC = 0x0
, _lastIns = Nop
, _running = True
, _regs = initialRegs
, _bus = Bus
[ compROM rom
, compWRAM 0xc000 $ 8 * 1024
, compVideo fb
, compJoystick
, compSerial serial
, compInterrupt
, compWRAM 0xff80 0x7e -- HRAM
]
}
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
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 ()
pc <- use $ regs . regPC
ins <- decode
when (pc == 0x2817) do
log $ mconcat
[ pretty $ Addr pc
, ": ", tshow ins
]
step ins
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
loop 0
|
