justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Continue shape rendering improvements

Browse Source
This commit is contained in:
justin
2021-09-21 02:04:41 +01:00
parent 464b0b16db
commit 2804d58a5a
12 changed files with 20 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+2 -2
View File
@@ -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
src/Dodge/Default/World.hs
+1 -1
View File
@@ -80,7 +80,7 @@ defaultWorld = World
, _inventoryMode = TopInventory
, _lClickHammer = HammerUp
, _foregroundShape = mempty
, _foregroundDecorations = []
, _foregroundDecorations = mempty
, _foregroundEdgeVerx = []
, _radDistortion = []
, _gameRooms = []
src/Dodge/Layout.hs
+1 -6
View File
@@ -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
src/Dodge/LevelGen.hs
+2 -2
View File
@@ -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
src/Dodge/LevelGen/Data.hs
+2 -2
View File
@@ -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
src/Dodge/Render.hs
-3
View File
@@ -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
src/Dodge/Render/Picture.hs
-4
View File
@@ -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
src/Dodge/Room/Foreground.hs
+6 -10
View File
@@ -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 $
src/Dodge/Room/Start.hs
+2 -2
View File
@@ -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)
src/Shader/Poke.hs
-21
View File
@@ -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
src/Shape.hs
+3 -18
View File
@@ -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
src/Shape/Data.hs
+1 -2
View File
@@ -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