Get scaled rendering context set up

app-debug/Main.hs

@@ -7,7 +7,7 @@ import Wolf3D.Debug.Display
 
 main :: IO ()
 main = createMain 2 dummyWorld2 $
-  \r s -> do
+  \r -> do
     setupRenderer r
-    d <- loadRenderData r s
+    d <- loadRenderData r
     return (render r d)

app/Main.hs

@@ -7,7 +7,7 @@ import Wolf3D.Debug.Dummy
 
 main :: IO ()
 main = createMain 1 dummyWorld $
-  \r s -> do
+  \r -> do
     setupRenderer r
-    d <- loadRenderData r s
+    d <- loadRenderData r
     return (render r d)

src/Wolf3D/Debug/Data.hs

@@ -5,8 +5,8 @@ import qualified SDL.Font
 import Wolf3D.Debug.Display
 import qualified Wolf3D.Loader as D
 
-loadRenderData :: SDL.Renderer -> (Int, Int) -> IO DebugRenderData
-loadRenderData r s = do
-  d <- D.loadRenderData r s
+loadRenderData :: SDL.Renderer -> IO DebugRenderData
+loadRenderData r = do
+  d <- D.loadRenderData r
   font <- SDL.Font.load "assets/Monospace.ttf" 12
   return (DebugRenderData d font)

src/Wolf3D/Debug/Display.hs

@@ -25,7 +25,7 @@ setupRenderer :: SDL.Renderer -> IO ()
 setupRenderer = D.setupRenderer
 
 render :: SDL.Renderer -> DebugRenderData -> SimRun -> IO ()
-render r drd@(DebugRenderData rd@(D.RenderData {D.areaSize=(width, height)}) _) sr = do
+render r drd@(DebugRenderData rd _) sr = do
   (_, tookTime) <- stopWatch runRender
   let debugText = createDebugText sr (toNanoSecs tookTime `div` 1000000)
   withViewport r (Just (mkSDLRect 0 0 (fromIntegral miniMapWidth) (fromIntegral miniMapHeight))) $
@@ -34,8 +34,8 @@ render r drd@(DebugRenderData rd@(D.RenderData {D.areaSize=(width, height)}) _)
   SDL.present r
   where
     w = simRunWorld sr
-    miniMapWidth = width `div` 3
-    miniMapHeight = height `div` 3
+    miniMapWidth = D.screenWidth `div` 3
+    miniMapHeight = D.screenHeight `div` 3
     runRender = do
       D.renderHud r rd
       D.renderWorld r rd w
@@ -47,12 +47,12 @@ createDebugText sr tookTime = unwords (map (\(l, v) -> l ++ ": " ++ v) items)
     items = [("WT", show (worldTime world `div` 1000) ++ "s"), ("Render", show tookTime ++ "ms")]
 
 drawDebugText :: SDL.Renderer -> DebugRenderData -> String -> IO ()
-drawDebugText r (DebugRenderData (D.RenderData {D.areaSize=(w, h)}) font) text =
-  withViewport r (Just (mkSDLRect 0 0 (fromIntegral w) (fromIntegral h))) $ do
+drawDebugText r (DebugRenderData _ font) text =
+  withViewport r (Just (mkSDLRect 0 0 (fromIntegral D.screenWidth) (fromIntegral D.screenHeight))) $ do
     surface <- SDL.Font.solid font (SDL.V4 255 255 255 255) (pack text)
     (SDL.V2 textW textH) <- SDL.surfaceDimensions surface
     texture <- SDL.createTextureFromSurface r surface
-    let rect = Just (mkSDLRect 0 (fromIntegral (h - fromIntegral textH)) textW textH)
+    let rect = Just (mkSDLRect 0 (fromIntegral (D.screenHeight - fromIntegral textH)) textW textH)
     SDL.rendererDrawColor r $= SDL.V4 0 0 0 122
     SDL.fillRect r rect
     SDL.copy r texture Nothing rect

src/Wolf3D/Display.hs

@@ -4,7 +4,11 @@ module Wolf3D.Display (
   renderWorld,
   renderHud,
   rayLineIntersection,
-  RenderData (RenderData, areaSize)
+  RenderData (RenderData),
+  screenWidth,
+  screenHeight,
+  actionHeight,
+  actionWidth
 ) where
 
 import Wolf3D.Geom
