diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 5828f2969..e30272984 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -13,7 +13,7 @@ module Dodge.Creature.Picture import Dodge.Data --import Dodge.Base import Dodge.Creature.Test ---import Dodge.Render.InfoBox +import Dodge.Render.InfoBox import Dodge.Render.List --import Dodge.Creature.AlertLevel.Data --import Dodge.Picture.Layer @@ -87,17 +87,16 @@ crDisplayInfo cfig w cr = (_crPos cr, crOnScreen = pointOnScreen cfig w $ _crPos cr creatureDisplayText :: Configuration -> World -> Creature -> Picture -creatureDisplayText cfig w cr = setLayer FixedCoordLayer . setDepth 50 - $ color white $ renderListAt 0 0 cfig $ zip ["TEST","ME"] $ repeat white - -- $ renderInfoListAt 0 0 cfig w - -- $ crDisplayInfo cfig w cr +creatureDisplayText cfig w cr + = setLayer FixedCoordLayer $ renderInfoListAt 0 0 cfig w + $ crDisplayInfo cfig w cr creatureDisplayText' :: Configuration -> World -> Creature -> Picture creatureDisplayText' cfig w cr | not (_debug_cr_status cfig) = [] | otherwise - = setLayer TopLayer - . setDepth 50 + = setLayer DebugLayer + . setDepth 20 . translate x y . color white . rotate (0.5 * pi) diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index 75a13fceb..6d5a08637 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/src/Dodge/Debug/LinkDecoration.hs @@ -25,11 +25,11 @@ roomLinkDecorations :: Room -> Picture roomLinkDecorations rm = pictures . map (linkDecoration . lnkPosDir) $ _rmLinks rm linkDecoration :: (Point2,Float) -> Picture -linkDecoration (p,a) = setLayer TopLayer . setDepth 50 . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi/2)] +linkDecoration (p,a) = setLayer DebugLayer . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi/2)] roomPolyDecorations :: Room -> Picture roomPolyDecorations rm = pictures . map polyWireFrame $ _rmPolys rm polyWireFrame :: [Point2] -> Picture -polyWireFrame (x:xs) = setLayer TopLayer . setDepth 50 . color green $ line $ (x:xs) ++ [x] +polyWireFrame (x:xs) = setLayer DebugLayer . setDepth 50 . color green $ line $ (x:xs) ++ [x] polyWireFrame _ = undefined diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index fdd9399e1..5d8e98557 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -75,7 +75,7 @@ targetCursor = defaultTargeting targetSimpleDraw :: Int -> Item -> Creature -> World -> Picture targetSimpleDraw _ it _ w = fromMaybe mempty $ do mwp <- it ^? itTargeting . tgPos . _Just - return $ setLayer TopLayer $ color red $ setDepth 50 $ uncurryV translate mwp + return $ setLayer DebugLayer $ color red $ setDepth 50 $ uncurryV translate mwp $ rotate (_cameraRot w) $ pictures [line [V2 x x, V2 (-x) (-x)] @@ -87,7 +87,7 @@ targetSimpleDraw _ it _ w = fromMaybe mempty $ do targetRBCreatureDraw :: Int -> Item -> Creature -> World -> Picture targetRBCreatureDraw _ it _ w = fromMaybe mempty $ do mwp <- it ^? itTargeting . tgPos . _Just - return $ setLayer TopLayer $ color thecolor $ setDepth 50 $ uncurryV translate mwp + return $ setLayer DebugLayer $ color thecolor $ setDepth 50 $ uncurryV translate mwp $ rotate (_cameraRot w) $ pictures [line [V2 x x, V2 (-x) (-x)] diff --git a/src/Dodge/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs index 3101b6f31..3c672f68c 100644 --- a/src/Dodge/Picture/SizeInvariant.hs +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -14,8 +14,8 @@ fixedSizePicAt -> World -> Picture fixedSizePicAt pic p w - = setLayer TopLayer - . setDepth 50 + = setLayer DebugLayer + . setDepth 20 . translate x y . scale theScale theScale $ pic @@ -34,8 +34,8 @@ fixedSizePicClamp -> World -> Picture fixedSizePicClamp xbord ybord pic p cfig w - = setLayer TopLayer --- . setDepth 50 + = setLayer DebugLayer + . setDepth 20 . translate x y . scale theScale theScale $ pic @@ -59,8 +59,8 @@ fixedSizePicClampArrow -> World -> Picture fixedSizePicClampArrow xbord ybord pic p cfig w = pictures - [ setLayer TopLayer . translate x y . scale theScale theScale $ pic - , setLayer TopLayer . color white . setDepth 20 $ arrowPic + [ setLayer DebugLayer . translate x y . scale theScale theScale $ pic + , setLayer DebugLayer . color white . setDepth 20 $ arrowPic ] where winps = screenPolygon cfig w diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index aef83c75c..45ab07c1d 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -116,7 +116,7 @@ doDrawing pdata u = do then renderTextureWalls pdata nWalls else renderBlankWalls pdata nWalls --draw object pictures onto base buffer - renderLayer 0 shadV layerCounts + renderLayer BottomLayer shadV layerCounts --draw object shapes onto base buffer let fs = _shapeShader pdata currentProgram $= Just (_shadProg fs) @@ -146,9 +146,9 @@ doDrawing pdata u = do depthFunc $= Just Less blendFunc $= (SrcAlpha,OneMinusSrcAlpha) depthMask $= Disabled - renderLayer 3 shadV layerCounts + renderLayer BloomNoZWrite shadV layerCounts depthMask $= Enabled - renderLayer 1 shadV layerCounts + renderLayer BloomLayer shadV layerCounts --depthMask $= Enabled --setup downscale viewport for blurring bloom setViewportSize (round winx `div` (2*resFact)) (round winy `div` (2*resFact)) @@ -171,7 +171,7 @@ doDrawing pdata u = do blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha),(One,OneMinusSrcAlpha)) drawBuffers $= [FBOColorAttachment 0,NoBuffers] clear [ColorBuffer] - renderLayer 2 shadV layerCounts + renderLayer MidLayer shadV layerCounts --renderWindows pdata windowPoints drawShader (_windowShader pdata) nWins when (_cloud_shadows cfig) $ do @@ -179,7 +179,7 @@ doDrawing pdata u = do depthMask $= Enabled blend $= Disabled drawBuffers $= [NoBuffers,FBOColorAttachment 1] - renderLayer 2 shadV layerCounts + renderLayer MidLayer shadV layerCounts drawShader (_windowShader pdata) nWins ----draw lightmap for cloud buffer depthMask $= Disabled @@ -237,14 +237,14 @@ doDrawing pdata u = do depthFunc $= Just Always blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - renderLayer 5 shadV layerCounts + renderLayer DebugLayer shadV layerCounts -- draw overlay depthFunc $= Just Always depthMask $= Disabled blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - renderLayer 4 shadV layerCounts bufferUBO $ isoMatrix 0 1 (V2 0 0) (V2 2 2) + renderLayer FixedCoordLayer shadV layerCounts renderFoldable shadV $ fixedCoordPictures u depthMask $= Enabled eTicks <- SDL.ticks diff --git a/src/Dodge/Render/InfoBox.hs b/src/Dodge/Render/InfoBox.hs index 46bf2e7c5..69ce978d6 100644 --- a/src/Dodge/Render/InfoBox.hs +++ b/src/Dodge/Render/InfoBox.hs @@ -4,7 +4,7 @@ import Dodge.Data --import Dodge.Base.WinScale import Dodge.Render.Connectors import Dodge.Render.List -import Dodge.Base.Coordinate +import Dodge.Base import Picture import Geometry --import Control.Monad @@ -12,4 +12,7 @@ import Geometry renderInfoListAt :: Float -> Float -> Configuration -> World -> (Point2,[String]) -> Picture renderInfoListAt x y cfig w (p,ss) = renderListAt x y cfig (zip ss (repeat white)) - <> zConnect (V2 x y) (worldPosToScreenNorm cfig w p) + <> winScale cfig (color yellow $ zConnect (V2 (20+x-hw) (y+hh-20)) (worldPosToScreen w p)) + where + hw = halfWidth cfig + hh = halfHeight cfig diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 47dd3bf49..7dea5a826 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -96,7 +96,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w drawPathing :: Configuration -> World -> Picture drawPathing cfig w | _debug_pathing cfig - = -- setLayer 5 $ + = setLayer DebugLayer $ (color green . pictures . map (thickLine 5 . tflat2) $ graphToEdges gr) <> concatMap dispInc (graphToIncidence gr) | otherwise = [] @@ -106,7 +106,7 @@ drawPathing cfig w viewBoundaries :: Configuration -> World -> Picture viewBoundaries cfig w | _debug_view_boundaries cfig - = setLayer TopLayer $ color green (concatMap (polygonWire . _grBound) grs) + = setLayer DebugLayer $ color green (concatMap (polygonWire . _grBound) grs) <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w) | otherwise = [] where @@ -116,9 +116,9 @@ viewBoundaries cfig w viewClipBounds :: Configuration -> World -> Picture viewClipBounds cfig w | _debug_view_clip_bounds cfig == AllRoomClipBoundaries - = setLayer TopLayer $ color green $ concatMap (polygonWire . _cpPoints) (_roomClipping w) + = setLayer DebugLayer $ color green $ concatMap (polygonWire . _cpPoints) (_roomClipping w) | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries - = setLayer TopLayer $ f (_roomClipping w) + = setLayer DebugLayer $ f (_roomClipping w) | otherwise = [] where f (x:xs) = g x xs <> f xs diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 4075dd9a8..6d92b500b 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -20,20 +20,14 @@ data Layer | MidLayer | BloomLayer | BloomNoZWrite - | TopLayer + | DebugLayer | FixedCoordLayer + deriving (Eq,Ord,Enum,Bounded) layerNum :: Layer -> Int -layerNum lay = case lay of - BottomLayer -> 0 - MidLayer -> 1 - BloomLayer -> 2 - BloomNoZWrite -> 3 - TopLayer -> 4 - FixedCoordLayer -> 5 - +layerNum = fromEnum numLayers :: Int -numLayers = 6 +numLayers = length [minBound::Layer .. maxBound] --TODO use synonyms for layer numbers newtype ShadNum = ShadNum { _unShadNum :: Int } polyNum, polyzNum, bezNum, textNum, arcNum, ellNum :: ShadNum diff --git a/src/Render.hs b/src/Render.hs index 367243e9b..764dc4994 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -136,13 +136,15 @@ renderFoldable shadV struct = do ------------------------------end renderFoldable renderLayer - :: Int + :: Layer -> MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () renderLayer layer shads counts = do - let layerCounts = UMV.slice (layer * 6) 6 counts - MV.imapM_ (drawShaderLay layer layerCounts) shads + let layerCounts = UMV.slice (ln * numLayers) 6 counts + MV.imapM_ (drawShaderLay ln layerCounts) shads + where + ln = layerNum layer bindTO :: TextureObject -> IO () bindTO t = textureBinding Texture2D $= Just t