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
86
87
88
89
90
91
|
module Fig.Emulator.GB where
import Prelude (error)
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 Data.Vector as V
import qualified Data.ByteString as BS
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.Misc
import Fig.Emulator.GB.Component.Interrupt
cpuDMG :: Maybe Handle -> ByteString -> Framebuffer -> CPU
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
, compMisc
, compWRAM 0xff80 0x7e -- HRAM
]
}
testRun :: Maybe FilePath -> ByteString -> IO ()
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 :: Int -> Emulating ()
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 300000 == 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 * 4)
(fromIntegral screenHeight * 4)))
SDL.updateWindowSurface window
r <- use running
when r . loop $ cycle + 1
void $ flip (runStateT . runEmulating) cpu do
loop 0
|