@@ -24,20 +28,60 @@ import Control.Monad (mfilter)
 import Data.Fixed
 import qualified Data.Map as M
 import Foreign.C.Types (CInt)
+import GHC.Word (Word8)
+import Debug.Trace
 
 
 type WallMaterialData = M.Map WallMaterial (SDL.Texture, (Int, Int))
 type EnvItemData = M.Map EnvItemType (SDL.Texture, SDL.Rectangle CInt)
 type WeaponData = M.Map String Animation
-data RenderData = RenderData { areaSize :: (Int, Int)
-                             , actionArea :: IntRectangle
-                             , halfActionSize :: (Int, Int)
-                             , distToProjPlane :: Double
-                             , wallTextures :: WallMaterialData
+data RenderData = RenderData {wallTextures :: WallMaterialData
                              , itemTextures :: EnvItemData
                              , weaponTextures :: WeaponData
                              , hudPlaceholder :: (SDL.Texture, SDL.Rectangle CInt)}
 
+screenWidth :: Int
+screenWidth = 320
+
+screenHeight :: Int
+screenHeight = 200
+
+hudBorderTop :: (Int, Int)
+hudBorderTop = (8, 4)
+
+hudBarHeight :: Int
+hudBarHeight = 40
+
+actionWidth :: Int
+actionWidth = screenWidth - 2 * (fst hudBorderTop)
+
+actionHeight :: Int
+actionHeight = screenHeight - 2 * (snd hudBorderTop) - hudBarHeight
+
+actionAreaY :: CInt
+actionAreaY = fromIntegral (snd hudBorderTop)
+
+actionAreaX :: CInt
+actionAreaX = fromIntegral (fst hudBorderTop)
+
+actionArea :: IntRectangle
+actionArea = IntRectangle hudBorderTop (actionWidth, actionHeight)
+
+--halfActionWidth :: Int
+--halfActionWidth = actionWidth `div` 2
+
+halfActionHeight :: CInt
+halfActionHeight = traceShow (actionHeight `div` 2) (fromIntegral (actionHeight `div` 2))
+
+distToProjPlane :: Double
+distToProjPlane = fromIntegral (actionWidth `div` 2) / (tan (pi / 6))
+
+ceilingColor :: SDL.V4 Word8
+ceilingColor = SDL.V4 1 84 88 255
+
+floorColor :: SDL.V4 Word8
+floorColor = SDL.V4 112 112 112 255
+
 setupRenderer :: SDL.Renderer -> IO ()
 setupRenderer r = SDL.rendererDrawBlendMode r $= SDL.BlendAlphaBlend
 
@@ -48,10 +92,10 @@ render r d s = do
   SDL.present r
 
 renderHud :: SDL.Renderer -> RenderData -> IO ()
-renderHud r (RenderData {areaSize=(width, height), hudPlaceholder=(texture, sourceRect)}) = do
+renderHud r (RenderData {hudPlaceholder=(texture, sourceRect)}) = do
   SDL.copy r texture (Just sourceRect) (Just destRect)
   where
-    destRect = SDL.Rectangle (SDL.P (SDL.V2 0 0)) (SDL.V2 (fromIntegral width) (fromIntegral height))
+    destRect = SDL.Rectangle (SDL.P (SDL.V2 0 0)) (SDL.V2 (fromIntegral screenWidth) (fromIntegral screenHeight))
 
 renderWorld :: SDL.Renderer -> RenderData -> World Wolf3DSimEntity -> IO ()
 renderWorld r d w = do
@@ -61,32 +105,32 @@ renderWorld r d w = do
   renderWeapon r d (worldTime w) (worldHeroWeapon w)
 
 renderCeilingAndFloor :: SDL.Renderer -> RenderData -> IO ()
-renderCeilingAndFloor r RenderData {actionArea=(IntRectangle (x, y) (width, _)), halfActionSize=(_, halfH)} = do
-  SDL.rendererDrawColor r $= SDL.V4 1 84 88 255
-  SDL.fillRect r (Just (mkSDLRect (fromIntegral x) (fromIntegral y) cWidth cHalfH))
-  SDL.rendererDrawColor r $= SDL.V4 112 112 112 255
-  SDL.fillRect r (Just (mkSDLRect (fromIntegral x) cHalfH cWidth cHalfH))
+renderCeilingAndFloor r _ = do
+  SDL.rendererDrawColor r $= ceilingColor
+  SDL.fillRect r (Just (mkSDLRect x actionAreaY cWidth halfActionHeight))
+  SDL.rendererDrawColor r $= floorColor
+  SDL.fillRect r (Just (mkSDLRect x (actionAreaY + halfActionHeight) cWidth halfActionHeight))
   where
-    cHalfH = fromIntegral halfH
-    cWidth = fromIntegral width
+    cWidth = fromIntegral actionWidth
+    x = fromIntegral (intRectX actionArea)
 
 renderWalls :: SDL.Renderer -> RenderData -> World Wolf3DSimEntity -> IO ()
-renderWalls r d@RenderData {actionArea=(IntRectangle _ (width, _))} w = forM_ hits (renderWallLine r d)
-  where hits = pixelWallHits w width
+renderWalls r d w = forM_ hits (renderWallLine r d)
+  where hits = pixelWallHits w actionWidth
 
 renderWallLine :: SDL.Renderer -> RenderData -> (Int, WallHit, Double) -> IO ()
-renderWallLine r (RenderData {actionArea=(IntRectangle a@(areaX, areaY) _), halfActionSize=(_, halfHeight), distToProjPlane=d, wallTextures=wt}) (x, WallHit (Wall o _ m) hit _, distance) = do
-  copyWithActionOffset r a texture sourceRect destRect
+renderWallLine r (RenderData {wallTextures=wt}) (x, WallHit (Wall o _ m) hit _, distance) = do
+  copyWithActionOffset r (intRectPos actionArea) texture sourceRect destRect
   SDL.rendererDrawColor r $= SDL.V4 0 0 0 darknessAlpha
   SDL.drawLine r from to
   where
     (texture, (textureWidth, textureHeight)) = fromJust (M.lookup m wt)
     hitWallX = vectorDist hit o
     hitWallTextureRatio = hitWallX `mod'` wallHeight / wallHeight
-    ratio = d / distance
-    projectedTop = round (fromIntegral halfHeight - (ratio * (wallHeight - heroHeight)))
+    ratio = distToProjPlane / distance
+    projectedTop = round (fromIntegral halfActionHeight - (ratio * (wallHeight - heroHeight)))
     projectedHeight = round (ratio * wallHeight)
-    from = SDL.P (SDL.V2 (fromIntegral (x + areaX)) (fromIntegral (projectedTop + (fromIntegral areaY))))
+    from = SDL.P (SDL.V2 (fromIntegral (x + (intRectX actionArea))) (fromIntegral (projectedTop + (fromIntegral (intRectY actionArea)))))
     to = SDL.P (SDL.V2 (fromIntegral x) (projectedTop + projectedHeight))
     darknessMultiplier = 8000
     intensity = 1 - min 1 ((1 / distance) * darknessMultiplier)
@@ -151,8 +195,8 @@ renderItem r d@RenderData {itemTextures=it} hero i@(EnvItem t itemPos) =
     texture = fromJust (M.lookup t it)
 
 renderSprite :: SDL.Renderer -> RenderData -> (SDL.Texture, SDL.Rectangle CInt) -> Hero -> Vector2 -> Vector2 -> IO ()
-renderSprite r RenderData {actionArea=(IntRectangle a (width, _)), halfActionSize=(_, halfHeight), distToProjPlane=d} (texture, sourceRect) hero oPos oSize =
-  copyWithActionOffset r a texture sourceRect destRect
+renderSprite r _ (texture, sourceRect) hero oPos oSize =
+  copyWithActionOffset r (intRectPos actionArea) texture sourceRect destRect
   --SDL.rendererDrawColor r $= SDL.V4 255 0 0 50
   --SDL.fillRect r (Just destRect)
   where
@@ -165,19 +209,19 @@ renderSprite r RenderData {actionArea=(IntRectangle a (width, _)), halfActionSiz
 
     distance = vectorDist heroPos oPos
     -- TODO: Not sure of correct way to handle when 0 distance
-    ratio = d / max 0.01 distance
-    projectedTop = round (fromIntegral halfHeight - (ratio * (itemHeight - heroHeight)))
+    ratio = distToProjPlane / max 0.01 distance
+    projectedTop = round (fromIntegral halfActionHeight - (ratio * (itemHeight - heroHeight)))
     projectedHeight = round (ratio * itemHeight)
     projectedWidth = ratio * v2x oSize
-    x = round ((fromIntegral width * angleRatio) - (projectedWidth / 2))
+    x = round ((fromIntegral actionWidth * angleRatio) - (projectedWidth / 2))
     destRect = mkSDLRect x projectedTop (round projectedWidth) projectedHeight
 
 perpendicularDistance :: Double -> WallHit -> Double
 perpendicularDistance rayRotation (WallHit _ _ d) = d * cos rayRotation
 
 renderWeapon :: SDL.Renderer -> RenderData -> WorldTime -> Weapon -> IO ()
-renderWeapon r RenderData {actionArea=(IntRectangle a (width, height)), weaponTextures=wt} t w =
-  copyWithActionOffset r a texture sourceRect destRect
+renderWeapon r RenderData {weaponTextures=wt} t w =
+  copyWithActionOffset r (intRectPos actionArea) texture sourceRect destRect
   where
     totalAnimationTime = 400
     sinceUsed = fmap (t -) (lastTimeWeaponUsed w)
@@ -186,4 +230,6 @@ renderWeapon r RenderData {actionArea=(IntRectangle a (width, height)), weaponTe
     animation = fromJust (M.lookup "Pistol" wt)
     texture = animationTexture animation
     sourceRect@(SDL.Rectangle _ (SDL.V2 tW tH)) = getAnimationFrame animation progress
-    destRect = mkSDLRect (fromIntegral (width - fromIntegral tW) `div` 2) (fromIntegral (height - fromIntegral tH)) tW tH
+    destX = actionAreaX + (fromIntegral (actionWidth - fromIntegral tW) `div` 2)
+    destY = actionAreaY + (fromIntegral (actionHeight - fromIntegral tH))
+    destRect = mkSDLRect destX destY tW tH

src/Wolf3D/Geom.hs

@@ -3,6 +3,9 @@ module Wolf3D.Geom (
   Rectangle (Rectangle),
   IntRectangle (IntRectangle),
   Line,
+  intRectPos,
+  intRectX,
+  intRectY,
   createRay,
   rayOrigin,
   rayDirection,
@@ -40,6 +43,15 @@ data Ray = Ray Vector2 Vector2
 --createAngleFromCentre centre size = Angle (rotateRay centre (-halfSize)) (rotateRay centre halfSize) size
 --  where halfSize = size / 2
 
+intRectX :: IntRectangle -> Int
+intRectX (IntRectangle (x, _) _) = x
+
+intRectY :: IntRectangle -> Int
+intRectY (IntRectangle (_, y) _) = y
+
+intRectPos :: IntRectangle -> (Int, Int)
+intRectPos (IntRectangle pos _) = pos
+
 createRay :: Vector2 -> Vector2 -> Ray
 createRay p m
   | vmag m > 0 = Ray p (vnormalise m)

src/Wolf3D/Loader.hs

@@ -4,7 +4,6 @@ import qualified SDL
 import qualified SDL.Image
 import qualified SDL.Video.Renderer
 import Wolf3D.Engine
-import Wolf3D.Geom
 import Wolf3D.Display
 import Wolf3D.Sim
 import Wolf3D.Animation
@@ -14,27 +13,13 @@ import Data.Map (Map, fromList)
 import Foreign.C.Types (CInt)
 
 
-tan30 :: Double
-tan30 = tan (pi / 6)
-
-hudBorderTop :: (Int, Int)
-hudBorderTop = (8, 4)
-
-hudBarHeight :: Int
-hudBarHeight = 40
-
-loadRenderData :: SDL.Renderer -> (Int, Int) -> IO RenderData
-loadRenderData r s@(windowWidth, windowHeight) = do
+loadRenderData :: SDL.Renderer -> IO RenderData
+loadRenderData r = do
   w <- loadWallDatas r
   i <- loadEnvItemsData r
   weapons <- loadWeaponData r
   hudPlaceholder <- loadHudData r
-  let actionWidth = windowWidth - 2 * (fst hudBorderTop)
-  let actionHeight = windowHeight - 2 * (snd hudBorderTop) - hudBarHeight
-  let actionArea = IntRectangle hudBorderTop (actionWidth, actionHeight)
-  let halfSize = (actionWidth `div` 2, actionHeight `div` 2)
-  let distToProjPlane = fromIntegral (actionWidth `div` 2) / tan30
-  return (RenderData s actionArea halfSize distToProjPlane w i weapons hudPlaceholder)
+  return (RenderData w i weapons hudPlaceholder)
 
 loadHudData :: SDL.Renderer -> IO (SDL.Texture, SDL.Rectangle CInt)
 loadHudData r = loadTexture r "hud-placeholder.png"

src/Wolf3D/Main.hs

@@ -6,23 +6,23 @@ import Wolf3D.Runner
 import Wolf3D.UI
 import Wolf3D.Engine
 import Wolf3D.Sim
+import Wolf3D.Display (screenWidth)
 import qualified SDL
 import Data.StateVar (($=))
 
 type Scale = Int
 
-createMain :: Scale -> World Wolf3DSimEntity -> (SDL.Renderer -> (Int, Int) -> IO (SimRun -> IO ())) -> IO ()
+createMain :: Scale -> World Wolf3DSimEntity -> (SDL.Renderer -> IO (SimRun -> IO ())) -> IO ()
 createMain s initWorld createRender = do
   -- Original native size
-  let width = s * 320
-  let height = s * 200
+  let width = s * screenWidth
   -- wolf3d was 320 x 200 on 4:3 displays, so it was scaled vertically
   let windowSize = (width, width `div` 4 * 3) :: (Int, Int)
   -- On a machine with infinite resources, frame rate of Wolf3D was 70fps
   let frameTime = 14
   createUI windowSize $
     \r -> do
-      render <- createRender r (width, height)
+      render <- createRender r
       let scaleX = 1.0 -- (windowWidth / width) / 1.0
       let scaleY = 1.2 -- (windowHeight / height) / 1.0
       SDL.rendererScale r $= (SDL.V2 scaleX scaleY)

stack.yaml

@@ -59,6 +59,9 @@ extra-deps:
   - directory-1.3.6.0
   - process-1.4.3.0
   - unix-2.7.2.2 # Guess this one probably stops it working on windows?
+  - QuickCheck-2.13.2
+  - hspec-core-2.7.1
+  - hspec-discover-2.7.1
 
 # Override default flag values for local packages and extra-deps
 flags: {}

stack.yaml.lock

@@ -130,6 +130,27 @@ packages:
       sha256: c355f7924ce67e5bf8f20767462af18f09b8c0d1f7161117221cbb94c15deee3
   original:
     hackage: unix-2.7.2.2
+- completed:
+    hackage: QuickCheck-2.13.2@sha256:ad4e5adbd1c9dc0221a44307b992cb040c515f31095182e47aa7e974bc461df1,6952
+    pantry-tree:
+      size: 2202
+      sha256: f79eee2f6a00b2c649f993a7b358827702373cbc931ced55ebdfb59625540403
+  original:
+    hackage: QuickCheck-2.13.2
+- completed:
+    hackage: hspec-core-2.7.1@sha256:2696420050bafb1b690366b2c0ca8595a27c4597811df036f0c35cf19f46862b,4583
+    pantry-tree:
+      size: 3601
+      sha256: 7761094914f253af8eff3e0d14e1e0317a7e260f2d4bd4bd44d5d222fe0ba3d6
+  original:
+    hackage: hspec-core-2.7.1
+- completed:
+    hackage: hspec-discover-2.7.1@sha256:e8ce36741c06b41de58069814a7d3b7314bdeaab35ae573e3c924739011e0c29,2243
+    pantry-tree:
+      size: 1080
+      sha256: 2d1c4ccbd0c9047311d1bd24989714df844003c258964ef65d542f6627dc0fed
+  original:
+    hackage: hspec-discover-2.7.1
 snapshots:
 - completed:
     size: 535260