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
|
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 (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
cpuDMG :: (MonadIO m, MonadThrow m) => Handle -> ByteString -> Framebuffer -> CPU m
cpuDMG h rom fb = CPU
{ _lastPC = 0x0
, _lastIns = Nop
, _running = True
, _regs = initialRegs
, _bus = Bus
[ compROM rom
, compWRAM 0xc000 $ 8 * 1024
, compVideo fb
, compJoystick
, compSerial h
, compWRAM 0xff80 0x7e -- HRAM
]
}
testRun :: forall m. (MonadIO m, MonadThrow m) => FilePath -> ByteString -> m ()
testRun serialOut rom = do
SDL.initializeAll
window <- SDL.createWindow "taking" SDL.defaultWindow
fb <- initializeFramebuffer
liftIO $ withFile serialOut WriteMode \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 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
|
