Work on textures and lighting

This commit is contained in:
2023-03-23 21:17:24 +00:00
parent 1a2fc7c715
commit 1abfaa3cd0
25 changed files with 641 additions and 710 deletions
+30 -30
View File
@@ -49,12 +49,12 @@ translateToRightHand cr = translateToRightHand' cr -- . mirrorSPxz
translateToRightHand' :: Creature -> SPic -> SPic
translateToRightHand' cr
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5) -- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10)
| twoFlat cr = waistSP . translateSPf 4 (-8)
| oneH cr = shoulderSP . translateSPxy 11 (-3) . rotateSP (-0.5) -- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPxy 0 5 . rotateSP (-1) . translateSPxy 4 (-10)
| twoFlat cr = waistSP . translateSPxy 4 (-8)
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSP . translateSPf (- f sa) (- off)
_ -> waistSP . translateSPf 0 (- off)
Just (Walking sa LeftForward) -> waistSP . translateSPxy (- f sa) (- off)
_ -> waistSP . translateSPxy 0 (- off)
where
off = 8
sLen = _strideLength $ _crStance cr
@@ -65,12 +65,12 @@ translateToRightWrist cr = translateToRightWrist' cr -- . mirrorSPxz
translateToRightWrist' :: Creature -> SPic -> SPic
translateToRightWrist' cr
| oneH cr = shoulderSP . translateSPf 11 (-3) . rotateSP (-0.5) . offTrans -- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 4 (-10) . offTrans
| twoFlat cr = waistSP . translateSPf 4 (-8) . offTrans
| oneH cr = shoulderSP . translateSPxy 11 (-3) . rotateSP (-0.5) . offTrans -- . scaleSH (V3 1 1.5 1)
| twists cr = shoulderSP . translateSPxy 0 5 . rotateSP (-1) . translateSPxy 4 (-10) . offTrans
| twoFlat cr = waistSP . translateSPxy 4 (-8) . offTrans
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> waistSP . translateSPf (- f sa) (- off) . offTrans
_ -> waistSP . translateSPf 0 (- off) . offTrans
Just (Walking sa LeftForward) -> waistSP . translateSPxy (- f sa) (- off) . offTrans
_ -> waistSP . translateSPxy 0 (- off) . offTrans
where
offTrans = translateSP (V3 0 4 (-4))
off = 8
@@ -92,12 +92,12 @@ translatePointToLeftHand cr
translateToLeftHand :: Creature -> SPic -> SPic
translateToLeftHand cr
| oneH cr = waistSP . rotateSP 0.4 . translateSPf 0 off
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 12 4
| twoFlat cr = waistSP . translateSPf 4 8
| oneH cr = waistSP . rotateSP 0.4 . translateSPxy 0 off
| twists cr = shoulderSP . translateSPxy 0 5 . rotateSP (-1) . translateSPxy 12 4
| twoFlat cr = waistSP . translateSPxy 4 8
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> waistSP . translateSPf (- f sa) off
_ -> waistSP . translateSPf 0 off
Just (Walking sa RightForward) -> waistSP . translateSPxy (- f sa) off
_ -> waistSP . translateSPxy 0 off
where
off = 8
sLen = _strideLength $ _crStance cr
@@ -105,12 +105,12 @@ translateToLeftHand cr
translateToLeftWrist :: Creature -> SPic -> SPic
translateToLeftWrist cr
| oneH cr = waistSP . rotateSP 0.4 . translateSPf 0 off . offTrans
| twists cr = shoulderSP . translateSPf 0 5 . rotateSP (-1) . translateSPf 12 4 . offTrans
| twoFlat cr = waistSP . translateSPf 4 8 . offTrans
| oneH cr = waistSP . rotateSP 0.4 . translateSPxy 0 off . offTrans
| twists cr = shoulderSP . translateSPxy 0 5 . rotateSP (-1) . translateSPxy 12 4 . offTrans
| twoFlat cr = waistSP . translateSPxy 4 8 . offTrans
| otherwise = case cr ^? crStance . carriage of
Just (Walking sa RightForward) -> waistSP . translateSPf (- f sa) off . offTrans
_ -> waistSP . translateSPf 0 off . offTrans
Just (Walking sa RightForward) -> waistSP . translateSPxy (- f sa) off . offTrans
_ -> waistSP . translateSPxy 0 off . offTrans
where
offTrans = translateSP (V3 0 4 (-4))
off = 8
@@ -120,9 +120,9 @@ translateToLeftWrist cr
translateToLeftLeg :: Creature -> SPic -> SPic
translateToLeftLeg cr =
rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> translateSPf (f sa) off
Just (Walking sa RightForward) -> translateSPf (- f sa) off
_ -> translateSPf 0 off
Just (Walking sa LeftForward) -> translateSPxy (f sa) off
Just (Walking sa RightForward) -> translateSPxy (- f sa) off
_ -> translateSPxy 0 off
where
off = 5
sLen = _strideLength $ _crStance cr
@@ -131,9 +131,9 @@ translateToLeftLeg cr =
translateToRightLeg :: Creature -> SPic -> SPic
translateToRightLeg cr =
rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
Just (Walking sa LeftForward) -> translateSPf (- f sa) (- off)
Just (Walking sa RightForward) -> translateSPf (f sa) (- off)
_ -> translateSPf 0 (- off)
Just (Walking sa LeftForward) -> translateSPxy (- f sa) (- off)
Just (Walking sa RightForward) -> translateSPxy (f sa) (- off)
_ -> translateSPxy 0 (- off)
where
off = 5
sLen = _strideLength $ _crStance cr
@@ -142,12 +142,12 @@ translateToRightLeg cr =
translateToHead :: Creature -> SPic -> SPic
translateToHead cr
| twists cr =
translateSPz 20 . translateSPf 0 5 . rotateSP (-1) . translateSPf (negate 2.5) 0.25
translateSPz 20 . translateSPxy 0 5 . rotateSP (-1) . translateSPxy (negate 2.5) 0.25
. rotateSP 1
| oneH cr =
translateSPz 20 . rotateSP 0.5 . translateSPf 2.5 0
translateSPz 20 . rotateSP 0.5 . translateSPxy 2.5 0
. rotateSP (negate 0.5)
| otherwise = translateSPz 20 . translateSPf 2.5 0
| otherwise = translateSPz 20 . translateSPxy 2.5 0
translatePointToHead :: Creature -> Point3 -> Point3
translatePointToHead cr
@@ -162,7 +162,7 @@ translatePointToHead cr
translateToChest :: Creature -> SPic -> SPic
translateToChest cr
| oneH cr = rotateSP 0.5
-- | twists cr = translateSPf 0 5 . rotateSP (-1)
-- | twists cr = translateSPxy 0 5 . rotateSP (-1)
| twists cr = rotateSP (-1)
| otherwise = id
+1 -1
View File
@@ -23,7 +23,7 @@ import qualified Quaternion as Q
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr = uncurryV translateSPf (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
basicCrPict cr = uncurryV translateSPxy (_crPos cr) (rotateSP (_crDir cr) $ drawEquipment cr)
<> (basicCrShape cr, mempty)
--testShape :: Shape
+4 -3
View File
@@ -39,7 +39,7 @@ data Configuration = Configuration
, _volume_sound :: Float
, _volume_music :: Float
, _graphics_cloud_shadows :: Bool
, _graphics_object_shadows :: ObjectShadows
, _graphics_object_shadows :: ShadowRendering
, _graphics_resolution_factor :: ResFactor
, _graphics_num_shadow_casters :: NumShadowCasters
, _windowX :: Float
@@ -84,7 +84,8 @@ data DebugBool
data ResFactor = FullRes | HalfRes | QuarterRes
deriving (Show, Eq, Ord, Enum, Bounded)
data ObjectShadows = GeoObjShads
data ShadowRendering
= GeoObjShads
| InstancingShads
| NoObjShads
| NoShadows
@@ -125,7 +126,7 @@ debugOn db = S.member db . _debug_booleans
makeLenses ''Configuration
deriveJSON defaultOptions ''NumShadowCasters
deriveJSON defaultOptions ''ResFactor
deriveJSON defaultOptions ''ObjectShadows
deriveJSON defaultOptions ''ShadowRendering
deriveJSON defaultOptions ''RoomClipping
deriveJSON defaultOptions ''DebugBool
deriveJSON defaultOptions ''Configuration
+1 -1
View File
@@ -353,7 +353,7 @@ useMod hm = case hm of
moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x
modcrpos x cr =
cr & crDir %~ tweenAngles x (_crOldDir cr)
& crPos %~ tweenPoints x (_crOldPos cr)
& crPos %~ alongSegBy x (_crOldPos cr)
mcUseHeld :: HeldItemType -> Item -> Machine -> World -> World
mcUseHeld hit = case hit of
+1 -1
View File
@@ -34,7 +34,7 @@ drawRemoteShell pj
| t > (-99) = green
| otherwise = red
t = _prjTimer pj
doposition = translateSPz 18 . uncurryV translateSPf (_prjPos pj) . rotateSP (_prjDir pj)
doposition = translateSPz 18 . uncurryV translateSPxy (_prjPos pj) . rotateSP (_prjDir pj)
remoteShellShape :: Color -> SPic
remoteShellShape col =
+1 -1
View File
@@ -22,7 +22,7 @@ drawProp pd = case pd of
PropDrawToggle pd' -> propDrawToggle pd'
PropDrawGib x -> noPic . drawGib x
PropDrawFlatTranslate x -> \pr ->
uncurryV translateSPf (_prPos pr) $ rotateSP (_prRot pr) $ drawProp x pr
uncurryV translateSPxy (_prPos pr) $ rotateSP (_prRot pr) $ drawProp x pr
drawGib :: Float -> Prop -> Shape
drawGib x pr = flesh <> skin
+16 -15
View File
@@ -5,6 +5,7 @@ module Dodge.Render (
--import qualified Data.Vector as V
import Dodge.DownscaleSize
import Data.List (sortOn)
import Shader.Poke.Cloud
import GLHelp
@@ -187,14 +188,14 @@ doDrawing' win pdata u = do
--draw lightmap into its own buffer
createLightMap
cfig
pdata
lightPoints
(u ^. uvConfig . graphics_object_shadows)
nWalls
nSilIndices
nIndices
(u ^. uvConfig . graphics_object_shadows)
(pdata ^. fboBase . _2 . _2)
(pdata ^. fboBase . _2 . _3)
lightPoints
pdata
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
--apply lightmap to base buffer
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
@@ -221,13 +222,14 @@ doDrawing' win pdata u = do
glDepthMask GL_TRUE
renderLayer BloomLayer shadV layerCounts
--setup downscale viewport for blurring bloom
setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
--setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
setViewportSize (round winx `div` downSize) (round winy `div` downSize)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
glDepthFunc GL_ALWAYS
glBindTextureUnit 0 (pdata ^. fboBloom . _2 . unTO)
glDisable GL_BLEND
drawShader (_bloomBlurShader pdata) 4
replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
replicateM_ 2 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
glEnable GL_BLEND
setViewportSize (round winx `div` resFact) (round winy `div` resFact)
--draw clouds onto cloud buffer
@@ -302,21 +304,21 @@ doDrawing' win pdata u = do
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
createLightMap
cfig
pdata
lightPoints
(_graphics_object_shadows $ _uvConfig u)
nWalls
nSilIndices
nIndices
(_graphics_object_shadows $ _uvConfig u)
(pdata ^. fboPos . _2)
(pdata ^. fboCloud . _2 . _3)
lightPoints
pdata
glInvalidateBufferData (pdata ^. vboShapes . vboName)
--apply lightmap to cloud buffer
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
glDepthMask GL_FALSE
withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
glDepthFunc GL_ALWAYS
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
glEnable GL_BLEND
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
drawShader (_fullscreenShader pdata) 4
@@ -326,20 +328,21 @@ doDrawing' win pdata u = do
--Draw blurred bloom onto base buffer
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
glBindTextureUnit 0 (_unTO . snd $ _fboHalf1 pdata)
drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
--draw shadowed clouds onto base buffer
glBindTexture GL_TEXTURE_2D (pdata ^. fboCloud . _2 . _1 . unTO)
glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
drawShader (_fullscreenShader pdata) 4
--set viewport for radial distortion
setViewportSize (round winx) (round winy)
glDepthFunc GL_ALWAYS
glBlendFunc GL_ONE GL_ZERO
-- perform any radial distortion
-- this is hideous
case w ^. cWorld . lWorld . distortions of
[] -> do
bindTO $ pdata ^. fboBase . _2 . _1
glBindTextureUnit 0 $ pdata ^. fboBase . _2 . _1 . unTO
glBindFramebuffer GL_FRAMEBUFFER 0
drawShader (_fullscreenShader pdata) 4
rds -> do
@@ -352,10 +355,8 @@ doDrawing' win pdata u = do
take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
++ [FBO 0]
toList = (pdata ^. fboBase . _2 . _1) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata])
bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
glActiveTexture GL_TEXTURE1
bindings = zipWith (>>) (map bindFBO fboList) (map (glBindTextureUnit 1 . _unTO) toList)
zipWithM_ (>>) bindings $ map bindDrawDist rds
glActiveTexture GL_TEXTURE1
glDepthFunc GL_ALWAYS
glEnable GL_BLEND
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
+14 -21
View File
@@ -2,8 +2,6 @@ module Dodge.Render.ShapePicture (
worldSPic,
) where
import Dodge.Render.Picture
import Dodge.Data.Universe
import Control.Lens
import Control.Monad (guard)
import Data.Foldable
@@ -14,6 +12,7 @@ import qualified Data.Set as Set
import Dodge.Base
import Dodge.Creature.Picture
import Dodge.Creature.Picture.Awareness
import Dodge.Data.Universe
import Dodge.Debug.Picture
import Dodge.Draw
import Dodge.Flare
@@ -25,6 +24,7 @@ import Dodge.RadarBlip
import Dodge.Render.InfoBox
import Dodge.Render.Label
import Dodge.Render.List
import Dodge.Render.Picture
import Dodge.ShortShow
import Dodge.SoundLogic.LoadSound
import Dodge.Viewpoints
@@ -36,7 +36,7 @@ import Geometry.ConvexPoly
import qualified IntMapHelp as IM
import Padding
import Picture
import Polyhedra
import Shape
import ShapePicture
import ShortShow
import Sound.Data
@@ -108,21 +108,14 @@ drawCreature cr = case _crType cr of
]
)
cr
Lampoid{_lampHeight = h} -> picAtCrPosNoRot1 (lampCrPic h) cr
Lampoid{_lampHeight = h} -> uncurryV translateSPxy (_crPos cr) $ lampCrSPic h
NonDrawnCreature -> mempty
lampCrPic :: Float -> Picture
lampCrPic h =
pictures
[ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
, foldMap (polyToTris . map f) $ boxXYZnobase 5 5 (h -1)
]
where
f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum
picAtCrPosNoRot1 :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
picAtCrPosNoRot1 thePic cr = (,) mempty $ uncurryV translate (_crPos cr) thePic
lampCrSPic :: Float -> SPic
lampCrSPic h =
( colorSH blue . upperBox h $ rectWH 5 5
, setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
)
picAtCrPos1 :: Picture -> Creature -> SPic
--{-# INLINE picAtCrPos #-}
@@ -130,13 +123,13 @@ picAtCrPos1 thePic cr = (,) mempty $ tranRot (_crPos cr) (_crDir cr) thePic
shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
shiftDraw fpos fdir fdraw x =
uncurryV translateSPf (fpos x)
uncurryV translateSPxy (fpos x)
. rotateSP (fdir x)
$ fdraw x x
shiftDraw' :: (a -> Point2) -> (a -> Float) -> (a -> SPic) -> a -> SPic
shiftDraw' fpos fdir fdraw x =
uncurryV translateSPf (fpos x)
uncurryV translateSPxy (fpos x)
. rotateSP (fdir x)
$ fdraw x
@@ -366,17 +359,17 @@ ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
floorItemSPic :: FloorItem -> SPic
floorItemSPic flit =
uncurryV translateSPf (_flItPos flit) $
uncurryV translateSPxy (_flItPos flit) $
rotateSP (_flItRot flit) (itemSPic (_flIt flit))
btSPic :: Button -> SPic
btSPic bt =
uncurryV translateSPf (_btPos bt) $
uncurryV translateSPxy (_btPos bt) $
rotateSP (_btRot bt) (drawButton (_btPict bt) bt)
mcSPic :: Machine -> SPic
mcSPic mc =
uncurryV translateSPf (_mcPos mc) $
uncurryV translateSPxy (_mcPos mc) $
rotateSP (_mcDir mc) (drawMachine mc)
soundPic :: Configuration -> World -> Sound -> Picture