From a81c92dc2cdff02c55fdc197d943bc7a35c64be5 Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Tue, 7 May 2024 14:21:13 -0400
Subject: fig-emulator-gb: Fix space leak

---
 fig-emulator-gb/src/Fig/Emulator/GB.hs | 57 +++++++++++++++++++---------------
 1 file changed, 32 insertions(+), 25 deletions(-)

(limited to 'fig-emulator-gb/src/Fig/Emulator/GB.hs')

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
-- 
cgit v1.2.3