From ed9a46a18d7217be8e35e8ac809b1be944c0f1ba Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 24 Feb 2023 15:03:06 +0000 Subject: [PATCH] Allow to change menu options with rclick, move towards shader experiment --- shader/lighting/lineShadow.geom | 10 +++-- src/Data/Preload/Render.hs | 1 + src/Dodge/Data/Config.hs | 10 +++-- src/Dodge/Data/Universe.hs | 2 +- src/Dodge/Menu.hs | 2 +- src/Dodge/Menu/Option.hs | 14 ++++--- src/Dodge/Update/Input/ScreenLayer.hs | 15 ++++++-- src/Preload/Render.hs | 6 ++- src/Render.hs | 53 +++++++++++++++------------ 9 files changed, 71 insertions(+), 42 deletions(-) diff --git a/shader/lighting/lineShadow.geom b/shader/lighting/lineShadow.geom index 5ad1eeab2..ea7f12e6d 100644 --- a/shader/lighting/lineShadow.geom +++ b/shader/lighting/lineShadow.geom @@ -3,8 +3,10 @@ layout (lines_adjacency) in; layout (triangle_strip, max_vertices = 4) out; layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ; uniform vec3 lightPos; -//vec4 shift (vec4 p) { return (vec4 (p.xyz + (100000*(p.xyz-lightPos)), 1));} -vec4 shift (vec4 p) { return (vec4 (p.xyz + (1000*(p.xyz-lightPos)), 1));} +uniform vec4 lumRad; +//vec4 shift (vec4 p) { return (vec4 (p.xyz + (lumRad.a*normalize(p.xyz-lightPos)), 1));} +vec4 shift (vec4 p) { return (vec4 (p.xyz + (100000*(p.xyz-lightPos)), 1));} +//vec4 shift (vec4 p) { return (vec4 (lightPos + (lumRad.a*normalize(p.xyz-lightPos)), 1));} // copied from lighting/cap.geom, should not be changed on its own vec4 projNear (vec4 pos) { @@ -27,6 +29,7 @@ void main() { vec4 p0 = gl_in[0].gl_Position; vec4 p1 = gl_in[1].gl_Position; + vec4 mid = 0.5*(p0 + p1); vec3 n0a = gl_in[2].gl_Position.xyz; vec3 n1a = gl_in[3].gl_Position.xyz; vec3 n0 = cross(p1.xyz - p0.xyz, n0a - p0.xyz) ; @@ -34,10 +37,11 @@ void main() //vec3 n2 = n0 + n1; // assumes the summands are normalized vec3 lightDir = p0.xyz - lightPos.xyz; + vec3 lightDir2 = p1.xyz - lightPos.xyz; // first test if the edge is part of the silhouette // that is, if the normals of the faces connected by the edge point are in // "different directions" wrt the light direction - if ( dot(n0 , lightDir) * dot(n1 , lightDir) <= 0 ) + if ( dot(n0 , lightDir) * dot(n1 , lightDir) <= 0 ) // using <= rather than < seems to get rid of overlapping shadow // artefacts { diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 4ef115a8b..a854514ad 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -14,6 +14,7 @@ import Control.Monad.Primitive data RenderData = RenderData { _lightingWallShadShader :: FullShader , _lightingLineShadowShader :: FullShader + , _positionalBlankShader :: FullShader , _lightingCapShader :: FullShader , _wallBlankShader :: FullShader , _windowShader :: FullShader diff --git a/src/Dodge/Data/Config.hs b/src/Dodge/Data/Config.hs index 2184f9023..ac11ad9b6 100644 --- a/src/Dodge/Data/Config.hs +++ b/src/Dodge/Data/Config.hs @@ -16,7 +16,7 @@ data Configuration = Configuration , _volume_music :: Float , _graphics_wall_textured :: Bool , _graphics_cloud_shadows :: Bool - , _graphics_object_shadows :: Bool + , _graphics_object_shadows :: ObjectShadows , _graphics_resolution_factor :: ResFactor , _windowX :: Float , _windowY :: Float @@ -60,6 +60,9 @@ data DebugBool data ResFactor = FullRes | HalfRes | QuarterRes deriving (Show, Eq, Ord, Enum, Bounded) +data ObjectShadows = GeoObjShads | CPUObjShads | NoObjShads + deriving (Show, Eq, Ord, Enum, Bounded) + data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries deriving (Show, Eq, Ord, Enum, Bounded) @@ -74,10 +77,10 @@ defaultConfig = Configuration { _volume_master = 1 , _volume_sound = 1 - , _volume_music = 1 + , _volume_music = 0 , _graphics_wall_textured = True , _graphics_cloud_shadows = True - , _graphics_object_shadows = True + , _graphics_object_shadows = GeoObjShads , _graphics_resolution_factor = FullRes , _windowX = 800 , _windowY = 600 @@ -93,6 +96,7 @@ debugOn db = S.member db . _debug_booleans makeLenses ''Configuration deriveJSON defaultOptions ''ResFactor +deriveJSON defaultOptions ''ObjectShadows deriveJSON defaultOptions ''RoomClipping deriveJSON defaultOptions ''DebugBool deriveJSON defaultOptions ''Configuration diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index e032aa912..7aad9d5ca 100644 --- a/src/Dodge/Data/Universe.hs +++ b/src/Dodge/Data/Universe.hs @@ -60,7 +60,7 @@ data ScreenLayer , _scOffset :: Int , _scPositionedMenuOption :: PositionedMenuOption , _scOptionFlag :: OptionScreenFlag - , _scSelectionList :: SelectionList (Universe -> Universe) + , _scSelectionList :: SelectionList (Universe -> Universe,Universe->Universe) , _scAvailableLines :: Int , _scListDisplayParams :: ListDisplayParams } diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 8b0eea7a6..26d3d5db2 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -184,7 +184,7 @@ graphicsMenuOptions :: [MenuOption] graphicsMenuOptions = [ makeEnumOption graphics_resolution_factor "RESOLUTION" (uvIOEffects .~ updateFramebufferSize) , makeBoolOption graphics_wall_textured "WALL TEXTURES" - , makeBoolOption graphics_object_shadows "OBJECT SHADOWS" + , makeEnumOption graphics_object_shadows "OBJECT SHADOWS" id , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS" ] diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index 0f3e83eef..6d82edc80 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -1,5 +1,6 @@ module Dodge.Menu.Option where +import Control.Applicative --import Dodge.ScodeToChar import Dodge.Default.SelectionList import Data.Maybe @@ -61,14 +62,15 @@ makeOptionsSelectionList :: Universe -> [MenuOption] -> PositionedMenuOption -> - SelectionList (Universe -> Universe) + SelectionList (Universe -> Universe,Universe -> Universe) makeOptionsSelectionList maxlines mselpos u mos pmo = defaultSelectionList { _slItems = optionsToSelections maxlines u mos pmo , _slSelPos = mselpos } -optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption -> [SelectionItem (Universe -> Universe)] +optionsToSelections :: Int -> Universe -> [MenuOption] -> PositionedMenuOption + -> [SelectionItem (Universe -> Universe,Universe -> Universe)] optionsToSelections maxlines u allops pmo = case pmo of NoPositionedMenuOption -> map (menuOptionToSelectionItem u maxOptionLength) ops TopMenuOption mo -> map (menuOptionToSelectionItem u maxOptionLength) (mo : ops) @@ -115,7 +117,8 @@ optionValueOffset u mo = case _moString mo u of MODStringOption s _ -> length s _ -> 0 -menuOptionToSelectionItem :: Universe -> Int -> MenuOption -> SelectionItem (Universe -> Universe) +menuOptionToSelectionItem :: Universe -> Int -> MenuOption + -> SelectionItem (Universe -> Universe,Universe -> Universe) menuOptionToSelectionItem w padAmount mo = SelectionItem { _siPictures = [optionText] @@ -124,13 +127,14 @@ menuOptionToSelectionItem w padAmount mo = --, _siWidth = length optionText , _siColor = thecol , _siOffX = 0 - , _siPayload = f + , _siPayload = (f,g) } where isselectable = case _moString mo w of MODBlockedString{} -> False _ -> True - f = fromMaybe id $ mo ^? moEff + f = fromMaybe id $ mo ^? moEff <|> mo ^? moEff1 + g = fromMaybe id $ mo ^? moEff2 thecol = case _moString mo w of MODBlockedString{} -> greyN 0.5 _ -> white diff --git a/src/Dodge/Update/Input/ScreenLayer.hs b/src/Dodge/Update/Input/ScreenLayer.hs index 95bc8ef69..a93bf52cd 100644 --- a/src/Dodge/Update/Input/ScreenLayer.hs +++ b/src/Dodge/Update/Input/ScreenLayer.hs @@ -38,7 +38,7 @@ optionScreenUpdate :: ScreenLayer -> PositionedMenuOption -> ListDisplayParams -> - SelectionList (Universe -> Universe) -> + SelectionList (Universe -> Universe,Universe -> Universe) -> Universe -> Universe optionScreenUpdate screen mop ldps sl u = @@ -55,17 +55,24 @@ optionScreenDefaultEffect f u = case u ^. uvWorld . input . pressedKeys . at Sca Just InitialPress -> fromMaybe id (f ^? pmoMenuOption . moEff) u _ -> u +-- ouch this is not good mouseClickOptionsList :: ScreenLayer -> Universe -> Universe mouseClickOptionsList screen u = fromMaybe u $ do sl <- screen ^? scSelectionList Just $ case u ^. uvWorld . input . mouseButtons . at ButtonLeft of Just False -> fromMaybe u $ do i <- sl ^. slSelPos - f <- sl ^? slItems . ix i . siPayload + f <- sl ^? slItems . ix i . siPayload . _1 return $ f u - _ -> u + _ -> case u ^. uvWorld . input . mouseButtons . at ButtonRight of + Just False -> fromMaybe u $ do + i <- sl ^. slSelPos + f <- sl ^? slItems . ix i . siPayload . _2 + return $ f u + _ -> u -mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe +mouseOverSelectionList :: ListDisplayParams + -> SelectionList a -> Universe -> Universe mouseOverSelectionList ldps sl u | x > xl && x < xr && ylower == yupper diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index e3b28f07b..c384ce6cf 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -121,7 +121,10 @@ preloadRender = do >>= addUniforms ["lightPos"] lightingLineShadowShad <- makeShaderUsingVAO "lighting/lineShadow" [vert,geom,frag] ELinesAdjacency shEdgeVAO - >>= addUniforms ["lightPos"] + >>= addUniforms ["lightPos","lumRad"] +-- positional shader + positionalBlankShad <- makeShader "positional/blank" [vert,frag] [3] ETriangles + -- 2D draw shaders bslist <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles bslista <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles @@ -199,6 +202,7 @@ preloadRender = do , _silhouetteEBO = silEBO , _lightingCapShader = lightingCapShad , _lightingLineShadowShader = lightingLineShadowShad + , _positionalBlankShader = positionalBlankShad , _lightingWallShadShader = lightingWallShadShad , _wallBlankShader = wallBlankShad , _wallTextureShader = wallTextureShad diff --git a/src/Render.hs b/src/Render.hs index ecc342f5c..d981847ad 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -7,6 +7,7 @@ module Render , bindTO , bindFBO ) where +import Dodge.Data.Config import Shader import Shader.ExtraPrimitive import Shader.Data @@ -20,7 +21,7 @@ import qualified Data.Vector.Unboxed.Mutable as UMV import qualified Data.Vector.Mutable as MV import Control.Monad.Primitive import Graphics.GL.Core43 -import Control.Monad +--import Control.Monad import qualified Data.Vector.Fusion.Stream.Monadic as VFSM divideSize :: Int -> Size -> Size @@ -33,7 +34,7 @@ createLightMap -> Int -- ^ number of walls -> Int -- ^ number of silhoutte lines to draw -> Int -- ^ number of "caps" to attempt to draw - -> Bool -- ^ whether to draw object shadows or not + -> ObjectShadows -- ^ whether to draw object shadows or not -> TextureObject -- ^ the texture object giving positions -> IO () createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos = do @@ -71,28 +72,32 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos = do (marshalEPrimitiveMode $ _shadPrim lwShad) 0 (fromIntegral nWalls) - when drawObjShads $ do - --draw silhouette shadows - currentProgram $= Just (_shadProg llsShad) - uniform (head $ _shadUnis $ _lightingLineShadowShader pdata) - $= Vector3 x y z - bindVertexArrayObject $= Just (_vao $ _shadVAO llsShad) - glDrawElements - (marshalEPrimitiveMode $ _shadPrim llsShad) - (fromIntegral nSils) - GL_UNSIGNED_SHORT - nullPtr - cullFace $= Just Back - --draw caps on the near plane as required - currentProgram $= Just (_shadProg lcShad) - uniform (head $ _shadUnis lcShad) - $= Vector3 x y z - bindVertexArrayObject $= Just (_vao $ _shadVAO lcShad) - glDrawElements - (marshalEPrimitiveMode $ _shadPrim lcShad) - (fromIntegral nCaps) - GL_UNSIGNED_SHORT - nullPtr + case drawObjShads of + GeoObjShads -> do + --draw silhouette shadows + currentProgram $= Just (_shadProg llsShad) + uniform (head $ _shadUnis $ _lightingLineShadowShader pdata) + $= Vector3 x y z + uniform (_shadUnis ltShad !! 1) + $= Vector4 r g b rad + bindVertexArrayObject $= Just (_vao $ _shadVAO llsShad) + glDrawElements + (marshalEPrimitiveMode $ _shadPrim llsShad) + (fromIntegral nSils) + GL_UNSIGNED_SHORT + nullPtr + --draw caps on the near plane as required + cullFace $= Just Back + currentProgram $= Just (_shadProg lcShad) + uniform (head $ _shadUnis lcShad) + $= Vector3 x y z + bindVertexArrayObject $= Just (_vao $ _shadVAO lcShad) + glDrawElements + (marshalEPrimitiveMode $ _shadPrim lcShad) + (fromIntegral nCaps) + GL_UNSIGNED_SHORT + nullPtr + _ -> return () --draw lightmap itself depthFunc $= Just Always -- bind world position texture