module Graphics.LambdaCube.GpuProgramParams where import Data.Map (Map) import qualified Data.Map as Map import Data.Word import Graphics.LambdaCube.Types {-| Enumeration of the types of constant we may encounter in programs. @note Low-level programs, by definition, will always use either float4 or int4 constant types since that is the fundamental underlying type in assembler. -} data GpuConstantType = GCT_FLOAT1 | GCT_FLOAT2 | GCT_FLOAT3 | GCT_FLOAT4 | GCT_SAMPLER1D | GCT_SAMPLER2D | GCT_SAMPLER3D | GCT_SAMPLERCUBE | GCT_SAMPLER1DSHADOW | GCT_SAMPLER2DSHADOW | GCT_MATRIX_2X2 | GCT_MATRIX_2X3 | GCT_MATRIX_2X4 | GCT_MATRIX_3X2 | GCT_MATRIX_3X3 | GCT_MATRIX_3X4 | GCT_MATRIX_4X2 | GCT_MATRIX_4X3 | GCT_MATRIX_4X4 | GCT_INT1 | GCT_INT2 | GCT_INT3 | GCT_INT4 | GCT_UNKNOWN deriving Eq {-| The variability of a GPU parameter, as derived from auto-params targetting it. These values must be powers of two since they are used in masks. -} data GpuParamVariability = GpuParamVariability { gpvGlobal :: Bool -- ^ No variation except by manual setting - the default , gpvPerObject :: Bool -- ^ Varies per object (based on an auto param usually), but not per light setup , gpvLights :: Bool -- ^ Varies with light setup , gpvPassIterationNumber :: Bool -- ^ Varies with pass iteration number } deriving Eq {- enum GpuParamVariability { GPV_GLOBAL = 1, -- | GPV_PER_OBJECT = 2, -- |Varies with light setup GPV_LIGHTS = 4, -- |Varies with pass iteration number GPV_PASS_ITERATION_NUMBER = 8, -- |Full mask (16-bit) GPV_ALL = 0xFFFF }; -} {-| Information about predefined program constants. @note Only available for high-level programs but is referenced generically by GpuProgramParameters. -} data GpuConstantDefinition = GpuConstantDefinition { gcdConstType :: GpuConstantType -- ^ Data type , gcdPhysicalIndex :: Int -- ^ Physical start index in buffer (either float or int buffer) , gcdLogicalIndex :: Int -- ^ Logical index - used to communicate this constant to the rendersystem {-| Number of raw buffer slots per element (some programs pack each array element to float4, some do not) -} , gcdElementSize :: Int , gcdArraySize :: Int -- ^ Length of array , gcdVariability :: GpuParamVariability -- ^ How this parameter varies (bitwise combination of GpuProgramVariability) } deriving Eq isFloat :: GpuConstantType -> Bool isFloat c = case c of { GCT_INT1 -> False ; GCT_INT2 -> False ; GCT_INT3 -> False ; GCT_INT4 -> False ; GCT_SAMPLER1D -> False ; GCT_SAMPLER2D -> False ; GCT_SAMPLER3D -> False ; GCT_SAMPLERCUBE -> False ; GCT_SAMPLER1DSHADOW -> False ; GCT_SAMPLER2DSHADOW -> False ; _ -> True } isSampler :: GpuConstantType -> Bool isSampler c = case c of { ; GCT_SAMPLER1D -> True ; GCT_SAMPLER2D -> True ; GCT_SAMPLER3D -> True ; GCT_SAMPLERCUBE -> True ; GCT_SAMPLER1DSHADOW -> True ; GCT_SAMPLER2DSHADOW -> True ; _ -> False } {-| Get the element size of a given type, including whether to pad the elements into multiples of 4 (e.g. SM1 and D3D does, GLSL doesn't) -} getElementSize :: GpuConstantType -> Bool -> Int getElementSize ctype padToMultiplesOf4 = case padToMultiplesOf4 of { True -> case ctype of { GCT_FLOAT1 -> 4 ; GCT_INT1 -> 4 ; GCT_SAMPLER1D -> 4 ; GCT_SAMPLER2D -> 4 ; GCT_SAMPLER3D -> 4 ; GCT_SAMPLERCUBE -> 4 ; GCT_SAMPLER1DSHADOW -> 4 ; GCT_SAMPLER2DSHADOW -> 4 ; GCT_FLOAT2 -> 4 ; GCT_INT2 -> 4 ; GCT_FLOAT3 -> 4 ; GCT_INT3 -> 4 ; GCT_FLOAT4 -> 4 ; GCT_INT4 -> 4 ; GCT_MATRIX_2X2 -> 8 ; GCT_MATRIX_2X3 -> 8 ; GCT_MATRIX_2X4 -> 8 ; GCT_MATRIX_3X2 -> 12 ; GCT_MATRIX_3X3 -> 12 ; GCT_MATRIX_3X4 -> 12 ; GCT_MATRIX_4X2 -> 16 ; GCT_MATRIX_4X3 -> 16 ; GCT_MATRIX_4X4 -> 16 ; _ -> 4 } ; False -> case ctype of { ; GCT_FLOAT1 -> 1 ; GCT_INT1 -> 1 ; GCT_SAMPLER1D -> 1 ; GCT_SAMPLER2D -> 1 ; GCT_SAMPLER3D -> 1 ; GCT_SAMPLERCUBE -> 1 ; GCT_SAMPLER1DSHADOW -> 1 ; GCT_SAMPLER2DSHADOW -> 1 ; GCT_FLOAT2 -> 2 ; GCT_INT2 -> 2 ; GCT_FLOAT3 -> 3 ; GCT_INT3 -> 3 ; GCT_FLOAT4 -> 4 ; GCT_INT4 -> 4 ; GCT_MATRIX_2X2 -> 4 ; GCT_MATRIX_2X3 -> 6 ; GCT_MATRIX_3X2 -> 6 ; GCT_MATRIX_2X4 -> 8 ; GCT_MATRIX_4X2 -> 8 ; GCT_MATRIX_3X3 -> 9 ; GCT_MATRIX_3X4 -> 12 ; GCT_MATRIX_4X3 -> 12 ; GCT_MATRIX_4X4 -> 16 ; _ -> 4 } } -- | Struct collecting together the information for named constants. data GpuNamedConstants = GpuNamedConstants { gncFloatBufferSize :: Int -- ^ Total size of the float buffer required , gncIntBufferSize :: Int -- ^ Total size of the int buffer required , gncMap :: Map String GpuConstantDefinition -- ^ Map of parameter names to GpuConstantDefinition {-| Indicates whether all array entries will be generated and added to the definitions map @remarks Normally, the number of array entries added to the definitions map is capped at 16 to save memory. Setting this value to true allows all of the entries to be generated and added to the map. -} , gncGenerateAllConstantDefinitionArrayEntries :: Bool } deriving Eq {-| Structure recording the use of a physical buffer by a logical parameter index. Only used for low-level programs. -} data GpuLogicalIndexUse = GpuLogicalIndexUse { gliPhysicalIndex :: Int -- ^ Physical buffer index , gliCurrentSize :: Int -- ^ Current physical size allocation , gliVariability :: Word16 -- ^ How the contents of this slot vary } deriving Eq -- | Container struct to allow params to safely & update shared list of logical buffer assignments data GpuLogicalBufferStruct = GpuLogicalBufferStruct { gluMap :: Map Int GpuLogicalIndexUse -- ^ Map from logical index to physical buffer location , gluBufferSize :: Int -- ^ Shortcut to know the buffer size needs } deriving Eq {-| A group of manually updated parameters that are shared between many parameter sets. @remarks Sometimes you want to set some common parameters across many otherwise different parameter sets, and keep them all in sync together. This class allows you to define a set of parameters that you can share across many parameter sets and have the parameters that match automatically be pulled from the shared set, rather than you having to set them on all the parameter sets individually. @par Parameters in a shared set are matched up with instances in a GpuProgramParameters structure by matching names. It is up to you to define the named parameters that a shared set contains, and ensuring the definition matches. @note Shared parameter sets can be named, and looked up using the GpuProgramManager. -} data GpuSharedParameters = GpuSharedParameters { gspNamedConstants :: GpuNamedConstants , gspFloatConstants :: [Float] , gspIntConstants :: [Int] , gspName :: String -- Optional data the rendersystem might want to store --mutable Any mRenderSystemData; , gspFrameLastUpdated :: Int -- ^ Not used when copying data, but might be useful to RS using shared buffers , gspVersion :: Int -- ^ Version number of the definitions in this buffer } deriving Eq -- list of physical mappings that we are going to bring in data CopyDataEntry = CopyDataEntry { cdeSrcDefinition :: GpuConstantDefinition , cdeDstDefinition :: GpuConstantDefinition } deriving Eq {-| This class records the usage of a set of shared parameters in a concrete set of GpuProgramParameters. -} data GpuSharedParametersUsage = GpuSharedParametersUsage { spuSharedParams :: GpuSharedParameters -- , spuParams :: GpuProgramParameters -- ^ Not a shared pointer since this is also parent , spuCopyDataList :: [CopyDataEntry] -- Optional data the rendersystem might want to store -- mutable Any mRenderSystemData; , spuCopyDataVersion :: Int -- ^ Version of shared params we based the copydata on } deriving Eq {-| Defines the types of automatically updated values that may be bound to GpuProgram parameters, or used to modify parameters on a per-object basis. -} data AutoConstantType = ACT_WORLD_MATRIX -- ^ The current world matrix | ACT_INVERSE_WORLD_MATRIX -- ^ The current world matrix, inverted {-|Provides transpose of world matrix. Equivalent to RenderMonkey's "WorldTranspose". -} | ACT_TRANSPOSE_WORLD_MATRIX | ACT_INVERSE_TRANSPOSE_WORLD_MATRIX -- ^ The current world matrix, inverted & transposed | ACT_WORLD_MATRIX_ARRAY_3x4 -- ^ The current array of world matrices, as a 3x4 matrix, used for blending | ACT_WORLD_MATRIX_ARRAY -- ^ The current array of world matrices, used for blending | ACT_VIEW_MATRIX -- ^ The current view matrix | ACT_INVERSE_VIEW_MATRIX -- ^ The current view matrix, inverted {-|Provides transpose of view matrix. Equivalent to RenderMonkey's "ViewTranspose". -} | ACT_TRANSPOSE_VIEW_MATRIX {-|Provides inverse transpose of view matrix. Equivalent to RenderMonkey's "ViewInverseTranspose". -} | ACT_INVERSE_TRANSPOSE_VIEW_MATRIX | ACT_PROJECTION_MATRIX -- ^ The current projection matrix {-|Provides inverse of projection matrix. Equivalent to RenderMonkey's "ProjectionInverse". -} | ACT_INVERSE_PROJECTION_MATRIX {-|Provides transpose of projection matrix. Equivalent to RenderMonkey's "ProjectionTranspose". -} | ACT_TRANSPOSE_PROJECTION_MATRIX {-|Provides inverse transpose of projection matrix. Equivalent to RenderMonkey's "ProjectionInverseTranspose". -} | ACT_INVERSE_TRANSPOSE_PROJECTION_MATRIX | ACT_VIEWPROJ_MATRIX -- ^ The current view & projection matrices concatenated {-|Provides inverse of concatenated view and projection matrices. Equivalent to RenderMonkey's "ViewProjectionInverse". -} | ACT_INVERSE_VIEWPROJ_MATRIX {-|Provides transpose of concatenated view and projection matrices. Equivalent to RenderMonkey's "ViewProjectionTranspose". -} | ACT_TRANSPOSE_VIEWPROJ_MATRIX {-|Provides inverse transpose of concatenated view and projection matrices. Equivalent to RenderMonkey's "ViewProjectionInverseTranspose". -} | ACT_INVERSE_TRANSPOSE_VIEWPROJ_MATRIX | ACT_WORLDVIEW_MATRIX -- ^ The current world & view matrices concatenated | ACT_INVERSE_WORLDVIEW_MATRIX -- ^ The current world & view matrices concatenated, then inverted {-|Provides transpose of concatenated world and view matrices. Equivalent to RenderMonkey's "WorldViewTranspose". -} | ACT_TRANSPOSE_WORLDVIEW_MATRIX | ACT_INVERSE_TRANSPOSE_WORLDVIEW_MATRIX -- ^ The current world & view matrices concatenated, then inverted & transposed -- |view matrices. | ACT_WORLDVIEWPROJ_MATRIX -- ^ The current world, view & projection matrices concatenated {-|Provides inverse of concatenated world, view and projection matrices. Equivalent to RenderMonkey's "WorldViewProjectionInverse". -} | ACT_INVERSE_WORLDVIEWPROJ_MATRIX {-|Provides transpose of concatenated world, view and projection matrices. Equivalent to RenderMonkey's "WorldViewProjectionTranspose". -} | ACT_TRANSPOSE_WORLDVIEWPROJ_MATRIX {-|Provides inverse transpose of concatenated world, view and projection matrices. Equivalent to RenderMonkey's "WorldViewProjectionInverseTranspose". -} | ACT_INVERSE_TRANSPOSE_WORLDVIEWPROJ_MATRIX -- |render target related values {-|-1 if requires texture flipping, +1 otherwise. It's useful when you bypassed projection matrix transform, still able use this value to adjust transformed y position. -} | ACT_RENDER_TARGET_FLIPPING | ACT_FOG_COLOUR -- ^ Fog colour | ACT_FOG_PARAMS -- ^ Fog params: density, linear start, linear end, 1/(end-start) | ACT_SURFACE_AMBIENT_COLOUR -- ^ Surface ambient colour, as set in Pass::setAmbient | ACT_SURFACE_DIFFUSE_COLOUR -- ^ Surface diffuse colour, as set in Pass::setDiffuse | ACT_SURFACE_SPECULAR_COLOUR -- ^ Surface specular colour, as set in Pass::setSpecular | ACT_SURFACE_EMISSIVE_COLOUR -- ^ Surface emissive colour, as set in Pass::setSelfIllumination | ACT_SURFACE_SHININESS -- ^ Surface shininess, as set in Pass::setShininess | ACT_LIGHT_COUNT -- ^ The number of active light sources (better than gl_MaxLights) | ACT_AMBIENT_LIGHT_COLOUR -- ^ The ambient light colour set in the scene | ACT_LIGHT_DIFFUSE_COLOUR -- ^ Light diffuse colour (index determined by setAutoConstant call) | ACT_LIGHT_SPECULAR_COLOUR -- ^ Light specular colour (index determined by setAutoConstant call) | ACT_LIGHT_ATTENUATION -- ^ Light attenuation parameters, Vector4(range, constant, linear, quadric) {-|Spotlight parameters, Vector4(innerFactor, outerFactor, falloff, isSpot) innerFactor and outerFactor are cos(angle/2) The isSpot parameter is 0.0f for non-spotlights, 1.0f for spotlights. Also for non-spotlights the inner and outer factors are 1 and nearly 1 respectively -} | ACT_SPOTLIGHT_PARAMS | ACT_LIGHT_POSITION -- ^ A light position in world space (index determined by setAutoConstant call) | ACT_LIGHT_POSITION_OBJECT_SPACE -- ^ A light position in object space (index determined by setAutoConstant call) | ACT_LIGHT_POSITION_VIEW_SPACE -- ^ A light position in view space (index determined by setAutoConstant call) | ACT_LIGHT_DIRECTION -- ^ A light direction in world space (index determined by setAutoConstant call) | ACT_LIGHT_DIRECTION_OBJECT_SPACE -- ^ A light direction in object space (index determined by setAutoConstant call) | ACT_LIGHT_DIRECTION_VIEW_SPACE -- ^ A light direction in view space (index determined by setAutoConstant call) {-|The distance of the light from the center of the object a useful approximation as an alternative to per-vertex distance calculations. -} | ACT_LIGHT_DISTANCE_OBJECT_SPACE {-|Light power level, a single scalar as set in Light::setPowerScale (index determined by setAutoConstant call) -} | ACT_LIGHT_POWER_SCALE -- |Light diffuse colour pre-scaled by Light::setPowerScale (index determined by setAutoConstant call) | ACT_LIGHT_DIFFUSE_COLOUR_POWER_SCALED -- |Light specular colour pre-scaled by Light::setPowerScale (index determined by setAutoConstant call) | ACT_LIGHT_SPECULAR_COLOUR_POWER_SCALED -- |Array of light diffuse colours (count set by extra param) | ACT_LIGHT_DIFFUSE_COLOUR_ARRAY -- |Array of light specular colours (count set by extra param) | ACT_LIGHT_SPECULAR_COLOUR_ARRAY -- |Array of light diffuse colours scaled by light power (count set by extra param) | ACT_LIGHT_DIFFUSE_COLOUR_POWER_SCALED_ARRAY -- |Array of light specular colours scaled by light power (count set by extra param) | ACT_LIGHT_SPECULAR_COLOUR_POWER_SCALED_ARRAY -- |Array of light attenuation parameters, Vector4(range, constant, linear, quadric) (count set by extra param) | ACT_LIGHT_ATTENUATION_ARRAY -- |Array of light positions in world space (count set by extra param) | ACT_LIGHT_POSITION_ARRAY -- |Array of light positions in object space (count set by extra param) | ACT_LIGHT_POSITION_OBJECT_SPACE_ARRAY -- |Array of light positions in view space (count set by extra param) | ACT_LIGHT_POSITION_VIEW_SPACE_ARRAY -- |Array of light directions in world space (count set by extra param) | ACT_LIGHT_DIRECTION_ARRAY -- |Array of light directions in object space (count set by extra param) | ACT_LIGHT_DIRECTION_OBJECT_SPACE_ARRAY -- |Array of light directions in view space (count set by extra param) | ACT_LIGHT_DIRECTION_VIEW_SPACE_ARRAY {-|Array of distances of the lights from the center of the object a useful approximation as an alternative to per-vertex distance calculations. (count set by extra param) -} | ACT_LIGHT_DISTANCE_OBJECT_SPACE_ARRAY {-|Array of light power levels, a single scalar as set in Light::setPowerScale (count set by extra param) -} | ACT_LIGHT_POWER_SCALE_ARRAY {-|Spotlight parameters array of Vector4(innerFactor, outerFactor, falloff, isSpot) innerFactor and outerFactor are cos(angle/2) The isSpot parameter is 0.0f for non-spotlights, 1.0f for spotlights. Also for non-spotlights the inner and outer factors are 1 and nearly 1 respectively. (count set by extra param) -} | ACT_SPOTLIGHT_PARAMS_ARRAY {-|The derived ambient light colour, with 'r', 'g', 'b' components filled with product of surface ambient colour and ambient light colour, respectively, and 'a' component filled with surface ambient alpha component. -} | ACT_DERIVED_AMBIENT_LIGHT_COLOUR {-|The derived scene colour, with 'r', 'g' and 'b' components filled with sum of derived ambient light colour and surface emissive colour, respectively, and 'a' component filled with surface diffuse alpha component. -} | ACT_DERIVED_SCENE_COLOUR {-|The derived light diffuse colour (index determined by setAutoConstant call), with 'r', 'g' and 'b' components filled with product of surface diffuse colour, light power scale and light diffuse colour, respectively, and 'a' component filled with surface diffuse alpha component. -} | ACT_DERIVED_LIGHT_DIFFUSE_COLOUR {-|The derived light specular colour (index determined by setAutoConstant call), with 'r', 'g' and 'b' components filled with product of surface specular colour and light specular colour, respectively, and 'a' component filled with surface specular alpha component. -} | ACT_DERIVED_LIGHT_SPECULAR_COLOUR -- |Array of derived light diffuse colours (count set by extra param) | ACT_DERIVED_LIGHT_DIFFUSE_COLOUR_ARRAY -- |Array of derived light specular colours (count set by extra param) | ACT_DERIVED_LIGHT_SPECULAR_COLOUR_ARRAY {-|The absolute light number of a local light index. Each pass may have a number of lights passed to it, and each of these lights will have an index in the overall light list, which will differ from the local light index due to factors like setStartLight and setIteratePerLight. This binding provides the global light index for a local index. -} | ACT_LIGHT_NUMBER -- |Returns (int) 1 if the given light casts shadows, 0 otherwise (index set in extra param) | ACT_LIGHT_CASTS_SHADOWS {-|The distance a shadow volume should be extruded when using finite extrusion programs. -} | ACT_SHADOW_EXTRUSION_DISTANCE -- |The current camera's position in world space | ACT_CAMERA_POSITION -- |The current camera's position in object space | ACT_CAMERA_POSITION_OBJECT_SPACE -- |The view/projection matrix of the assigned texture projection frustum | ACT_TEXTURE_VIEWPROJ_MATRIX -- |Array of view/projection matrices of the first n texture projection frustums | ACT_TEXTURE_VIEWPROJ_MATRIX_ARRAY {-|The view/projection matrix of the assigned texture projection frustum, combined with the current world matrix -} | ACT_TEXTURE_WORLDVIEWPROJ_MATRIX -- |Array of world/view/projection matrices of the first n texture projection frustums | ACT_TEXTURE_WORLDVIEWPROJ_MATRIX_ARRAY -- |The view/projection matrix of a given spotlight | ACT_SPOTLIGHT_VIEWPROJ_MATRIX {-|The view/projection matrix of a given spotlight projection frustum, combined with the current world matrix -} | ACT_SPOTLIGHT_WORLDVIEWPROJ_MATRIX -- |A custom parameter which will come from the renderable, using 'data' as the identifier | ACT_CUSTOM {-|provides current elapsed time -} | ACT_TIME {-|Single float value, which repeats itself based on given as parameter "cycle time". Equivalent to RenderMonkey's "Time0_X". -} | ACT_TIME_0_X -- |Cosine of "Time0_X". Equivalent to RenderMonkey's "CosTime0_X". | ACT_COSTIME_0_X -- |Sine of "Time0_X". Equivalent to RenderMonkey's "SinTime0_X". | ACT_SINTIME_0_X -- |Tangent of "Time0_X". Equivalent to RenderMonkey's "TanTime0_X". | ACT_TANTIME_0_X {-|Vector of "Time0_X", "SinTime0_X", "CosTime0_X", "TanTime0_X". Equivalent to RenderMonkey's "Time0_X_Packed". -} | ACT_TIME_0_X_PACKED {-|Single float value, which represents scaled time value [0..1], which repeats itself based on given as parameter "cycle time". Equivalent to RenderMonkey's "Time0_1". -} | ACT_TIME_0_1 -- |Cosine of "Time0_1". Equivalent to RenderMonkey's "CosTime0_1". | ACT_COSTIME_0_1 -- |Sine of "Time0_1". Equivalent to RenderMonkey's "SinTime0_1". | ACT_SINTIME_0_1 -- |Tangent of "Time0_1". Equivalent to RenderMonkey's "TanTime0_1". | ACT_TANTIME_0_1 {-|Vector of "Time0_1", "SinTime0_1", "CosTime0_1", "TanTime0_1". Equivalent to RenderMonkey's "Time0_1_Packed". -} | ACT_TIME_0_1_PACKED {-|Single float value, which represents scaled time value [0..2*Pi], which repeats itself based on given as parameter "cycle time". Equivalent to RenderMonkey's "Time0_2PI". -} | ACT_TIME_0_2PI -- |Cosine of "Time0_2PI". Equivalent to RenderMonkey's "CosTime0_2PI". | ACT_COSTIME_0_2PI -- |Sine of "Time0_2PI". Equivalent to RenderMonkey's "SinTime0_2PI". | ACT_SINTIME_0_2PI -- |Tangent of "Time0_2PI". Equivalent to RenderMonkey's "TanTime0_2PI". | ACT_TANTIME_0_2PI {-|Vector of "Time0_2PI", "SinTime0_2PI", "CosTime0_2PI", "TanTime0_2PI". Equivalent to RenderMonkey's "Time0_2PI_Packed". -} | ACT_TIME_0_2PI_PACKED -- |provides the scaled frame time, returned as a floating point value. | ACT_FRAME_TIME -- |provides the calculated frames per second, returned as a floating point value. | ACT_FPS -- |viewport-related values {-|Current viewport width (in pixels) as floating point value. Equivalent to RenderMonkey's "ViewportWidth". -} | ACT_VIEWPORT_WIDTH {-|Current viewport height (in pixels) as floating point value. Equivalent to RenderMonkey's "ViewportHeight". -} | ACT_VIEWPORT_HEIGHT {-|This variable represents 1.0/ViewportWidth. Equivalent to RenderMonkey's "ViewportWidthInverse". -} | ACT_INVERSE_VIEWPORT_WIDTH {-|This variable represents 1.0/ViewportHeight. Equivalent to RenderMonkey's "ViewportHeightInverse". -} | ACT_INVERSE_VIEWPORT_HEIGHT {-|Packed of "ViewportWidth", "ViewportHeight", "ViewportWidthInverse", "ViewportHeightInverse". -} | ACT_VIEWPORT_SIZE -- |view parameters {-|This variable provides the view direction vector (world space). Equivalent to RenderMonkey's "ViewDirection". -} | ACT_VIEW_DIRECTION {-|This variable provides the view side vector (world space). Equivalent to RenderMonkey's "ViewSideVector". -} | ACT_VIEW_SIDE_VECTOR {-|This variable provides the view up vector (world space). Equivalent to RenderMonkey's "ViewUpVector". -} | ACT_VIEW_UP_VECTOR {-|This variable provides the field of view as a floating point value. Equivalent to RenderMonkey's "FOV". -} | ACT_FOV {-|This variable provides the near clip distance as a floating point value. Equivalent to RenderMonkey's "NearClipPlane". -} | ACT_NEAR_CLIP_DISTANCE {-|This variable provides the far clip distance as a floating point value. Equivalent to RenderMonkey's "FarClipPlane". -} | ACT_FAR_CLIP_DISTANCE {-|provides the pass index number within the technique of the active materil. -} | ACT_PASS_NUMBER {-|provides the current iteration number of the pass. The iteration number is the number of times the current render operation has been drawn for the active pass. -} | ACT_PASS_ITERATION_NUMBER {-|Provides a parametric animation value [0..1], only available where the renderable specifically implements it. -} | ACT_ANIMATION_PARAMETRIC {-|Provides the texel offsets required by this rendersystem to map texels to pixels. Packed as float4(absoluteHorizontalOffset, absoluteVerticalOffset, horizontalOffset / viewportWidth, verticalOffset / viewportHeight) -} | ACT_TEXEL_OFFSETS {-|Provides information about the depth range of the scene as viewed from the current camera. Passed as float4(minDepth, maxDepth, depthRange, 1 / depthRange) -} | ACT_SCENE_DEPTH_RANGE {-|Provides information about the depth range of the scene as viewed from a given shadow camera. Requires an index parameter which maps to a light index relative to the current light list. Passed as float4(minDepth, maxDepth, depthRange, 1 / depthRange) -} | ACT_SHADOW_SCENE_DEPTH_RANGE {-|Provides the fixed shadow colour as configured via SceneManager::setShadowColour; useful for integrated modulative shadows. -} | ACT_SHADOW_COLOUR {-|Provides texture size of the texture unit (index determined by setAutoConstant call). Packed as float4(width, height, depth, 1) -} | ACT_TEXTURE_SIZE {-|Provides inverse texture size of the texture unit (index determined by setAutoConstant call). Packed as float4(1 / width, 1 / height, 1 / depth, 1) -} | ACT_INVERSE_TEXTURE_SIZE {-|Provides packed texture size of the texture unit (index determined by setAutoConstant call). Packed as float4(width, height, 1 / width, 1 / height) -} | ACT_PACKED_TEXTURE_SIZE {-|Provides the current transform matrix of the texture unit (index determined by setAutoConstant call), as seen by the fixed-function pipeline. -} | ACT_TEXTURE_MATRIX {-|Provides the position of the LOD camera in world space, allowing you to perform separate LOD calculations in shaders independent of the rendering camera. If there is no separate LOD camera then this is the real camera position. See Camera::setLodCamera. -} | ACT_LOD_CAMERA_POSITION {-|Provides the position of the LOD camera in object space, allowing you to perform separate LOD calculations in shaders independent of the rendering camera. If there is no separate LOD camera then this is the real camera position. See Camera::setLodCamera. -} | ACT_LOD_CAMERA_POSITION_OBJECT_SPACE {-|Binds custom per-light constants to the shaders. -} | ACT_LIGHT_CUSTOM deriving Eq -- | Defines the type of the extra data item used by the auto constant. data ACDataType = ACDT_NONE -- ^ no data is required | ACDT_INT -- ^ the auto constant requires data of type int | ACDT_REAL -- ^ the auto constant requires data of type real deriving Eq -- | Defines the base element type of the auto constant data ElementType = ET_INT | ET_REAL deriving Eq {-| Structure defining an auto constant that's available for use in a parameters object. -} data AutoConstantDefinition = AutoConstantDefinition { acdType :: AutoConstantType , acdName :: String , acdElementCount :: Int , acdElementType :: ElementType -- ^ The type of the constant in the program , acdDataType :: ACDataType -- ^ The type of any extra data } deriving Eq {-| Structure recording the use of an automatic parameter. -} data AutoConstantEntry = AutoConstantEntry { aceParamType :: AutoConstantType -- ^ The type of parameter , acePhysicalIndex :: Int -- ^ The target (physical) constant index {-| The number of elements per individual entry in this constant Used in case people used packed elements smaller than 4 (e.g. GLSL) and bind an auto which is 4-element packed to it -} , aceElementCount :: Int -- | Additional information to go with the parameter -- union{ -- size_t data; -- Real fData; -- }; , aceVariability :: GpuParamVariability -- ^ The variability of this parameter (see GpuParamVariability) } deriving Eq {-| Collects together the program parameters used for a GpuProgram. @remarks Gpu program state includes constant parameters used by the program, and bindings to render system state which is propagated into the constants by the engine automatically if requested. @par GpuProgramParameters objects should be created through the GpuProgram and may be shared between multiple Pass instances. For this reason they are managed using a shared pointer, which will ensure they are automatically deleted when no Pass is using them anymore. @par High-level programs use named parameters (uniforms), low-level programs use indexed constants. This class supports both, but you can tell whether named constants are supported by calling hasNamedParameters(). There are references in the documentation below to 'logical' and 'physical' indexes; logical indexes are the indexes used by low-level programs and represent indexes into an array of float4's, some of which may be settable, some of which may be predefined constants in the program. We only store those constants which have actually been set, therefore our buffer could have gaps if we used the logical indexes in our own buffers. So instead we map these logical indexes to physical indexes in our buffer. When using high-level programs, logical indexes don't necessarily exist, although they might if the high-level program has a direct, exposed mapping from parameter names to logical indexes. In addition, high-level languages may or may not pack arrays of elements that are smaller than float4 (e.g. float2/vec2) contiguously. This kind of information is held in the ConstantDefinition structure which is only populated for high-level programs. You don't have to worry about any of this unless you intend to read parameters back from this structure rather than just setting them. -} --data GpuProgramParameters' -- = GpuProgramParameters' -- { ---- static AutoConstantDefinition AutoConstantDictionary[]; -- gppFloatConstants :: [Float] -- ^ Packed list of floating-point constants (physical indexing) -- , gppIntConstants :: [Int] -- ^ Packed list of integer constants (physical indexing) -- {-| Logical index to physical index map - for low-level programs -- or high-level programs which pass params this way. -} -- , gppFloatLogicalToPhysical :: GpuLogicalBufferStruct -- {-| Logical index to physical index map - for low-level programs -- or high-level programs which pass params this way. -} -- , gppIntLogicalToPhysical :: GpuLogicalBufferStruct -- , gppNamedConstants :: GpuNamedConstants -- ^ Mapping from parameter names to def - high-level programs are expected to populate this -- , gppAutoConstants :: [AutoConstantEntry] -- ^ List of automatically updated parameters -- , gppCombinedVariability :: GpuParamVariability -- ^ The combined variability masks of all parameters -- , gppTransposeMatrices :: Bool -- ^ Do we need to transpose matrices? -- , gppIgnoreMissingParams :: Bool -- ^ flag to indicate if names not found will be ignored -- , gppActivePassIterationIndex :: Int -- ^ physical index for active pass iteration parameter real constant entry; -- , gppSharedParamSets :: [GpuSharedParametersUsage] ---- -- Optional data the rendersystem might want to store ---- mutable Any mRenderSystemData; -- } -- deriving Eq -- TEMP CODE data GpuProgramParameters = GpuProgramParameters { gppNamedConstants :: [GpuNamedConstant] } data GpuNamedConstant = GpuNamedConstant { gncName :: String , gncType :: ElementType , gncIntValues :: [Int] , gncFloatValues :: [FloatType] } autoConstantDictionary = [ (ACT_WORLD_MATRIX, "world_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_WORLD_MATRIX, "inverse_world_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_TRANSPOSE_WORLD_MATRIX, "transpose_world_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_TRANSPOSE_WORLD_MATRIX, "inverse_transpose_world_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_WORLD_MATRIX_ARRAY_3x4, "world_matrix_array_3x4", 12, ET_REAL, ACDT_NONE) , (ACT_WORLD_MATRIX_ARRAY, "world_matrix_array", 16, ET_REAL, ACDT_NONE) , (ACT_VIEW_MATRIX, "view_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_VIEW_MATRIX, "inverse_view_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_TRANSPOSE_VIEW_MATRIX, "transpose_view_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_TRANSPOSE_VIEW_MATRIX, "inverse_transpose_view_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_PROJECTION_MATRIX, "projection_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_PROJECTION_MATRIX, "inverse_projection_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_TRANSPOSE_PROJECTION_MATRIX, "transpose_projection_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_TRANSPOSE_PROJECTION_MATRIX, "inverse_transpose_projection_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_VIEWPROJ_MATRIX, "viewproj_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_VIEWPROJ_MATRIX, "inverse_viewproj_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_TRANSPOSE_VIEWPROJ_MATRIX, "transpose_viewproj_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_TRANSPOSE_VIEWPROJ_MATRIX, "inverse_transpose_viewproj_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_WORLDVIEW_MATRIX, "worldview_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_WORLDVIEW_MATRIX, "inverse_worldview_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_TRANSPOSE_WORLDVIEW_MATRIX, "transpose_worldview_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_TRANSPOSE_WORLDVIEW_MATRIX, "inverse_transpose_worldview_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_WORLDVIEWPROJ_MATRIX, "worldviewproj_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_WORLDVIEWPROJ_MATRIX, "inverse_worldviewproj_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_TRANSPOSE_WORLDVIEWPROJ_MATRIX, "transpose_worldviewproj_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_INVERSE_TRANSPOSE_WORLDVIEWPROJ_MATRIX, "inverse_transpose_worldviewproj_matrix", 16, ET_REAL, ACDT_NONE) , (ACT_RENDER_TARGET_FLIPPING, "render_target_flipping", 1, ET_REAL, ACDT_NONE) , (ACT_FOG_COLOUR, "fog_colour", 4, ET_REAL, ACDT_NONE) , (ACT_FOG_PARAMS, "fog_params", 4, ET_REAL, ACDT_NONE) , (ACT_SURFACE_AMBIENT_COLOUR, "surface_ambient_colour", 4, ET_REAL, ACDT_NONE) , (ACT_SURFACE_DIFFUSE_COLOUR, "surface_diffuse_colour", 4, ET_REAL, ACDT_NONE) , (ACT_SURFACE_SPECULAR_COLOUR, "surface_specular_colour", 4, ET_REAL, ACDT_NONE) , (ACT_SURFACE_EMISSIVE_COLOUR, "surface_emissive_colour", 4, ET_REAL, ACDT_NONE) , (ACT_SURFACE_SHININESS, "surface_shininess", 1, ET_REAL, ACDT_NONE) , (ACT_LIGHT_COUNT, "light_count", 1, ET_REAL, ACDT_NONE) , (ACT_AMBIENT_LIGHT_COLOUR, "ambient_light_colour", 4, ET_REAL, ACDT_NONE) , (ACT_LIGHT_DIFFUSE_COLOUR, "light_diffuse_colour", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_SPECULAR_COLOUR, "light_specular_colour", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_ATTENUATION, "light_attenuation", 4, ET_REAL, ACDT_INT) , (ACT_SPOTLIGHT_PARAMS, "spotlight_params", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_POSITION, "light_position", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_POSITION_OBJECT_SPACE, "light_position_object_space", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_POSITION_VIEW_SPACE, "light_position_view_space", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIRECTION, "light_direction", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIRECTION_OBJECT_SPACE, "light_direction_object_space", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIRECTION_VIEW_SPACE, "light_direction_view_space", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DISTANCE_OBJECT_SPACE, "light_distance_object_space", 1, ET_REAL, ACDT_INT) , (ACT_LIGHT_POWER_SCALE, "light_power", 1, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIFFUSE_COLOUR_POWER_SCALED, "light_diffuse_colour_power_scaled", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_SPECULAR_COLOUR_POWER_SCALED, "light_specular_colour_power_scaled", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIFFUSE_COLOUR_ARRAY, "light_diffuse_colour_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_SPECULAR_COLOUR_ARRAY, "light_specular_colour_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIFFUSE_COLOUR_POWER_SCALED_ARRAY, "light_diffuse_colour_power_scaled_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_SPECULAR_COLOUR_POWER_SCALED_ARRAY, "light_specular_colour_power_scaled_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_ATTENUATION_ARRAY, "light_attenuation_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_POSITION_ARRAY, "light_position_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_POSITION_OBJECT_SPACE_ARRAY, "light_position_object_space_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_POSITION_VIEW_SPACE_ARRAY, "light_position_view_space_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIRECTION_ARRAY, "light_direction_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIRECTION_OBJECT_SPACE_ARRAY, "light_direction_object_space_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DIRECTION_VIEW_SPACE_ARRAY, "light_direction_view_space_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_DISTANCE_OBJECT_SPACE_ARRAY, "light_distance_object_space_array", 1, ET_REAL, ACDT_INT) , (ACT_LIGHT_POWER_SCALE_ARRAY, "light_power_array", 1, ET_REAL, ACDT_INT) , (ACT_SPOTLIGHT_PARAMS_ARRAY, "spotlight_params_array", 4, ET_REAL, ACDT_INT) , (ACT_DERIVED_AMBIENT_LIGHT_COLOUR, "derived_ambient_light_colour", 4, ET_REAL, ACDT_NONE) , (ACT_DERIVED_SCENE_COLOUR, "derived_scene_colour", 4, ET_REAL, ACDT_NONE) , (ACT_DERIVED_LIGHT_DIFFUSE_COLOUR, "derived_light_diffuse_colour", 4, ET_REAL, ACDT_INT) , (ACT_DERIVED_LIGHT_SPECULAR_COLOUR, "derived_light_specular_colour", 4, ET_REAL, ACDT_INT) , (ACT_DERIVED_LIGHT_DIFFUSE_COLOUR_ARRAY, "derived_light_diffuse_colour_array", 4, ET_REAL, ACDT_INT) , (ACT_DERIVED_LIGHT_SPECULAR_COLOUR_ARRAY, "derived_light_specular_colour_array", 4, ET_REAL, ACDT_INT) , (ACT_LIGHT_NUMBER, "light_number", 1, ET_REAL, ACDT_INT) , (ACT_LIGHT_CASTS_SHADOWS, "light_casts_shadows", 1, ET_REAL, ACDT_INT) , (ACT_SHADOW_EXTRUSION_DISTANCE, "shadow_extrusion_distance", 1, ET_REAL, ACDT_INT) , (ACT_CAMERA_POSITION, "camera_position", 3, ET_REAL, ACDT_NONE) , (ACT_CAMERA_POSITION_OBJECT_SPACE, "camera_position_object_space", 3, ET_REAL, ACDT_NONE) , (ACT_TEXTURE_VIEWPROJ_MATRIX, "texture_viewproj_matrix", 16, ET_REAL, ACDT_INT) , (ACT_TEXTURE_VIEWPROJ_MATRIX_ARRAY, "texture_viewproj_matrix_array", 16, ET_REAL, ACDT_INT) , (ACT_TEXTURE_WORLDVIEWPROJ_MATRIX, "texture_worldviewproj_matrix", 16, ET_REAL, ACDT_INT) , (ACT_TEXTURE_WORLDVIEWPROJ_MATRIX_ARRAY, "texture_worldviewproj_matrix_array", 16, ET_REAL, ACDT_INT) , (ACT_SPOTLIGHT_VIEWPROJ_MATRIX, "spotlight_viewproj_matrix", 16, ET_REAL, ACDT_INT) , (ACT_SPOTLIGHT_WORLDVIEWPROJ_MATRIX, "spotlight_worldviewproj_matrix", 16, ET_REAL, ACDT_INT) , (ACT_CUSTOM, "custom", 4, ET_REAL, ACDT_INT) -- *** needs to be tested , (ACT_TIME, "time", 1, ET_REAL, ACDT_REAL) , (ACT_TIME_0_X, "time_0_x", 4, ET_REAL, ACDT_REAL) , (ACT_COSTIME_0_X, "costime_0_x", 4, ET_REAL, ACDT_REAL) , (ACT_SINTIME_0_X, "sintime_0_x", 4, ET_REAL, ACDT_REAL) , (ACT_TANTIME_0_X, "tantime_0_x", 4, ET_REAL, ACDT_REAL) , (ACT_TIME_0_X_PACKED, "time_0_x_packed", 4, ET_REAL, ACDT_REAL) , (ACT_TIME_0_1, "time_0_1", 4, ET_REAL, ACDT_REAL) , (ACT_COSTIME_0_1, "costime_0_1", 4, ET_REAL, ACDT_REAL) , (ACT_SINTIME_0_1, "sintime_0_1", 4, ET_REAL, ACDT_REAL) , (ACT_TANTIME_0_1, "tantime_0_1", 4, ET_REAL, ACDT_REAL) , (ACT_TIME_0_1_PACKED, "time_0_1_packed", 4, ET_REAL, ACDT_REAL) , (ACT_TIME_0_2PI, "time_0_2pi", 4, ET_REAL, ACDT_REAL) , (ACT_COSTIME_0_2PI, "costime_0_2pi", 4, ET_REAL, ACDT_REAL) , (ACT_SINTIME_0_2PI, "sintime_0_2pi", 4, ET_REAL, ACDT_REAL) , (ACT_TANTIME_0_2PI, "tantime_0_2pi", 4, ET_REAL, ACDT_REAL) , (ACT_TIME_0_2PI_PACKED, "time_0_2pi_packed", 4, ET_REAL, ACDT_REAL) , (ACT_FRAME_TIME, "frame_time", 1, ET_REAL, ACDT_REAL) , (ACT_FPS, "fps", 1, ET_REAL, ACDT_NONE) , (ACT_VIEWPORT_WIDTH, "viewport_width", 1, ET_REAL, ACDT_NONE) , (ACT_VIEWPORT_HEIGHT, "viewport_height", 1, ET_REAL, ACDT_NONE) , (ACT_INVERSE_VIEWPORT_WIDTH, "inverse_viewport_width", 1, ET_REAL, ACDT_NONE) , (ACT_INVERSE_VIEWPORT_HEIGHT, "inverse_viewport_height", 1, ET_REAL, ACDT_NONE) , (ACT_VIEWPORT_SIZE, "viewport_size", 4, ET_REAL, ACDT_NONE) , (ACT_VIEW_DIRECTION, "view_direction", 3, ET_REAL, ACDT_NONE) , (ACT_VIEW_SIDE_VECTOR, "view_side_vector", 3, ET_REAL, ACDT_NONE) , (ACT_VIEW_UP_VECTOR, "view_up_vector", 3, ET_REAL, ACDT_NONE) , (ACT_FOV, "fov", 1, ET_REAL, ACDT_NONE) , (ACT_NEAR_CLIP_DISTANCE, "near_clip_distance", 1, ET_REAL, ACDT_NONE) , (ACT_FAR_CLIP_DISTANCE, "far_clip_distance", 1, ET_REAL, ACDT_NONE) , (ACT_PASS_NUMBER, "pass_number", 1, ET_REAL, ACDT_NONE) , (ACT_PASS_ITERATION_NUMBER, "pass_iteration_number", 1, ET_REAL, ACDT_NONE) , (ACT_ANIMATION_PARAMETRIC, "animation_parametric", 4, ET_REAL, ACDT_INT) , (ACT_TEXEL_OFFSETS, "texel_offsets", 4, ET_REAL, ACDT_NONE) , (ACT_SCENE_DEPTH_RANGE, "scene_depth_range", 4, ET_REAL, ACDT_NONE) , (ACT_SHADOW_SCENE_DEPTH_RANGE, "shadow_scene_depth_range", 4, ET_REAL, ACDT_INT) , (ACT_SHADOW_COLOUR, "shadow_colour", 4, ET_REAL, ACDT_NONE) , (ACT_TEXTURE_SIZE, "texture_size", 4, ET_REAL, ACDT_INT) , (ACT_INVERSE_TEXTURE_SIZE, "inverse_texture_size", 4, ET_REAL, ACDT_INT) , (ACT_PACKED_TEXTURE_SIZE, "packed_texture_size", 4, ET_REAL, ACDT_INT) , (ACT_TEXTURE_MATRIX, "texture_matrix", 16, ET_REAL, ACDT_INT) , (ACT_LOD_CAMERA_POSITION, "lod_camera_position", 3, ET_REAL, ACDT_NONE) , (ACT_LOD_CAMERA_POSITION_OBJECT_SPACE, "lod_camera_position_object_space", 3, ET_REAL, ACDT_NONE) , (ACT_LIGHT_CUSTOM, "light_custom", 4, ET_REAL, ACDT_INT) ]