From 2804d58a5a89f82cef900295efdc5aaba8c111a4 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 21 Sep 2021 02:04:41 +0100 Subject: [PATCH] Continue shape rendering improvements --- src/Dodge/Data.hs | 4 ++-- src/Dodge/Default/World.hs | 2 +- src/Dodge/Layout.hs | 7 +------ src/Dodge/LevelGen.hs | 4 ++-- src/Dodge/LevelGen/Data.hs | 4 ++-- src/Dodge/Render.hs | 3 --- src/Dodge/Render/Picture.hs | 4 ---- src/Dodge/Room/Foreground.hs | 16 ++++++---------- src/Dodge/Room/Start.hs | 4 ++-- src/Shader/Poke.hs | 21 --------------------- src/Shape.hs | 21 +++------------------ src/Shape/Data.hs | 3 +-- 12 files changed, 20 insertions(+), 73 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 0d3c26225..df65e8565 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -27,7 +27,6 @@ import Data.Preload import Picture.Data import ShapePicture import Geometry.Data -import Polyhedra.Data import Sound.Data import qualified DoubleStack as DS import Dodge.GameRoom @@ -76,7 +75,8 @@ data World = World , _playingSounds :: M.Map SoundOrigin Sound , _decorations :: IM.IntMap Picture , _foregroundShape :: Shape - , _foregroundDecorations :: [Polyhedra] + --, _foregroundDecorations :: [Polyhedra] + , _foregroundDecorations :: Shape , _foregroundEdgeVerx :: [Point3] , _corpses :: Zone [Corpse] , _clickMousePos :: !Point2 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 9f1fd0494..64a20cd75 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -80,7 +80,7 @@ defaultWorld = World , _inventoryMode = TopInventory , _lClickHammer = HammerUp , _foregroundShape = mempty - , _foregroundDecorations = [] + , _foregroundDecorations = mempty , _foregroundEdgeVerx = [] , _radDistortion = [] , _gameRooms = [] diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index e0e78669e..39fa5dfe0 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -24,7 +24,6 @@ import Picture.Data import Tile import Polyhedra import Polyhedra.Data -import Shape import Control.Monad.State import Control.Lens @@ -78,11 +77,7 @@ setupWorldBounds w = w ) ps setupForegroundEdgeVerxs :: World -> World -setupForegroundEdgeVerxs w = w & foregroundEdgeVerx .~ polyhedrasToEdges (_foregroundDecorations w) - & foregroundShape .~ ([ShapeObj ListV vs],es) - where - vs = shVfromList $ map pairToSV $ concatMap polyToTris $ concatMap _pyFaces $ _foregroundDecorations w - es = shEfromList $ polyhedrasToEdges (_foregroundDecorations w) +setupForegroundEdgeVerxs w = w & foregroundShape .~ (_foregroundDecorations w) polyhedrasToEdges :: [Polyhedra] -> [Point3] polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index b7a0c742c..4c239f921 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -19,9 +19,9 @@ import Dodge.LevelGen.TriggerDoor import Dodge.LevelGen.Switch import Dodge.LevelGen.Data import Geometry +import Shape --import Geometry.Data import Picture -import Polyhedra import qualified IntMapHelp as IM --import System.Random @@ -99,7 +99,7 @@ placeSpot ps w = case _psType ps of where (q:qs) = map (shiftPointBy (p,rot)) ps' rmCrossPaths w' = foldr (uncurry removePathsCrossing) w' $ zip (q:qs) (qs++[q]) - PutForeground poly -> w & foregroundDecorations %~ (map (uncurryV translateXY p . rotateXY rot) poly ++) + PutForeground sh -> w & foregroundDecorations %~ ((uncurryV translateSHf p . rotateSH rot) sh <>) PutNothing -> w PutID _ -> w --_ -> w diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index 812b8289b..a7af6c1ec 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/src/Dodge/LevelGen/Data.hs @@ -19,8 +19,8 @@ module Dodge.LevelGen.Data ) where import Dodge.Data import Picture -import Polyhedra.Data import Geometry.Data +import Shape.Data import Control.Lens import Control.Monad.State @@ -40,7 +40,7 @@ data PSType = PutCrit {_unPutCrit :: Creature} | PutBtDoor Color Point2 Float Point2 Point2 Float | PutSwitchDoor Color Point2 Float Point2 Point2 Float | RandPS (State StdGen PSType) - | PutForeground [Polyhedra] + | PutForeground Shape | PutNothing | PutID { _putID :: Int} data PlacementSpot = PS diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index b069efea8..65d028e12 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -19,7 +19,6 @@ import Shader.Bind import Shader.Data import MatrixHelper --import Polyhedra.Data -import Polyhedra import Shader.ExtraPrimitive import Shader.Parameters @@ -98,8 +97,6 @@ doDrawing pdata w = do if w ^. config . wall_textured then renderTextureWalls pdata nWalls else renderBlankWalls pdata nWalls - ---draw foreground geometry onto base buffer - renderFoldable shadV $ polysToPic $ foregroundPics w --draw objects onto base buffer layerCounts <- UMV.replicate (6*6) 0 pokeBindFoldableLayer shadV layerCounts $ worldPictures w diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 8c7ca9f1c..f3395d3f8 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -14,7 +14,6 @@ import Dodge.SoundLogic.LoadSound import Sound.Data import Geometry import Picture -import Polyhedra.Data import ShapePicture import Control.Lens @@ -42,9 +41,6 @@ worldPictures w = pictures winSize = 30 + max (getWindowX w) (getWindowY w) camCen = _cameraCenter w -foregroundPics :: World -> [Polyhedra] -foregroundPics = _foregroundDecorations - fixedCoordPictures :: World -> Picture fixedCoordPictures w = case _menuLayers w of [] -> pictures diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index 21e5688ef..ecc4252b2 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -6,9 +6,8 @@ import Dodge.Base import Picture import Geometry --import Geometry.Data -import Geometry.Vector3D -import Polyhedra -import Polyhedra.Data +--import Geometry.Vector3D +import Shape import Data.List import Data.Maybe @@ -48,14 +47,11 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints ] yN = d * 0.5 *.* normalizeV (pa -.- pb) -highPipe :: Float -> Point2 -> Point2 -> [Polyhedra] -highPipe h x@(V2 xx xy) y = - [ Polyhedron . map (map ( (,orange) . (+.+.+ V3 xx xy h))) - $ boxABC (V3 a b 0) (V3 a' b' 0) (V3 0 0 5) - ] +highPipe :: Float -> Point2 -> Point2 -> Shape +highPipe h x y = translateSHz h $ colorSH orange $ upperPrismPoly 5 + [x +.+ n, y +.+ n, y -.- n, x -.- n] where - (V2 a b) = y -.- x - (V2 a' b') = 10 *.* normalizeV (vNormal (V2 a b)) + n = 2.5 *.* normalizeV (vNormal (y -.- x)) girderZ :: Float -> Point2 -> Point2 -> Picture girderZ w x y = setDepth 50 $ color red $ pictures $ diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 17b2dd15f..26b48f786 100644 --- a/src/Dodge/Room/Start.hs +++ b/src/Dodge/Room/Start.hs @@ -25,8 +25,8 @@ startRoom = do h <- state $ randomR (200,400) let fground = sPS (V2 0 0) 0 $ PutForeground $ highPipe 80 (V2 0 (h/3)) (V2 w (h/2)) - ++ highPipe 40 (V2 0 (h/2)) (V2 w (h/3)) - ++ highPipe 60 (V2 (w/3) 0 ) (V2 (w/3) h ) + <> highPipe 40 (V2 0 (h/2)) (V2 w (h/3)) + <> highPipe 60 (V2 (w/3) 0 ) (V2 (w/3) h ) theLamp = sPS (V2 (w/2) (h/2)) 0 $ putColorLamp (V3 0.75 0.75 0.75) treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy (V2 (-20) (-20),0) diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 017c50ee0..ff6fb8316 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -62,7 +62,6 @@ pokeShapeObjs ptr iptr _ count = VS.foldlM' (pokeShapeObj ptr iptr) count . VS.f pokeShapeObj :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int,Int) pokeShapeObj ptr iptr counts (ShapeObj shType shVerts) = case shType of - ListV -> pokeShapeVs ptr iptr counts shVerts TopPrism size -> pokeTopPrism size ptr iptr counts shVerts pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int,Int) @@ -80,9 +79,6 @@ pokeTopPrismIndex nv iptr ni ioff = do pokeElemOff iptr ni (fromIntegral $ nv + ioff) return (ni + 1) -pokeShapeVs :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [ShapeV] -> IO (Int, Int,Int,Int) -pokeShapeVs ptr iptr count = VS.foldlM' (pokeShapeV ptr iptr) count . VS.fromList - pokeShapeEs :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> [Point3] -> IO (Int,Int,Int,Int) pokeShapeEs ptr ieptr count = VS.foldlM' (pokeShapeE ptr ieptr) count . VS.fromList @@ -120,23 +116,6 @@ pokeJustV ptr (nv,ne,ni,nei) sh = do V3 a b c = _svPos sh V4 d e f g = _svCol sh -pokeShapeV :: Ptr Float -> Ptr GLushort -> (Int,Int,Int,Int) -> ShapeV -> IO (Int,Int,Int,Int) -pokeShapeV ptr iptr (nv,ne,ni,nei) sh = do - pokeElemOff ptr (off 0) a - pokeElemOff ptr (off 1) b - pokeElemOff ptr (off 2) c - pokeElemOff ptr (off 3) d - pokeElemOff ptr (off 4) e - pokeElemOff ptr (off 5) f - pokeElemOff ptr (off 6) g - pokeElemOff iptr ni (fromIntegral nv) - return (nv+1,ne,ni+1,nei) - where - off i = nv*7 + i - V3 a b c = _svPos sh - V4 d e f g = _svCol sh - - pokePoint3s :: Ptr Float -> VS.Stream IO Point3 -> IO Int pokePoint3s ptr = VS.foldlM' (pokePoint3 ptr) 0 diff --git a/src/Shape.hs b/src/Shape.hs index 6e456fb12..9dee75f27 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -4,6 +4,7 @@ module Shape , translateSH , emptySH , upperPrismPoly + , polyCirc , translateSHz , translateSHf , rotateSH @@ -24,8 +25,8 @@ emptySH :: Shape emptySH = mempty polyCirc :: Int -> Float -> [Point2] -{-# INLINE polycirc #-} -polyCirc n r = map (\i -> rotateV ) [0..n] +{-# INLINE polyCirc #-} +polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/(fromIntegral n)..] upperPrismPoly :: Float -- ^ height, expected to be strictly positive @@ -53,22 +54,6 @@ upperPrismPoly h ps = sideEdges = shEfromList $ concat $ zipWith3 makeSideEdge ps (tail ps ++ [head ps]) (drop 2 ps ++ take 2 ps) makeSideEdge (V2 xl yl) (V2 x y) (V2 xr yr) = [V3 x y 0, V3 x y h, V3 xr yr 0, V3 xl yl h] -flatPoly :: [Point2] -> Shape -flatPoly ps = - ( [ShapeObj ListV $ shVfromList $ polyToTris $ map f ps] - , shEfromList $ concat $ zipWith g ps (tail ps ++ [head ps]) - ) - where - f (V2 x y) = pairToSV ( V3 x y 0, black ) - g (V2 x y) (V2 a b) = - [ V3 x y 0 - , V3 a b 0 - , V3 x y 0 -.-.- n - , V3 a b 0 -.-.- n - ] - where - n = addZ 0 $ vNormal (V2 (a-x) (b-y)) - colorSH :: Color -> Shape -> Shape {-# INLINE colorSH #-} colorSH col = overCol $ const col diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index 64de280c4..853a7ffd1 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -40,8 +40,7 @@ data ShapeObj = ShapeObj data ShapeType = TopPrism Int - | ListV --- | TopHexahedron -- ^ assumed convex, eight vertices +-- | ListV -- edges are given by four consecutive points data ShapeV = ShapeV