fig-emulator-gb/src/Fig/Emulator/GB/Component/Video.hs


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

module Fig.Emulator.GB.Component.Video where

import Fig.Prelude

import Fig.Emulator.GB.Bus

newtype VideoError = VideoError Text
  deriving Show
instance Exception VideoError
instance Pretty VideoError where
  pretty (VideoError b) = mconcat
    [ "video error: "
    , b
    ]

compLCD :: (MonadIO m, MonadThrow m) => Component m
compLCD = Component
  { compState = ()
  , compMatches = \a -> a >= 0xff40 && a <= 0xff4b
  , compUpdate = pure
  , compWrite = \s _ _ -> pure s
  , compRead = \_ (Addr a) -> do
      let off = a - 0xff40
      case off of
        0x0 -> pure 0x00
        0x1 -> pure 0x00
        0x2 -> pure 0x00
        0x3 -> pure 0x00
        0x4 -> pure 0x00
        0x5 -> pure 0x00
        0x6 -> pure 0x00
        0x7 -> pure 0x00
        0x8 -> pure 0x00
        0x9 -> pure 0x00
        0xa -> pure 0x00
        0xb -> pure 0x00
        _ -> throwM $ VideoError $ mconcat
          [ "address out of bounds for LCD: "
          , pretty $ Addr a
          ]
  }