[warning] ⚠️ broken commit of background manipulation

example/Main.hs

@@ -1,17 +1,28 @@
 module Main where
 
-import qualified Data.Text.Lazy.IO  as T
+import           Data.Matrix
+import qualified Data.Text.Lazy.IO   as T
 import           Data.Word
 import           Lazyboy
+import           Lazyboy.IO.Graphics
 import           Lazyboy.Prelude
 import           Lazyboy.Target.ASM
-import           Prelude            hiding ((&&), (/=), (<), (==), (>), (||))
+import           Prelude             hiding ((&&), (/=), (<), (==), (>), (||))
 
+-- [TODO] it seems like the registers get overwritten and break the control flow in this program
+-- to fix that, let's make use of the stack to store state before we make any changes
+-- see here: http://gameboy.mongenel.com/dmg/lesson1.html (search: STACK)
 main :: IO ()
 main = rom >>= T.putStrLn
     where rom = compileROM $ do
-            byte A 0xDE
-            byte B 0xDE
-            if' ((A == (0xDE :: Word8)) && (A == B)) $ do
-                write (Address wram0) 0xDE
+            let tilemap = matrix 32 32 $ \_ -> 1
+            let sprite = [0x00,0x00,0x00,0x00,0x24,0x24,0x00,0x00,0x81,0x81,0x7e,0x7e,0x00,0x00,0x00,0x00]
+            sprite' <- embedBytes sprite
+            setScroll (0, 0)
+            setBackgroundPalette defaultPalette
+            onVblank $ do
+                disableLCD
+                memcpy (Name sprite') (Address $ 0x9010) $ fromIntegral $ length sprite 
+                updateTilemap tilemap
+                setLCDControl $ defaultLCDControl { lcdDisplayEnable = True, lcdBackgroundEnable = True }
             freeze

lazyboy.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 34f0bae356e4c05dfe779d5d3aff89364296c81fed4ff98ee78c7c270671d92d
+-- hash: 40ed3a8c4154cea848dce54c8ed9103dcecbe85b39d4e4716a55d48a59198782
 
 name:           lazyboy
 version:        0.2.2.1
@@ -31,6 +31,7 @@ source-repository head
 
 library
   exposed-modules:
+      Data.Bits.Extra
       Lazyboy
       Lazyboy.Constants
       Lazyboy.Control

src/Data/Bits/Extra.hs

@@ -0,0 +1,20 @@
+{-|
+    Module      : Data.Bits.Extra
+    Description : Additional bitwise functions used by Lazyboy
+    Copyright   : (c) Rose 2019
+    License     : BSD3
+    Maintainer  : rose@lain.org.uk
+    Stability   : experimental
+    Portability : POSIX
+
+    This module extends Data.Bits with additional functionality.
+-}
+
+module Data.Bits.Extra where
+
+import           Data.Bits
+import           Data.Word
+
+-- | Split a 16 bit integer into its two 8 bit component parts.
+split :: Word16 -> (Word8, Word8)
+split n = (fromIntegral $ n `shiftR` 8, fromIntegral $ n .&. 0x00FF)

src/Lazyboy/IO/Graphics.hs

@@ -13,13 +13,19 @@
 module Lazyboy.IO.Graphics where
 
 import           Control.Exception
+import           Control.Monad.Trans.RWS.Lazy
+import           Data.Bits
+import           Data.Bits.Extra
 import           Data.Matrix
 import           Data.Word
-import qualified Lazyboy.Constants as GB
+import qualified Lazyboy.Constants            as GB
+import           Lazyboy.Control
 import           Lazyboy.IO
+import           Lazyboy.Prelude              ((/=), (==))
 import           Lazyboy.Types
+import           Prelude                      hiding (and, or, (/=), (==))
 import           Text.Printf
-import           Type.Reflection   (Typeable)
+import           Type.Reflection              (Typeable)
 
 -- | Type alias that represents a tile map as a Matrix.
 type Tilemap = Matrix Integer
@@ -34,13 +40,33 @@ instance (Show a) => Show (GraphicsException a) where
 -- | An instance of Exception for the exceptional type.
 instance (Show a, Typeable a) => Exception (GraphicsException a) where
 
--- [TODO] make this use a loop
 -- | Update the whole background tilemap.
 updateTilemap :: Tilemap -> Lazyboy ()
 updateTilemap tiles = do
-    mapM_ (\(ix, tile) -> setTileAtIndex ix tile) addressed
-    where addressed = zip [0..] flat
-          flat = toList tiles
+    content <- getLocalLabel
+
+    -- embed the tile data in the ROM
+    content <- embedBytes bytes
+    -- zero BC out for use as a counter
+    tell [LDrn B 0, LDrn C 0]
+    -- load the start of the background region into HL
+    tell [LDrrnn HL $ Address GB.background]
+    -- point DE to the start of the tile data
+    tell [LDrrnn DE $ Name content]
+
+    while ((B /= high) `or` (C /= low)) $ do
+        tell [LDArr DE]
+        tell [LDHLAI]
+        inc DE
+        inc BC
+
+    where bytes = map fromIntegral $ toList tiles
+          (high, low) = split count
+          count = fromIntegral $ length tiles - 1
+
+unsafeSetTileFromRegisters :: Register16 -> Register8 -> Lazyboy ()
+unsafeSetTileFromRegisters offset tile = do
+    tell [ADDHLrr DE]
 
 -- | Write a Tile ID to the nth background tile.
 setTileAtIndex :: Integer -> Integer -> Lazyboy ()
@@ -61,3 +87,16 @@ setTile x y tile
     where address = Address $ GB.background + (32 * fromIntegral x + fromIntegral y)
           (minXY, maxXY) = (0, 31)
           (minTile, maxTile) = (0, 191)
+
+-- | Set the X scroll co-ordinate.
+setScrollX :: Word8 -> Lazyboy ()
+setScrollX x = write (Address GB.scx) x
+
+setScrollY :: Word8 -> Lazyboy ()
+setScrollY y = write (Address GB.scy) y
+
+-- | Set the X and Y scroll co-ordinates.
+setScroll :: (Word8, Word8) -> Lazyboy ()
+setScroll (x, y) = do
+    setScrollX x
+    setScrollY y

src/Lazyboy/Types.hs

@@ -167,4 +167,17 @@ data Instruction =
   | INCLUDE FilePath          -- ^ Include the file at FilePath.
   | BYTES [Word8]             -- ^ Define some bytes in the form of a Word8 list with a global label.
 
-  deriving (Eq)
+  deriving (Eq)
+
+-- | A typeclass for providing variable-width integer operations.
+class Lazynum a where
+  dec :: a -> Lazyboy ()
+  inc :: a -> Lazyboy ()
+
+instance Lazynum Register8 where
+  dec r8 = tell [DECr r8]
+  inc r8 = tell [INCr r8]
+
+instance Lazynum Register16 where
+  dec r16 = tell [DECrr r16]
+  inc r16 = tell [INCrr r16]