module Graphics.LambdaCube.GpuProgramParams where import Data.Map (Map) import Data.Word import Graphics.LambdaCube.Types -- | The types of constants we may encounter in programs. 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. 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 -- | Information about predefined program constants. 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 , gcdElementSize :: Int -- ^ Number of raw buffer slots per element (some programs pack each array element to float4, some do not) , 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 | padToMultiplesOf4 = 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 | otherwise = 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 , 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 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. data GpuSharedParameters = GpuSharedParameters { gspNamedConstants :: GpuNamedConstants , gspFloatConstants :: [Float] , gspIntConstants :: [Int] , gspName :: String , 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 -- | The list of physical mappings that we are going to bring in. data CopyDataEntry = CopyDataEntry { cdeSrcDefinition :: GpuConstantDefinition , cdeDstDefinition :: GpuConstantDefinition } deriving Eq -- | The usage of a set of shared parameters in a concrete set of -- GpuProgramParameters. data GpuSharedParametersUsage = GpuSharedParametersUsage { spuSharedParams :: GpuSharedParameters , spuCopyDataList :: [CopyDataEntry] , spuCopyDataVersion :: Int -- ^ Version of shared params we based the copydata on } deriving Eq -- | 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 | ACT_TRANSPOSE_WORLD_MATRIX -- ^ Provides transpose of world matrix. Equivalent to RenderMonkey's "WorldTranspose". | 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 | ACT_TRANSPOSE_VIEW_MATRIX -- ^ Provides transpose of view matrix. Equivalent to RenderMonkey's "ViewTranspose". | ACT_INVERSE_TRANSPOSE_VIEW_MATRIX -- ^ Provides inverse transpose of view matrix. Equivalent to RenderMonkey's "ViewInverseTranspose". | ACT_PROJECTION_MATRIX -- ^ The current projection matrix | ACT_INVERSE_PROJECTION_MATRIX -- ^ Provides inverse of projection matrix. Equivalent to RenderMonkey's "ProjectionInverse". | ACT_TRANSPOSE_PROJECTION_MATRIX -- ^ Provides transpose of projection matrix. Equivalent to RenderMonkey's "ProjectionTranspose". | ACT_INVERSE_TRANSPOSE_PROJECTION_MATRIX -- ^ Provides inverse transpose of projection matrix. Equivalent to RenderMonkey's "ProjectionInverseTranspose". | ACT_VIEWPROJ_MATRIX -- ^ The current view & projection matrices concatenated | ACT_INVERSE_VIEWPROJ_MATRIX -- ^ Provides inverse of concatenated view and projection matrices. Equivalent to RenderMonkey's "ViewProjectionInverse". | ACT_TRANSPOSE_VIEWPROJ_MATRIX -- ^ Provides transpose of concatenated view and projection matrices. Equivalent to RenderMonkey's "ViewProjectionTranspose". | ACT_INVERSE_TRANSPOSE_VIEWPROJ_MATRIX -- ^ Provides inverse transpose of concatenated view and projection matrices. Equivalent to RenderMonkey's "ViewProjectionInverseTranspose". | ACT_WORLDVIEW_MATRIX -- ^ The current world & view matrices concatenated | ACT_INVERSE_WORLDVIEW_MATRIX -- ^ The current world & view matrices concatenated, then inverted | ACT_TRANSPOSE_WORLDVIEW_MATRIX -- ^ Provides transpose of concatenated world and view matrices. Equivalent to RenderMonkey's "WorldViewTranspose". | ACT_INVERSE_TRANSPOSE_WORLDVIEW_MATRIX -- ^ The current world & view matrices concatenated, then inverted & transposed | ACT_WORLDVIEWPROJ_MATRIX -- ^ The current world, view & projection matrices concatenated | ACT_INVERSE_WORLDVIEWPROJ_MATRIX -- ^ Provides inverse of concatenated world, view and projection matrices. Equivalent to RenderMonkey's "WorldViewProjectionInverse". | ACT_TRANSPOSE_WORLDVIEWPROJ_MATRIX -- ^ Provides transpose of concatenated world, view and projection matrices. Equivalent to RenderMonkey's "WorldViewProjectionTranspose". | ACT_INVERSE_TRANSPOSE_WORLDVIEWPROJ_MATRIX -- ^ Provides inverse transpose of concatenated world, view and projection matrices. Equivalent to RenderMonkey's "WorldViewProjectionInverseTranspose". | ACT_RENDER_TARGET_FLIPPING -- ^ -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_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) | 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) | ACT_LIGHT_DISTANCE_OBJECT_SPACE -- ^ The distance of the light from the center of the object a useful approximation as an alternative to per-vertex distance calculations. | ACT_LIGHT_POWER_SCALE -- ^ Light power level, a single scalar as set in Light::setPowerScale (index determined by setAutoConstant call) | ACT_LIGHT_DIFFUSE_COLOUR_POWER_SCALED -- ^ Light diffuse colour pre-scaled by Light::setPowerScale (index determined by setAutoConstant call) | ACT_LIGHT_SPECULAR_COLOUR_POWER_SCALED -- ^ Light specular colour pre-scaled by Light::setPowerScale (index determined by setAutoConstant call) | ACT_LIGHT_DIFFUSE_COLOUR_ARRAY -- ^ Array of light diffuse colours (count set by extra param) | ACT_LIGHT_SPECULAR_COLOUR_ARRAY -- ^ Array of light specular colours (count set by extra param) | ACT_LIGHT_DIFFUSE_COLOUR_POWER_SCALED_ARRAY -- ^ Array of light diffuse colours scaled by light power (count set by extra param) | ACT_LIGHT_SPECULAR_COLOUR_POWER_SCALED_ARRAY -- ^ Array of light specular colours scaled by light power (count set by extra param) | ACT_LIGHT_ATTENUATION_ARRAY -- ^ Array of light attenuation parameters, Vector4(range, constant, linear, quadric) (count set by extra param) | ACT_LIGHT_POSITION_ARRAY -- ^ Array of light positions in world space (count set by extra param) | ACT_LIGHT_POSITION_OBJECT_SPACE_ARRAY -- ^ Array of light positions in object space (count set by extra param) | ACT_LIGHT_POSITION_VIEW_SPACE_ARRAY -- ^ Array of light positions in view space (count set by extra param) | ACT_LIGHT_DIRECTION_ARRAY -- ^ Array of light directions in world space (count set by extra param) | ACT_LIGHT_DIRECTION_OBJECT_SPACE_ARRAY -- ^ Array of light directions in object space (count set by extra param) | ACT_LIGHT_DIRECTION_VIEW_SPACE_ARRAY -- ^ Array of light directions in view space (count set by extra param) | ACT_LIGHT_DISTANCE_OBJECT_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_POWER_SCALE_ARRAY -- ^ Array of light power levels, a single scalar as set in Light::setPowerScale (count set by extra param) | ACT_SPOTLIGHT_PARAMS_ARRAY | ACT_DERIVED_AMBIENT_LIGHT_COLOUR | ACT_DERIVED_SCENE_COLOUR | ACT_DERIVED_LIGHT_DIFFUSE_COLOUR | ACT_DERIVED_LIGHT_SPECULAR_COLOUR | ACT_DERIVED_LIGHT_DIFFUSE_COLOUR_ARRAY -- ^ Array of derived light diffuse colours (count set by extra param) | ACT_DERIVED_LIGHT_SPECULAR_COLOUR_ARRAY -- ^ Array of derived light specular colours (count set by extra param) | ACT_LIGHT_NUMBER | ACT_LIGHT_CASTS_SHADOWS -- ^ Returns (int) 1 if the given light casts shadows, 0 otherwise (index set in extra param) | ACT_SHADOW_EXTRUSION_DISTANCE -- ^ The distance a shadow volume should be extruded when using finite extrusion programs. | ACT_CAMERA_POSITION -- ^ The current camera's position in world space | ACT_CAMERA_POSITION_OBJECT_SPACE -- ^ The current camera's position in object space | ACT_TEXTURE_VIEWPROJ_MATRIX -- ^ The view/projection matrix of the assigned texture projection frustum | ACT_TEXTURE_VIEWPROJ_MATRIX_ARRAY -- ^ Array of view/projection matrices of the first n texture projection frustums | ACT_TEXTURE_WORLDVIEWPROJ_MATRIX -- ^ The view/projection matrix of the assigned texture projection frustum, combined with the current world matrix | ACT_TEXTURE_WORLDVIEWPROJ_MATRIX_ARRAY -- ^ Array of world/view/projection matrices of the first n texture projection frustums | ACT_SPOTLIGHT_VIEWPROJ_MATRIX -- ^ The view/projection matrix of a given spotlight | ACT_SPOTLIGHT_WORLDVIEWPROJ_MATRIX -- ^ The view/projection matrix of a given spotlight projection frustum, combined with the current world matrix | ACT_CUSTOM -- ^ A custom parameter which will come from the renderable, using 'data' as the identifier | ACT_TIME -- ^ provides current elapsed time | ACT_TIME_0_X -- ^ Single float value, which repeats itself based on given as parameter "cycle time". Equivalent to RenderMonkey's "Time0_X". | ACT_COSTIME_0_X -- ^ Cosine of "Time0_X". Equivalent to RenderMonkey's "CosTime0_X". | ACT_SINTIME_0_X -- ^ Sine of "Time0_X". Equivalent to RenderMonkey's "SinTime0_X". | ACT_TANTIME_0_X -- ^ Tangent of "Time0_X". Equivalent to RenderMonkey's "TanTime0_X". | ACT_TIME_0_X_PACKED -- ^ Vector of "Time0_X", "SinTime0_X", "CosTime0_X", "TanTime0_X". Equivalent to RenderMonkey's "Time0_X_Packed". | ACT_TIME_0_1 -- ^ 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_COSTIME_0_1 -- ^ Cosine of "Time0_1". Equivalent to RenderMonkey's "CosTime0_1". | ACT_SINTIME_0_1 -- ^ Sine of "Time0_1". Equivalent to RenderMonkey's "SinTime0_1". | ACT_TANTIME_0_1 -- ^ Tangent of "Time0_1". Equivalent to RenderMonkey's "TanTime0_1". | ACT_TIME_0_1_PACKED -- ^ Vector of "Time0_1", "SinTime0_1", "CosTime0_1", "TanTime0_1". Equivalent to RenderMonkey's "Time0_1_Packed". | ACT_TIME_0_2PI -- ^ 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_COSTIME_0_2PI -- ^ Cosine of "Time0_2PI". Equivalent to RenderMonkey's "CosTime0_2PI". | ACT_SINTIME_0_2PI -- ^ Sine of "Time0_2PI". Equivalent to RenderMonkey's "SinTime0_2PI". | ACT_TANTIME_0_2PI -- ^ Tangent of "Time0_2PI". Equivalent to RenderMonkey's "TanTime0_2PI". | ACT_TIME_0_2PI_PACKED -- ^ Vector of "Time0_2PI", "SinTime0_2PI", "CosTime0_2PI", "TanTime0_2PI". Equivalent to RenderMonkey's "Time0_2PI_Packed". | ACT_FRAME_TIME -- ^ provides the scaled frame time, returned as a floating point value. | ACT_FPS -- ^ provides the calculated frames per second, returned as a floating point value. | ACT_VIEWPORT_WIDTH -- ^ Current viewport width (in pixels) as floating point value. Equivalent to RenderMonkey's "ViewportWidth". | ACT_VIEWPORT_HEIGHT -- ^ Current viewport height (in pixels) as floating point value. Equivalent to RenderMonkey's "ViewportHeight". | ACT_INVERSE_VIEWPORT_WIDTH -- ^ This variable represents 1.0/ViewportWidth. Equivalent to RenderMonkey's "ViewportWidthInverse". | ACT_INVERSE_VIEWPORT_HEIGHT -- ^ This variable represents 1.0/ViewportHeight. Equivalent to RenderMonkey's "ViewportHeightInverse". | ACT_VIEWPORT_SIZE -- ^ Packed of "ViewportWidth", "ViewportHeight", "ViewportWidthInverse", "ViewportHeightInverse". | ACT_VIEW_DIRECTION -- ^ This variable provides the view direction vector (world space). Equivalent to RenderMonkey's "ViewDirection". | ACT_VIEW_SIDE_VECTOR -- ^ This variable provides the view side vector (world space). Equivalent to RenderMonkey's "ViewSideVector". | ACT_VIEW_UP_VECTOR -- ^ This variable provides the view up vector (world space). Equivalent to RenderMonkey's "ViewUpVector". | ACT_FOV -- ^ This variable provides the field of view as a floating point value. Equivalent to RenderMonkey's "FOV". | ACT_NEAR_CLIP_DISTANCE -- ^ This variable provides the near clip distance as a floating point value. Equivalent to RenderMonkey's "NearClipPlane". | ACT_FAR_CLIP_DISTANCE -- ^ This variable provides the far clip distance as a floating point value. Equivalent to RenderMonkey's "FarClipPlane". | ACT_PASS_NUMBER -- ^ provides the pass index number within the technique of the active materil. | ACT_PASS_ITERATION_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_ANIMATION_PARAMETRIC -- ^ Provides a parametric animation value [0..1], only available where the renderable specifically implements it. | ACT_TEXEL_OFFSETS | ACT_SCENE_DEPTH_RANGE | ACT_SHADOW_SCENE_DEPTH_RANGE | ACT_SHADOW_COLOUR -- ^ Provides the fixed shadow colour as configured via SceneManager::setShadowColour; useful for integrated modulative shadows. | ACT_TEXTURE_SIZE -- ^ Provides texture size of the texture unit (index determined by setAutoConstant call). Packed as float4(width, height, depth, 1) | ACT_INVERSE_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_PACKED_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_TEXTURE_MATRIX -- ^ Provides the current transform matrix of the texture unit (index determined by setAutoConstant call), as seen by the fixed-function pipeline. | ACT_LOD_CAMERA_POSITION | ACT_LOD_CAMERA_POSITION_OBJECT_SPACE | ACT_LIGHT_CUSTOM -- ^ Binds custom per-light constants to the shaders. deriving Eq 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 data ElementType = ET_INT | ET_REAL deriving Eq 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 data AutoConstantEntry = AutoConstantEntry { aceParamType :: AutoConstantType -- ^ The type of parameter , acePhysicalIndex :: Int -- ^ The target (physical) constant index , aceElementCount :: Int -- ^ 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 , aceVariability :: GpuParamVariability -- ^ The variability of this parameter (see GpuParamVariability) } deriving Eq data GpuProgramParameters = GpuProgramParameters { gppNamedConstants :: [GpuNamedConstant] } data GpuNamedConstant = GpuNamedConstant { gncName :: String , gncType :: ElementType , gncIntValues :: [Int] , gncFloatValues :: [FloatType] } autoConstantDictionary :: [(AutoConstantType,String,Int,ElementType,ACDataType)] 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) ]