RenderTargetIterator;
+
+ {-| Returns a specialised MapIterator over all render targets attached to the RenderSystem. -}
+ -- TODO: virtual RenderTargetIterator getRenderTargetIterator(void) {
+ -- TODO: return RenderTargetIterator( mRenderTargets.begin(), mRenderTargets.end() );
+ -- TODO: }
+
+ {-| Returns a description of an error code.
+ -}
+ -- TODO: virtual String getErrorDescription(long errorNumber) const = 0;
+
+ {-| Defines whether or now fullscreen render windows wait for the vertical blank before flipping buffers.
+ @remarks
+ By default, all rendering windows wait for a vertical blank (when the CRT beam turns off briefly to move
+ from the bottom right of the screen back to the top left) before flipping the screen buffers. This ensures
+ that the image you see on the screen is steady. However it restricts the frame rate to the refresh rate of
+ the monitor, and can slow the frame rate down. You can speed this up by not waiting for the blank, but
+ this has the downside of introducing 'tearing' artefacts where part of the previous frame is still displayed
+ as the buffers are switched. Speed vs quality, you choose.
+ @note
+ Has NO effect on windowed mode render targets. Only affects fullscreen mode.
+ @param
+ enabled If true, the system waits for vertical blanks - quality over speed. If false it doesn't - speed over quality.
+ -}
+ setWaitForVerticalBlank :: a -> Bool -> IO ()
+-- getWaitForVerticalBlank :: a -> IO Bool -- ^ Returns true if the system is synchronising frames with the monitor vertical blank.
+
+ -- ------------------------------------------------------------------------
+ -- Internal Rendering Access
+ -- All methods below here are normally only called by other OGRE classes
+ -- They can be called by library user if required
+ -- ------------------------------------------------------------------------
+
+
+ {-| Tells the rendersystem to use the attached set of lights (and no others)
+ up to the number specified (this allows the same list to be used with different
+ count limits) -}
+ useLights :: a -> [(Matrix4,Light)] -> IO ()
+-- useLights :: a -> [Light] -> Int -> IO ()
+ {-| Are fixed-function lights provided in view space? Affects optimisation.
+ -}
+ -- TODO: virtual bool areFixedFunctionLightsInViewSpace() const { return false; }
+ setWorldMatrix :: a -> Matrix4 -> IO () -- ^ Sets the world transform matrix.
+ --_setWorldMatrices :: a -> [Matrix4] -> Int -> IO () -- ^ Sets multiple world matrices (vertex blending).
+ setViewMatrix :: a -> Matrix4 -> IO () -- ^ Sets the view transform matrix
+ setProjectionMatrix :: a -> Matrix4 -> IO () -- ^ Sets the projection transform matrix
+
+ {-| Sets the surface properties to be used for future rendering.
+
+ This method sets the the properties of the surfaces of objects
+ to be rendered after it. In this context these surface properties
+ are the amount of each type of light the object reflects (determining
+ it's colour under different types of light), whether it emits light
+ itself, and how shiny it is. Textures are not dealt with here,
+ see the _setTetxure method for details.
+ This method is used by _setMaterial so does not need to be called
+ direct if that method is being used.
+
+ @param ambient The amount of ambient (sourceless and directionless)
+ light an object reflects. Affected by the colour/amount of ambient light in the scene.
+ @param diffuse The amount of light from directed sources that is
+ reflected (affected by colour/amount of point, directed and spot light sources)
+ @param specular The amount of specular light reflected. This is also
+ affected by directed light sources but represents the colour at the
+ highlights of the object.
+ @param emissive The colour of light emitted from the object. Note that
+ this will make an object seem brighter and not dependent on lights in
+ the scene, but it will not act as a light, so will not illuminate other
+ objects. Use a light attached to the same SceneNode as the object for this purpose.
+ @param shininess A value which only has an effect on specular highlights (so
+ specular must be non-black). The higher this value, the smaller and crisper the
+ specular highlights will be, imitating a more highly polished surface.
+ This value is not constrained to 0.0-1.0, in fact it is likely to
+ be more (10.0 gives a modest sheen to an object).
+ @param tracking A bit field that describes which of the ambient, diffuse, specular
+ and emissive colours follow the vertex colour of the primitive. When a bit in this field is set
+ its ColourValue is ignored. This is a combination of TVC_AMBIENT, TVC_DIFFUSE, TVC_SPECULAR(note that the shininess value is still
+ taken from shininess) and TVC_EMISSIVE. TVC_NONE means that there will be no material property
+ tracking the vertex colours.
+ -}
+ setSurfaceParams :: a -> ColourValue -> ColourValue -> ColourValue -> ColourValue -> FloatType -> TrackVertexColourType -> IO ()
+
+ {-| Sets whether or not rendering points using OT_POINT_LIST will
+ render point sprites (textured quads) or plain points.
+ @param enabled True enables point sprites, false returns to normal
+ point rendering.
+ -}
+ setPointSpritesEnabled :: a -> Bool -> IO ()
+
+ {-| Sets the size of points and how they are attenuated with distance.
+ @remarks
+ When performing point rendering or point sprite rendering,
+ point size can be attenuated with distance. The equation for
+ doing this is attenuation = 1 / (constant + linear * dist + quadratic * d^2) .
+ @par
+ For example, to disable distance attenuation (constant screensize)
+ you would set constant to 1, and linear and quadratic to 0. A
+ standard perspective attenuation would be 0, 1, 0 respectively.
+ -}
+ setPointParameters :: a -> FloatType -> Bool -> FloatType -> FloatType -> FloatType -> FloatType -> FloatType -> IO ()
+
+
+ setActiveTextureUnit :: a -> Int -> IO ()
+ {-|
+ Sets the texture to bind to a given texture unit.
+
+ User processes would not normally call this direct unless rendering
+ primitives themselves.
+
+ @param unit The index of the texture unit to modify. Multitexturing
+ hardware can support multiple units (see
+ RenderSystemCapabilites::getNumTextureUnits)
+ @param enabled Boolean to turn the unit on/off
+ @param texPtr Pointer to the texture to use.
+ -}
+-- setTexture :: a -> Int -> Bool -> Maybe t -> IO ()
+ setTexture :: a -> Maybe t -> IO ()
+ {-|
+ Sets the texture to bind to a given texture unit.
+
+ User processes would not normally call this direct unless rendering
+ primitives themselves.
+
+ @param unit The index of the texture unit to modify. Multitexturing
+ hardware can support multiple units (see
+ RenderSystemCapabilites::getNumTextureUnits)
+ @param enabled Boolean to turn the unit on/off
+ @param texname The name of the texture to use - this should have
+ already been loaded with TextureManager::load.
+ -}
+ --virtual void _setTexture(size_t unit, bool enabled, const String &texname);
+
+ {-| Binds a texture to a vertex sampler.
+ @remarks
+ Not all rendersystems support separate vertex samplers. For those that
+ do, you can set a texture for them, separate to the regular texture
+ samplers, using this method. For those that don't, you should use the
+ regular texture samplers which are shared between the vertex and
+ fragment units; calling this method will throw an exception.
+ @see RenderSystemCapabilites::getVertexTextureUnitsShared
+ -}
+ setVertexTexture :: a -> Maybe t -> IO ()
+
+ {-|
+ Sets the texture coordinate set to use for a texture unit.
+
+ Meant for use internally - not generally used directly by apps - the Material and TextureUnitState
+ classes let you manage textures far more easily.
+
+ @param unit Texture unit as above
+ @param index The index of the texture coordinate set to use.
+ -}
+-- setTextureCoordSet :: a -> Int -> Int -> IO ()
+
+ {-|
+ Sets a method for automatically calculating texture coordinates for a stage.
+ Should not be used by apps - for use by Ogre only.
+ @param unit Texture unit as above
+ @param m Calculation method to use
+ @param frustum Optional Frustum param, only used for projective effects
+ -}
+ setTextureCoordCalculation :: a -> TexCoordCalcMethod{- -> Frustum-} -> IO ()
+
+ {-| Sets the texture blend modes from a TextureUnitState record.
+ Meant for use internally only - apps should use the Material
+ and TextureUnitState classes.
+ @param unit Texture unit as above
+ @param bm Details of the blending mode
+ -}
+ setTextureBlendMode :: a -> LayerBlendModeEx -> LayerBlendModeEx -> IO ()
+
+ {-| Sets the filtering options for a given texture unit.
+ @param unit The texture unit to set the filtering options for
+ @param minFilter The filter used when a texture is reduced in size
+ @param magFilter The filter used when a texture is magnified
+ @param mipFilter The filter used between mipmap levels, FO_NONE disables mipmapping
+ -}
+ setTextureUnitFiltering :: a -> TextureType -> FilterOptions -> FilterOptions -> FilterOptions -> IO ()
+
+ {-| Sets a single filter for a given texture unit.
+ @param unit The texture unit to set the filtering options for
+ @param ftype The filter type
+ @param filter The filter to be used
+ -}
+-- setTextureUnitFiltering :: a -> Int -> FilterType -> FilterOptions -> IO ()
+
+ {-| Sets the maximal anisotropy for the specified texture unit.-}
+ setTextureLayerAnisotropy :: a -> TextureType -> Int -> IO ()
+
+ {-| Sets the texture addressing mode for a texture unit.-}
+ setTextureAddressingMode :: a -> TextureType -> UVWAddressingMode -> IO ()
+
+ {-| Sets the texture border colour for a texture unit.-}
+ setTextureBorderColour :: a -> TextureType -> ColourValue -> IO ()
+
+ {-| Sets the mipmap bias value for a given texture unit.
+ @remarks
+ This allows you to adjust the mipmap calculation up or down for a
+ given texture unit. Negative values force a larger mipmap to be used,
+ positive values force a smaller mipmap to be used. Units are in numbers
+ of levels, so +1 forces the mipmaps to one smaller level.
+ @note Only does something if render system has capability RSC_MIPMAP_LOD_BIAS.
+ -}
+ setTextureMipmapBias :: a -> FloatType -> IO ()
+
+ {-| Sets the texture coordinate transformation matrix for a texture unit.
+ @param unit Texture unit to affect
+ @param xform The 4x4 matrix
+ -}
+ setTextureMatrix :: a -> Matrix4 -> IO ()
+
+ {-| Sets the global blending factors for combining subsequent renders with the existing frame contents.
+ The result of the blending operation is:
+ final = (texture * sourceFactor) + (pixel * destFactor)
+ Each of the factors is specified as one of a number of options, as specified in the SceneBlendFactor
+ enumerated type.
+ By changing the operation you can change addition between the source and destination pixels to a different operator.
+ @param sourceFactor The source factor in the above calculation, i.e. multiplied by the texture colour components.
+ @param destFactor The destination factor in the above calculation, i.e. multiplied by the pixel colour components.
+ @param op The blend operation mode for combining pixels
+ -}
+ setSceneBlending :: a -> SceneBlendFactor -> SceneBlendFactor -> SceneBlendOperation -> IO ()
+
+ {-| Sets the global blending factors for combining subsequent renders with the existing frame contents.
+ The result of the blending operation is:
+ final = (texture * sourceFactor) + (pixel * destFactor)
+ Each of the factors is specified as one of a number of options, as specified in the SceneBlendFactor
+ enumerated type.
+ @param sourceFactor The source factor in the above calculation, i.e. multiplied by the texture colour components.
+ @param destFactor The destination factor in the above calculation, i.e. multiplied by the pixel colour components.
+ @param sourceFactorAlpha The source factor in the above calculation for the alpha channel, i.e. multiplied by the texture alpha components.
+ @param destFactorAlpha The destination factor in the above calculation for the alpha channel, i.e. multiplied by the pixel alpha components.
+ @param op The blend operation mode for combining pixels
+ @param alphaOp The blend operation mode for combining pixel alpha values
+ -}
+ setSeparateSceneBlending :: a -> SceneBlendFactor -> SceneBlendFactor -> SceneBlendFactor -> SceneBlendFactor -> SceneBlendOperation -> SceneBlendOperation -> IO ()
+
+ {-| Sets the global alpha rejection approach for future renders.
+ By default images are rendered regardless of texture alpha. This method lets you change that.
+ @param func The comparison function which must pass for a pixel to be written.
+ @param val The value to compare each pixels alpha value to (0-255)
+ @param alphaToCoverage Whether to enable alpha to coverage, if supported
+ -}
+ setAlphaRejectSettings :: a -> CompareFunction -> Int -> Bool -> IO ()
+
+ {-| Notify the rendersystem that it should adjust texture projection to be
+ relative to a different origin.
+ -}
+ -- TODO: virtual void _setTextureProjectionRelativeTo(bool enabled, const Vector3& pos);
+ {-|
+ * Signifies the beginning of a frame, i.e. the start of rendering on a single viewport. Will occur
+ * several times per complete frame if multiple viewports exist.
+ -}
+ -- TODO: virtual void _beginFrame(void) = 0;
+
+
+ {-|
+ * Ends rendering of a frame to the current viewport.
+ -}
+ -- TODO: virtual void _endFrame(void) = 0;
+ {-|
+ Sets the provided viewport as the active one for future
+ rendering operations. This viewport is aware of it's own
+ camera and render target. Must be implemented by subclass.
+
+ @param target Pointer to the appropriate viewport.
+ -}
+ setViewport :: a -> Int -> Int -> Int -> Int -> IO ()
+ {-| Get the current active viewport for rendering. -}
+ -- TODO: virtual Viewport* _getViewport(void);
+
+ {-| Sets the culling mode for the render system based on the 'vertex winding'.
+ A typical way for the rendering engine to cull triangles is based on the
+ 'vertex winding' of triangles. Vertex winding refers to the direction in
+ which the vertices are passed or indexed to in the rendering operation as viewed
+ from the camera, and will wither be clockwise or anticlockwise (that's 'counterclockwise' for
+ you Americans out there ;) The default is CULL_CLOCKWISE i.e. that only triangles whose vertices
+ are passed/indexed in anticlockwise order are rendered - this is a common approach and is used in 3D studio models
+ for example. You can alter this culling mode if you wish but it is not advised unless you know what you are doing.
+ You may wish to use the CULL_NONE option for mesh data that you cull yourself where the vertex
+ winding is uncertain.
+ -}
+ setCullingMode :: a -> CullingMode -> IO ()
+-- getCullingMode :: a -> IO CullingMode
+
+ {-| Sets the mode of operation for depth buffer tests from this point onwards.
+ Sometimes you may wish to alter the behaviour of the depth buffer to achieve
+ special effects. Because it's unlikely that you'll set these options for an entire frame,
+ but rather use them to tweak settings between rendering objects, this is an internal
+ method (indicated by the '_' prefix) which will be used by a SceneManager implementation
+ rather than directly from the client application.
+ If this method is never called the settings are automatically the same as the default parameters.
+ @param depthTest If true, the depth buffer is tested for each pixel and the frame buffer is only updated
+ if the depth function test succeeds. If false, no test is performed and pixels are always written.
+ @param depthWrite If true, the depth buffer is updated with the depth of the new pixel if the depth test succeeds.
+ If false, the depth buffer is left unchanged even if a new pixel is written.
+ @param depthFunction Sets the function required for the depth test.
+ -}
+ setDepthBufferParams :: a -> Bool -> Bool -> CompareFunction -> IO ()
+
+ {-| Sets whether or not the depth buffer check is performed before a pixel write.
+ @param enabled If true, the depth buffer is tested for each pixel and the frame buffer is only updated
+ if the depth function test succeeds. If false, no test is performed and pixels are always written.
+ -}
+ setDepthBufferCheckEnabled :: a -> Bool -> IO ()
+ {-| Sets whether or not the depth buffer is updated after a pixel write.
+ @param enabled If true, the depth buffer is updated with the depth of the new pixel if the depth test succeeds.
+ If false, the depth buffer is left unchanged even if a new pixel is written.
+ -}
+ setDepthBufferWriteEnabled :: a -> Bool -> IO ()
+ {-| Sets the comparison function for the depth buffer check.
+ Advanced use only - allows you to choose the function applied to compare the depth values of
+ new and existing pixels in the depth buffer. Only an issue if the deoth buffer check is enabled
+ (see _setDepthBufferCheckEnabled)
+ @param func The comparison between the new depth and the existing depth which must return true
+ for the new pixel to be written.
+ -}
+ --setDepthBufferFunction :: a -> CompareFunction -> IO ()
+ setDepthBufferFunction :: a -> Bool -> CompareFunction -> IO ()
+ {-| Sets whether or not colour buffer writing is enabled, and for which channels.
+ @remarks
+ For some advanced effects, you may wish to turn off the writing of certain colour
+ channels, or even all of the colour channels so that only the depth buffer is updated
+ in a rendering pass. However, the chances are that you really want to use this option
+ through the Material class.
+ @param red, green, blue, alpha Whether writing is enabled for each of the 4 colour channels. -}
+ setColourBufferWriteEnabled :: a -> Bool -> Bool -> Bool -> Bool -> IO ()
+ {-| Sets the depth bias, NB you should use the Material version of this.
+ @remarks
+ When polygons are coplanar, you can get problems with 'depth fighting' where
+ the pixels from the two polys compete for the same screen pixel. This is particularly
+ a problem for decals (polys attached to another surface to represent details such as
+ bulletholes etc.).
+ @par
+ A way to combat this problem is to use a depth bias to adjust the depth buffer value
+ used for the decal such that it is slightly higher than the true value, ensuring that
+ the decal appears on top.
+ @note
+ The final bias value is a combination of a constant bias and a bias proportional
+ to the maximum depth slope of the polygon being rendered. The final bias
+ is constantBias + slopeScaleBias * maxslope. Slope scale biasing is
+ generally preferable but is not available on older hardware.
+ @param constantBias The constant bias value, expressed as a value in
+ homogeneous depth coordinates.
+ @param slopeScaleBias The bias value which is factored by the maximum slope
+ of the polygon, see the description above. This is not supported by all
+ cards.
+
+ -}
+ setDepthBias :: a -> FloatType -> FloatType -> IO ()
+ {-| Sets the fogging mode for future geometry.
+ @param mode Set up the mode of fog as described in the FogMode enum, or set to FOG_NONE to turn off.
+ @param colour The colour of the fog. Either set this to the same as your viewport background colour,
+ or to blend in with a skydome or skybox.
+ @param expDensity The density of the fog in FOG_EXP or FOG_EXP2 mode, as a value between 0 and 1. The default is 1. i.e. completely opaque, lower values can mean
+ that fog never completely obscures the scene.
+ @param linearStart Distance at which linear fog starts to encroach. The distance must be passed
+ as a parametric value between 0 and 1, with 0 being the near clipping plane, and 1 being the far clipping plane. Only applicable if mode is FOG_LINEAR.
+ @param linearEnd Distance at which linear fog becomes completely opaque.The distance must be passed
+ as a parametric value between 0 and 1, with 0 being the near clipping plane, and 1 being the far clipping plane. Only applicable if mode is FOG_LINEAR.
+ -}
+ setFog :: a -> FogMode -> ColourValue -> FloatType -> FloatType -> FloatType -> IO ()
+
+ {-| The RenderSystem will keep a count of tris rendered, this resets the count. -}
+ -- TODO: virtual void _beginGeometryCount(void);
+ {-| Reports the number of tris rendered since the last _beginGeometryCount call. -}
+ -- TODO: virtual unsigned int _getFaceCount(void) const;
+ {-| Reports the number of batches rendered since the last _beginGeometryCount call. -}
+ -- TODO: virtual unsigned int _getBatchCount(void) const;
+ {-| Reports the number of vertices passed to the renderer since the last _beginGeometryCount call. -}
+ -- TODO: virtual unsigned int _getVertexCount(void) const;
+
+ {-| Generates a packed data version of the passed in ColourValue suitable for
+ use as with this RenderSystem.
+ @remarks
+ Since different render systems have different colour data formats (eg
+ RGBA for GL, ARGB for D3D) this method allows you to use 1 method for all.
+ @param colour The colour to convert
+ @param pDest Pointer to location to put the result.
+ -}
+ -- TODO: virtual void convertColourValue(const ColourValue& colour, uint32* pDest);
+ {-| Get the native VertexElementType for a compact 32-bit colour value
+ for this rendersystem.
+ -}
+ -- TODO: virtual VertexElementType getColourVertexElementType(void) const = 0;
+
+ {-| Converts a uniform projection matrix to suitable for this render system.
+ @remarks
+ Because different APIs have different requirements (some incompatible) for the
+ projection matrix, this method allows each to implement their own correctly and pass
+ back a generic OGRE matrix for storage in the engine.
+ -}
+ -- TODO: virtual void _convertProjectionMatrix(const Matrix4& matrix,
+ -- TODO: Matrix4& dest, bool forGpuProgram = false) = 0;
+
+ {-| Builds a perspective projection matrix suitable for this render system.
+ @remarks
+ Because different APIs have different requirements (some incompatible) for the
+ projection matrix, this method allows each to implement their own correctly and pass
+ back a generic OGRE matrix for storage in the engine.
+ -}
+ -- TODO: virtual void _makeProjectionMatrix(const Radian& fovy, Real aspect, Real nearPlane, Real farPlane,
+ -- TODO: Matrix4& dest, bool forGpuProgram = false) = 0;
+
+ {-| Builds a perspective projection matrix for the case when frustum is
+ not centered around camera.
+ @remarks
+ Viewport coordinates are in camera coordinate frame, i.e. camera is
+ at the origin.
+ -}
+ -- TODO: virtual void _makeProjectionMatrix(Real left, Real right, Real bottom, Real top,
+ -- TODO: Real nearPlane, Real farPlane, Matrix4& dest, bool forGpuProgram = false) = 0;
+ {-| Builds an orthographic projection matrix suitable for this render system.
+ @remarks
+ Because different APIs have different requirements (some incompatible) for the
+ projection matrix, this method allows each to implement their own correctly and pass
+ back a generic OGRE matrix for storage in the engine.
+ -}
+ -- TODO: virtual void _makeOrthoMatrix(const Radian& fovy, Real aspect, Real nearPlane, Real farPlane,
+ -- TODO: Matrix4& dest, bool forGpuProgram = false) = 0;
+
+ {-| Update a perspective projection matrix to use 'oblique depth projection'.
+ @remarks
+ This method can be used to change the nature of a perspective
+ transform in order to make the near plane not perpendicular to the
+ camera view direction, but to be at some different orientation.
+ This can be useful for performing arbitrary clipping (e.g. to a
+ reflection plane) which could otherwise only be done using user
+ clip planes, which are more expensive, and not necessarily supported
+ on all cards.
+ @param matrix The existing projection matrix. Note that this must be a
+ perspective transform (not orthographic), and must not have already
+ been altered by this method. The matrix will be altered in-place.
+ @param plane The plane which is to be used as the clipping plane. This
+ plane must be in CAMERA (view) space.
+ @param forGpuProgram Is this for use with a Gpu program or fixed-function
+ -}
+ -- TODO: virtual void _applyObliqueDepthProjection(Matrix4& matrix, const Plane& plane,
+ -- TODO: bool forGpuProgram) = 0;
+
+ {-| Sets how to rasterise triangles, as points, wireframe or solid polys. -}
+ setPolygonMode :: a -> PolygonMode -> IO ()
+
+ {-| Turns stencil buffer checking on or off.
+ @remarks
+ Stencilling (masking off areas of the rendering target based on the stencil
+ buffer) can be turned on or off using this method. By default, stencilling is
+ disabled.
+ -}
+ setStencilCheckEnabled :: a -> Bool -> IO ()
+ {-| Determines if this system supports hardware accelerated stencil buffer.
+ @remarks
+ Note that the lack of this function doesn't mean you can't do stencilling, but
+ the stencilling operations will be provided in software, which will NOT be
+ fast.
+ @par
+ Generally hardware stencils are only supported in 32-bit colour modes, because
+ the stencil buffer shares the memory of the z-buffer, and in most cards the
+ z-buffer has to be the same depth as the colour buffer. This means that in 32-bit
+ mode, 24 bits of the z-buffer are depth and 8 bits are stencil. In 16-bit mode there
+ is no room for a stencil (although some cards support a 15:1 depth:stencil option,
+ this isn't useful for very much) so 8 bits of stencil are provided in software.
+ This can mean that if you use stencilling, your applications may be faster in
+ 32-but colour than in 16-bit, which may seem odd to some people.
+ -}
+ {-virtual bool hasHardwareStencil(void) = 0;-}
+
+ {-| This method allows you to set all the stencil buffer parameters in one call.
+ @remarks
+ The stencil buffer is used to mask out pixels in the render target, allowing
+ you to do effects like mirrors, cut-outs, stencil shadows and more. Each of
+ your batches of rendering is likely to ignore the stencil buffer,
+ update it with new values, or apply it to mask the output of the render.
+ The stencil test is:
+ (Reference Value & Mask) CompareFunction (Stencil Buffer Value & Mask)
+ The result of this will cause one of 3 actions depending on whether the test fails,
+ succeeds but with the depth buffer check still failing, or succeeds with the
+ depth buffer check passing too.
+ @par
+ Unlike other render states, stencilling is left for the application to turn
+ on and off when it requires. This is because you are likely to want to change
+ parameters between batches of arbitrary objects and control the ordering yourself.
+ In order to batch things this way, you'll want to use OGRE's separate render queue
+ groups (see RenderQueue) and register a RenderQueueListener to get notifications
+ between batches.
+ @par
+ There are individual state change methods for each of the parameters set using
+ this method.
+ Note that the default values in this method represent the defaults at system
+ start up too.
+ @param func The comparison function applied.
+ @param refValue The reference value used in the comparison
+ @param mask The bitmask applied to both the stencil value and the reference value
+ before comparison
+ @param stencilFailOp The action to perform when the stencil check fails
+ @param depthFailOp The action to perform when the stencil check passes, but the
+ depth buffer check still fails
+ @param passOp The action to take when both the stencil and depth check pass.
+ @param twoSidedOperation If set to true, then if you render both back and front faces
+ (you'll have to turn off culling) then these parameters will apply for front faces,
+ and the inverse of them will happen for back faces (keep remains the same).
+ -}
+ setStencilBufferParams :: a -> CompareFunction -> Word32 -> Word32 -> StencilOperation -> StencilOperation -> StencilOperation -> Bool -> IO ()
+
+
+
+ {-| Sets the current vertex declaration, ie the source of vertex data. -}
+-- setVertexDeclaration :: a -> VertexDeclaration -> IO ()
+ {-| Sets the current vertex buffer binding state. -}
+-- setVertexBufferBinding :: a -> VertexBufferBinding vb -> IO ()
+
+ {-| Sets whether or not normals are to be automatically normalised.
+ @remarks
+ This is useful when, for example, you are scaling SceneNodes such that
+ normals may not be unit-length anymore. Note though that this has an
+ overhead so should not be turn on unless you really need it.
+ @par
+ You should not normally call this direct unless you are rendering
+ world geometry; set it on the Renderable because otherwise it will be
+ overridden by material settings.
+ -}
+ setNormaliseNormals :: a -> Bool -> IO ()
+
+ {-|
+ Render something to the active viewport.
+
+ Low-level rendering interface to perform rendering
+ operations. Unlikely to be used directly by client
+ applications, since the SceneManager and various support
+ classes will be responsible for calling this method.
+ Can only be called between _beginScene and _endScene
+
+ @param Iteration count
+ @param op A rendering operation instance, which contains
+ details of the operation to be performed.
+ -}
+ render :: a -> RenderOperation vb ib -> IO ()
+ bindGeometry :: a -> RenderOperation vb ib -> [TextureUnitState t] -> IO ()
+ unbindGeometry :: a -> RenderOperation vb ib -> IO ()
+
+ {-| Gets the capabilities of the render system. -}
+ getCapabilities :: a -> RenderSystemCapabilities
+
+ {-| Binds a given GpuProgram (but not the parameters).
+ @remarks Only one GpuProgram of each type can be bound at once, binding another
+ one will simply replace the existing one.
+ -}
+ bindLinkedGpuProgram :: a -> lp -> IO ()
+-- bindGpuProgram :: a -> GpuProgram -> IO ()
+
+ {-| Bind Gpu program parameters.
+ @param gptype The type of program to bind the parameters to
+ @param params The parameters to bind
+ @param variabilityMask A mask of GpuParamVariability identifying which params need binding
+ -}
+-- bindGpuProgramParameters :: a -> GpuProgramType -> GpuProgramParameters -> Word16 -> IO ()
+
+ {-| Only binds Gpu program parameters used for passes that have more than one iteration rendering
+ -}
+-- bindGpuProgramPassIterationParameters :: a -> GpuProgramType -> IO ()
+ {-| Unbinds GpuPrograms of a given GpuProgramType.
+ @remarks
+ This returns the pipeline to fixed-function processing for this type.
+ -}
+ unbindLinkedGpuProgram :: a -> IO ()
+-- unbindGpuProgram :: a -> GpuProgramType -> IO ()
+
+ {-| Returns whether or not a Gpu program of the given type is currently bound. -}
+-- isGpuProgramBound :: a -> GpuProgramType -> IO Bool
+
+ {-| Sets the user clipping region.
+ -}
+ -- TODO: virtual void setClipPlanes(const PlaneList& clipPlanes);
+
+ {-| Add a user clipping plane. -}
+ -- TODO: virtual void addClipPlane (const Plane &p);
+ {-| Add a user clipping plane. -}
+ -- TODO: virtual void addClipPlane (Real A, Real B, Real C, Real D);
+
+ {-| Clears the user clipping region.
+ -}
+ -- TODO: virtual void resetClipPlanes();
+
+ {-| Utility method for initialising all render targets attached to this rendering system. -}
+ -- TODO: virtual void _initRenderTargets(void);
+
+ {-| Utility method to notify all render targets that a camera has been removed,
+ in case they were referring to it as their viewer.
+ -}
+ -- TODO: virtual void _notifyCameraRemoved(const Camera* cam);
+
+ {-| Internal method for updating all render targets attached to this rendering system. -}
+ -- TODO: virtual void _updateAllRenderTargets(bool swapBuffers = true);
+ {-| Internal method for swapping all the buffers on all render targets,
+ if _updateAllRenderTargets was called with a 'false' parameter. -}
+ -- TODO: virtual void _swapAllRenderTargetBuffers(bool waitForVsync = true);
+
+ {-| Gets whether or not vertex windings set should be inverted; this can be important
+ for rendering reflections. -}
+ -- TODO: virtual bool getInvertVertexWinding(void);
+
+ {-| Sets whether or not vertex windings set should be inverted; this can be important
+ for rendering reflections. -}
+ -- TODO: virtual void setInvertVertexWinding(bool invert);
+ {-| Sets the 'scissor region' ie the region of the target in which rendering can take place.
+ @remarks
+ This method allows you to 'mask off' rendering in all but a given rectangular area
+ as identified by the parameters to this method.
+ @note
+ Not all systems support this method. Check the RenderSystemCapabilities for the
+ RSC_SCISSOR_TEST capability to see if it is supported.
+ @param enabled True to enable the scissor test, false to disable it.
+ @param left, top, right, bottom The location of the corners of the rectangle, expressed in
+ pixels.
+ -}
+ setScissorTest :: a -> Bool -> Int -> Int -> Int -> Int -> IO ()
+
+ {-| Clears one or more frame buffers on the active render target.
+ @param buffers Combination of one or more elements of FrameBufferType
+ denoting which buffers are to be cleared
+ @param colour The colour to clear the colour buffer with, if enabled
+ @param depth The value to initialise the depth buffer with, if enabled
+ @param stencil The value to initialise the stencil buffer with, if enabled.
+ -}
+ clearFrameBuffer :: a -> FrameBufferType -> ColourValue -> FloatType -> Word16 -> IO ()
+ {-| Returns the horizontal texel offset value required for mapping
+ texel origins to pixel origins in this rendersystem.
+ @remarks
+ Since rendersystems sometimes disagree on the origin of a texel,
+ mapping from texels to pixels can sometimes be problematic to
+ implement generically. This method allows you to retrieve the offset
+ required to map the origin of a texel to the origin of a pixel in
+ the horizontal direction.
+ -}
+ getHorizontalTexelOffset :: a -> IO FloatType
+ {-| Returns the vertical texel offset value required for mapping
+ texel origins to pixel origins in this rendersystem.
+ @remarks
+ Since rendersystems sometimes disagree on the origin of a texel,
+ mapping from texels to pixels can sometimes be problematic to
+ implement generically. This method allows you to retrieve the offset
+ required to map the origin of a texel to the origin of a pixel in
+ the vertical direction.
+ -}
+ getVerticalTexelOffset :: a -> IO FloatType
+
+ {-| Gets the minimum (closest) depth value to be used when rendering
+ using identity transforms.
+ @remarks
+ When using identity transforms you can manually set the depth
+ of a vertex; however the input values required differ per
+ rendersystem. This method lets you retrieve the correct value.
+ @see Renderable::getUseIdentityView, Renderable::getUseIdentityProjection
+ -}
+ getMinimumDepthInputValue :: a -> FloatType
+ {-| Gets the maximum (farthest) depth value to be used when rendering
+ using identity transforms.
+ @remarks
+ When using identity transforms you can manually set the depth
+ of a vertex; however the input values required differ per
+ rendersystem. This method lets you retrieve the correct value.
+ @see Renderable::getUseIdentityView, Renderable::getUseIdentityProjection
+ -}
+ getMaximumDepthInputValue :: a -> FloatType
+ {-| set the current multi pass count value. This must be set prior to
+ calling _render() if multiple renderings of the same pass state are
+ required.
+ @param count Number of times to render the current state.
+ -}
+ -- TODO: virtual void setCurrentPassIterationCount(const size_t count) { mCurrentPassIterationCount = count; }
+
+ {-| Tell the render system whether to derive a depth bias on its own based on
+ the values passed to it in setCurrentPassIterationCount.
+ The depth bias set will be baseValue + iteration * multiplier
+ @param derive True to tell the RS to derive this automatically
+ @param baseValue The base value to which the multiplier should be
+ added
+ @param multiplier The amount of depth bias to apply per iteration
+ @param slopeScale The constant slope scale bias for completeness
+ -}
+ -- TODO: virtual void setDeriveDepthBias(bool derive, float baseValue = 0.0f,
+ -- TODO: float multiplier = 0.0f, float slopeScale = 0.0f)
+ -- TODO: {
+ -- TODO: mDerivedDepthBias = derive;
+ -- TODO: mDerivedDepthBiasBase = baseValue;
+ -- TODO: mDerivedDepthBiasMultiplier = multiplier;
+ -- TODO: mDerivedDepthBiasSlopeScale = slopeScale;
+ -- TODO: }
+
+ {-|
+ * Set current render target to target, enabling its device context if needed
+ -}
+ -- TODO: virtual void _setRenderTarget(RenderTarget *target) = 0;
+
+class (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => Renderable r vb ib t lp | r -> vb ib t lp where
+ prepare :: Matrix4 -> r -> [RenderEntity vb ib t lp]
+
+data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => RenderEntity vb ib t lp
+ = RenderEntity
+ { reOperation :: RenderOperation vb ib
+ , rePassList :: [Pass t lp]
+ , reMatrix :: Matrix4
+ }
+
+--setPass :: RenderSystem -> Pass -> IO ()
+setPass time rs pass = do
+ let rsc = getCapabilities rs
+ caps = rscCapabilities rsc
+ Pass
+ { --psName :: String -- ^ optional name for the pass
+
+ -- Colour properties, only applicable in fixed-function passes
+ psAmbient = ambient
+ , psDiffuse = diffuse
+ , psSpecular = specular
+ , psEmissive = emissive
+ , psShininess = shininess
+ , psTracking = vertexColourTracking
+
+ -- Blending factors
+ , psSourceBlendFactor = sourceBlendFactor
+ , psDestBlendFactor = destBlendFactor
+ , psSourceBlendFactorAlpha = sourceBlendFactorAlpha
+ , psDestBlendFactorAlpha = destBlendFactorAlpha
+
+ , psSeparateBlend = separateBlend
+
+ -- Blending operations
+ , psBlendOperation = blendOperation
+ , psAlphaBlendOperation = alphaBlendOperation
+ , psSeparateBlendOperation = separateBlendOperation
+
+ -- Depth buffer settings
+ , psDepthCheck = depthCheck
+ , psDepthWrite = depthWrite
+ , psDepthFunc = depthFunc
+ , psDepthBiasConstant = depthBiasConstant
+ , psDepthBiasSlopeScale = depthBiasSlopeScale
+-- , psDepthBiasPerIteration :: FloatType
+
+ -- Colour buffer settings
+ , psColourWrite = colourWrite
+
+ -- Alpha reject settings
+ , psAlphaRejectFunc = alphaRejectFunc
+ , psAlphaRejectVal = alphaRejectVal
+ , psAlphaToCoverageEnabled = alphaToCoverageEnabled
+
+-- , psTransparentSorting :: Bool -- ^ Transparent depth sorting
+-- , psTransparentSortingForced :: Bool -- ^ Transparent depth sorting forced
+
+ -- Culling mode
+ , psCullMode = cullMode
+-- , psManualCullMode :: ManualCullingMode
+
+ , psLightingEnabled = lightingEnabled
+-- , psMaxSimultaneousLights :: Int -- ^ Max simultaneous lights
+-- , psStartLight :: Int -- ^ Starting light index
+-- , psLightsPerIteration :: Maybe Int -- ^ Run this pass once per light? Iterate per how many lights?
+-- , psOnlyLightType :: Maybe LightTypes -- ^ Should it only be run for a certain light type?
+
+ , psShadeOptions = shadeOptions
+ , psPolygonMode = polygonMode
+
+ -- Normalisation
+-- , psNormaliseNormals :: Bool
+ , psPolygonModeOverrideable = polygonModeOverrideable
+
+ -- Fog
+ , psFogOverride = fogOverride
+ , psFogMode = fogMode
+ , psFogColour = fogColour
+ , psFogStart = fogStart
+ , psFogEnd = fogEnd
+ , psFogDensity = fogDensity
+
+ , psTextureUnitStates = textureUnitStates
+
+ , psVertexProgramUsage = vertexProgramUsage
+ -- , psShadowCasterVertexProgramUsage :: GpuProgramUsage -- ^ Vertex program details
+ -- , psShadowReceiverVertexProgramUsage :: GpuProgramUsage -- ^ Vertex program details
+ , psFragmentProgramUsage = fragmentProgramUsage
+ -- , psShadowReceiverFragmentProgramUsage :: GpuProgramUsage -- ^ Fragment program details
+ , psGeometryProgramUsage = geometryProgramUsage
+ , psLinkedGpuProgram = linkedGpuProgram
+ -- , psQueuedForDeletion :: Bool -- ^ Is this pass queued for deletion?
+
+-- , psPassIterationCount :: Int -- ^ number of pass iterations to perform
+
+ , psPointSize = pointSize
+ , psPointMinSize = pointMinSize
+ , psPointMaxSize = pointMaxSize
+ , psPointSpritesEnabled = pointSpritesEnabled
+ , psPointAttenuationEnabled = pointAttenuationEnabled
+-- , psPointAttenuationCoeffs :: FloatType3 -- ^ constant, linear, quadratic coeffs
+
+ {-
+ // TU Content type lookups
+ typedef vector::type ContentTypeLookup;
+ mutable ContentTypeLookup mShadowContentTypeLookup;
+ mutable bool mContentTypeLookupBuilt;
+ -}
+-- , psLightScissoring :: Bool -- ^ Scissoring for the light?
+-- , psLightClipPlanes :: Bool -- ^ User clip planes for light?
+-- , psIlluminationStage :: IlluminationStage -- ^ Illumination stage?
+ } = pass
+ {-
+ if (!mSuppressRenderStateChanges || evenIfSuppressed)
+ {
+ if (mIlluminationStage == IRS_RENDER_TO_TEXTURE && shadowDerivation)
+ {
+ // Derive a special shadow caster pass from this one
+ pass = deriveShadowCasterPass(pass);
+ }
+ else if (mIlluminationStage == IRS_RENDER_RECEIVER_PASS && shadowDerivation)
+ {
+ pass = deriveShadowReceiverPass(pass);
+ }
+
+ // Tell params about current pass
+ mAutoParamDataSource->setCurrentPass(pass);
+
+ bool passSurfaceAndLightParams = true;
+ bool passFogParams = true;
+ -}
+ let passSurfaceAndLightParams = True
+ passFogParams = True
+
+ case linkedGpuProgram of
+ { Nothing -> unbindLinkedGpuProgram rs
+ ; Just lp -> bindLinkedGpuProgram rs lp
+ }
+
+ when passSurfaceAndLightParams $ do
+ -- Set surface reflectance properties, only valid if lighting is enabled
+ when lightingEnabled $
+ setSurfaceParams rs ambient diffuse specular emissive shininess vertexColourTracking
+ -- Dynamic lighting enabled?
+ setLightingEnabled rs lightingEnabled
+
+ when passFogParams $ do
+ -- New fog params can either be from scene or from material
+ -- TODO: implement override
+ --setFog rs newFogMode newFogColour newFogDensity newFogStart newFogEnd
+ setFog rs fogMode fogColour fogDensity fogStart fogEnd
+ -- TODO
+ {-
+ if (passFogParams)
+ {
+ // New fog params can either be from scene or from material
+ FogMode newFogMode;
+ ColourValue newFogColour;
+ Real newFogStart, newFogEnd, newFogDensity;
+ if (pass->getFogOverride())
+ {
+ // New fog params from material
+ newFogMode = pass->getFogMode();
+ newFogColour = pass->getFogColour();
+ newFogStart = pass->getFogStart();
+ newFogEnd = pass->getFogEnd();
+ newFogDensity = pass->getFogDensity();
+ }
+ else
+ {
+ // New fog params from scene
+ newFogMode = mFogMode;
+ newFogColour = mFogColour;
+ newFogStart = mFogStart;
+ newFogEnd = mFogEnd;
+ newFogDensity = mFogDensity;
+ }
+
+ /* In D3D, it applies to shaders prior
+ to version vs_3_0 and ps_3_0. And in OGL, it applies to "ARB_fog_XXX" in
+ fragment program, and in other ways, them maybe access by gpu program via
+ "state.fog.XXX".
+ */
+ mDestRenderSystem->_setFog(
+ newFogMode, newFogColour, newFogDensity, newFogStart, newFogEnd);
+ }
+
+ // Tell params about ORIGINAL fog
+ // Need to be able to override fixed function fog, but still have
+ // original fog parameters available to a shader than chooses to use
+ mAutoParamDataSource->setFog(
+ mFogMode, mFogColour, mFogDensity, mFogStart, mFogEnd);
+ -}
+
+ -- The rest of the settings are the same no matter whether we use programs or not
+
+ -- Set scene blending
+ case separateBlend of
+ { True -> setSeparateSceneBlending rs sourceBlendFactor destBlendFactor
+ sourceBlendFactorAlpha destBlendFactorAlpha
+ blendOperation
+ (if separateBlendOperation then blendOperation else alphaBlendOperation)
+ ; False -> case psSeparateBlendOperation pass of
+ { True -> setSeparateSceneBlending rs sourceBlendFactor destBlendFactor
+ sourceBlendFactor destBlendFactor
+ blendOperation alphaBlendOperation
+ ; False -> setSceneBlending rs sourceBlendFactor destBlendFactor blendOperation
+ }
+ }
+
+ -- Set point parameters
+ let (pac,pal,paq) = psPointAttenuationCoeffs pass -- TODO: refactor
+ setPointParameters rs pointSize pointAttenuationEnabled pac pal paq pointMinSize pointMaxSize
+
+ when (Set.member RSC_POINT_SPRITES caps) $
+ setPointSpritesEnabled rs pointSpritesEnabled
+
+ -- Texture unit settings
+ -- TODO
+ {-
+ Pass::ConstTextureUnitStateIterator texIter = pass->getTextureUnitStateIterator();
+ size_t unit = 0;
+ // Reset the shadow texture index for each pass
+ size_t startLightIndex = pass->getStartLight();
+ size_t shadowTexUnitIndex = 0;
+ size_t shadowTexIndex = mShadowTextures.size();
+ if (mShadowTextureIndexLightList.size() > startLightIndex)
+ shadowTexIndex = mShadowTextureIndexLightList[startLightIndex];
+ while(texIter.hasMoreElements())
+ {
+ TextureUnitState* pTex = texIter.getNext();
+ if (!pass->getIteratePerLight() &&
+ isShadowTechniqueTextureBased() &&
+ pTex->getContentType() == TextureUnitState::CONTENT_SHADOW)
+ {
+ // Need to bind the correct shadow texture, based on the start light
+ // Even though the light list can change per object, our restrictions
+ // say that when texture shadows are enabled, the lights up to the
+ // number of texture shadows will be fixed for all objects
+ // to match the shadow textures that have been generated
+ // see Listener::sortLightsAffectingFrustum and
+ // MovableObject::Listener::objectQueryLights
+ // Note that light iteration throws the indexes out so we don't bind here
+ // if that's the case, we have to bind when lights are iterated
+ // in renderSingleObject
+
+ TexturePtr shadowTex;
+ if (shadowTexIndex < mShadowTextures.size())
+ {
+ shadowTex = getShadowTexture(shadowTexIndex);
+ // Hook up projection frustum
+ Camera *cam = shadowTex->getBuffer()->getRenderTarget()->getViewport(0)->getCamera();
+ // Enable projective texturing if fixed-function, but also need to
+ // disable it explicitly for program pipeline.
+ pTex->setProjectiveTexturing(!pass->hasVertexProgram(), cam);
+ mAutoParamDataSource->setTextureProjector(cam, shadowTexUnitIndex);
+ }
+ else
+ {
+ // Use fallback 'null' shadow texture
+ // no projection since all uniform colour anyway
+ shadowTex = mNullShadowTexture;
+ pTex->setProjectiveTexturing(false);
+ mAutoParamDataSource->setTextureProjector(0, shadowTexUnitIndex);
+
+ }
+ pTex->_setTexturePtr(shadowTex);
+
+ ++shadowTexIndex;
+ ++shadowTexUnitIndex;
+ }
+ else if (mIlluminationStage == IRS_NONE && pass->hasVertexProgram())
+ {
+ // Manually set texture projector for shaders if present
+ // This won't get set any other way if using manual projection
+ TextureUnitState::EffectMap::const_iterator effi =
+ pTex->getEffects().find(TextureUnitState::ET_PROJECTIVE_TEXTURE);
+ if (effi != pTex->getEffects().end())
+ {
+ mAutoParamDataSource->setTextureProjector(effi->second.frustum, unit);
+ }
+ }
+ mDestRenderSystem->_setTextureUnitSettings(unit, *pTex);
+ ++unit;
+ }
+ // Disable remaining texture units
+ mDestRenderSystem->_disableTextureUnitsFrom(pass->getNumTextureUnitStates());
+ -}
+ -- TODO
+ mapM_ (uncurry $ setTextureUnitSettings time rs) $ zip [0..] textureUnitStates
+
+ -- Disable remaining texture units
+ forM_ [(length textureUnitStates)..((rscNumTextureUnits $ getCapabilities rs) - 1)] $ \tu -> do
+ -- TODO: dont disable disabled texunits
+ setActiveTextureUnit rs tu
+ setTexture rs Nothing
+
+ -- Set up non-texture related material settings
+ -- Depth buffer settings
+ --FIXME: high level haskell gl binding handles depth check activation and depth function in one function
+ setDepthBufferFunction rs depthCheck depthFunc
+ {- -- HINT: GL has unified function for this
+ setDepthBufferFunction rs depthFunc
+ setDepthBufferCheckEnabled rs depthCheck
+ -}
+ setDepthBufferWriteEnabled rs depthWrite
+ setDepthBias rs depthBiasConstant depthBiasSlopeScale
+
+ -- Alpha-reject settings
+ setAlphaRejectSettings rs alphaRejectFunc alphaRejectVal alphaToCoverageEnabled
+
+ -- Set colour write mode
+ -- Right now we only use on/off, not per-channel
+ setColourBufferWriteEnabled rs colourWrite colourWrite colourWrite colourWrite
+ -- TODO
+ {-
+ // Culling mode
+ if (isShadowTechniqueTextureBased()
+ && mIlluminationStage == IRS_RENDER_TO_TEXTURE
+ && mShadowCasterRenderBackFaces
+ && pass->getCullingMode() == CULL_CLOCKWISE)
+ {
+ // render back faces into shadow caster, can help with depth comparison
+ mPassCullingMode = CULL_ANTICLOCKWISE;
+ }
+ else
+ {
+ mPassCullingMode = pass->getCullingMode();
+ }
+ -}
+ -- TODO: calc cull mode according illumination stage
+ setCullingMode rs cullMode
+ -- Shading
+ setShadingType rs shadeOptions
+
+ -- Polygon mode
+ unless polygonModeOverrideable $
+ setPolygonMode rs polygonMode
+
+ -- TODO
+ {-
+ // set pass number
+ mAutoParamDataSource->setPassNumber( pass->getIndex() );
+
+ // mark global params as dirty
+ mGpuParamsDirty |= (uint16)GPV_GLOBAL;
+ -}
+ return ()
+
+{-
+ const TexturePtr& TextureUnitState::_getTexturePtr(size_t frame) const
+ {
+ if (mContentType == CONTENT_NAMED)
+ {
+ if (frame < mFrames.size() && !mTextureLoadFailed)
+ {
+ ensureLoaded(frame);
+ return mFramePtrs[frame];
+ }
+ else
+ {
+ // Silent fail with empty texture for internal method
+ static TexturePtr nullTexPtr;
+ return nullTexPtr;
+ }
+ }
+ else
+ {
+ // Manually bound texture, no name or loading
+ assert(frame < mFramePtrs.size());
+ return mFramePtrs[frame];
+ }
+ }
+-}
+
+{-| Utility function for setting all the properties of a texture unit at once.
+This method is also worth using over the individual texture unit settings because it
+only sets those settings which are different from the current settings for this
+unit, thus minimising render state changes.
+-}
+--setTextureUnitSettings :: RenderSystem a vb ib q t p => a -> Int -> TextureUnitState t -> IO ()
+setTextureUnitSettings time rs texUnit tl = do
+ -- This method is only ever called to set a texture unit to valid details
+ -- The method _disableTextureUnit is called to turn a unit off
+ let rsc = getCapabilities rs
+ caps = rscCapabilities rsc
+ TextureUnitState
+ { tusAnimDuration = animDuration
+-- , tusCubic :: Bool -- ^ is this a series of 6 2D textures to make up a cube?
+
+ , tusTextureType = texType
+-- , tusDesiredFormat :: PixelFormat
+-- , tusTextureSrcMipmaps :: Int -- ^ Request number of mipmaps
+
+-- , tusTextureCoordSetIndex :: Int
+ , tusAddressMode = uvw
+ , tusBorderColour = borderColour
+
+ , tusColourBlendMode = colourBlendMode
+-- , tusColourBlendFallbackSrc :: SceneBlendFactor
+-- , tusColourBlendFallbackDest :: SceneBlendFactor
+
+ , tusAlphaBlendMode = alphaBlendMode
+ -- mutable bool mTextureLoadFailed;
+ -- , tusTextureLoadFailed :: Bool
+-- , tusIsAlpha :: Bool
+-- , tusHwGamma :: Bool
+
+ -- mutable bool mRecalcTexMatrix;
+ -- Real mUMod, mVMod;
+ -- Real mUScale, mVScale;
+ -- Radian mRotate;
+ -- mutable Matrix4 mTexModMatrix;
+
+ , tusMinFilter = minFilter
+ , tusMagFilter = magFilter
+ , tusMipFilter = mipFilter
+
+ , tusMaxAniso = maxAniso
+ , tusMipmapBias = mipmapBias
+
+ -- bool mIsDefaultAniso;
+ -- bool mIsDefaultFiltering;
+ , tusBindingType = bindingType
+-- , tusContentType :: ContentType -- ^ Content type of texture (normal loaded texture, auto-texture)
+
+-- , tusFrameNames :: [String]
+ , tusFrames = frames
+-- , tusName :: String -- ^ optional name for the TUS
+-- , tusTextureAlias :: String -- ^ optional alias for texture frames
+ , tusEffects = effects
+ } = tl
+ texl = fromMaybe (error "fromJust 12") frames -- TODO: const TexturePtr& tex = tl._getTexturePtr();
+
+ -- Activate TextureUnit
+ setActiveTextureUnit rs texUnit
+ -- Vertex texture binding?
+ unless (null texl) $ do
+ let tex = case animDuration of
+ { Nothing -> head texl
+ ; Just 0 -> head texl
+ ; Just d -> texl !! (floor $ (fromIntegral $ length texl) * (snd $ properFraction $ time / d))
+ }
+ case (Set.member RSC_VERTEX_TEXTURE_FETCH caps && (not $ rscVertexTextureUnitsShared rsc)) of
+ { True -> case bindingType of
+ { BT_VERTEX -> do
+ -- Bind vertex texture
+ setVertexTexture rs $ Just tex
+ -- bind nothing to fragment unit (hardware isn't shared but fragment
+ -- unit can't be using the same index
+ setTexture rs Nothing
+ ; _ -> do
+ -- vice versa
+ setVertexTexture rs Nothing
+ setTexture rs $ Just tex
+ }
+ ; False -> do
+ -- Shared vertex / fragment textures or no vertex texture support
+ -- Bind texture (may be blank)
+ setTexture rs $ Just tex
+ }
+
+ -- Set texture layer filtering
+ setTextureUnitFiltering rs texType minFilter magFilter mipFilter
+
+ -- Set texture layer filtering
+ when (Set.member RSC_ANISOTROPY caps) $
+ setTextureLayerAnisotropy rs texType maxAniso
+
+ -- Set mipmap biasing
+ when (Set.member RSC_MIPMAP_LOD_BIAS caps) $
+ setTextureMipmapBias rs mipmapBias
+
+ -- Set blend modes
+ -- Check to see if blending is supported
+ when (Set.member RSC_BLENDING caps) $ do
+ setTextureBlendMode rs colourBlendMode alphaBlendMode
+ --HINT: Obsolete below, due to stateful behaviour
+ -- Note, colour before alpha is important
+ --setTextureBlendMode rs colourBlendMode
+ --setTextureBlendMode rs alphaBlendMode
+
+ -- Texture addressing mode
+ setTextureAddressingMode rs texType uvw
+ -- Set texture border colour only if required
+ when ( amU uvw == TAM_BORDER ||
+ amV uvw == TAM_BORDER ||
+ amW uvw == TAM_BORDER ) $
+ setTextureBorderColour rs texType borderColour
+
+ -- Set texture effects
+ -- TODO
+-- mapM_ effects
+ setTextureCoordCalculation rs TEXCALC_NONE
+ forM_ effects $ \ e -> case teType e of
+ { ET_ENVIRONMENT_MAP -> setTextureCoordCalculation rs TEXCALC_ENVIRONMENT_MAP
+ ; _ -> return ()
+ }
+-- effects
+{-
+ // Set texture effects
+ TextureUnitState::EffectMap::iterator effi;
+ // Iterate over new effects
+ bool anyCalcs = false;
+ for (effi = tl.mEffects.begin(); effi != tl.mEffects.end(); ++effi)
+ {
+ switch (effi->second.type)
+ {
+ case TextureUnitState::ET_ENVIRONMENT_MAP:
+ if (effi->second.subtype == TextureUnitState::ENV_CURVED)
+ {
+ _setTextureCoordCalculation(texUnit, TEXCALC_ENVIRONMENT_MAP);
+ anyCalcs = true;
+ }
+ else if (effi->second.subtype == TextureUnitState::ENV_PLANAR)
+ {
+ _setTextureCoordCalculation(texUnit, TEXCALC_ENVIRONMENT_MAP_PLANAR);
+ anyCalcs = true;
+ }
+ else if (effi->second.subtype == TextureUnitState::ENV_REFLECTION)
+ {
+ _setTextureCoordCalculation(texUnit, TEXCALC_ENVIRONMENT_MAP_REFLECTION);
+ anyCalcs = true;
+ }
+ else if (effi->second.subtype == TextureUnitState::ENV_NORMAL)
+ {
+ _setTextureCoordCalculation(texUnit, TEXCALC_ENVIRONMENT_MAP_NORMAL);
+ anyCalcs = true;
+ }
+ break;
+ case TextureUnitState::ET_UVSCROLL:
+ case TextureUnitState::ET_USCROLL:
+ case TextureUnitState::ET_VSCROLL:
+ case TextureUnitState::ET_ROTATE:
+ case TextureUnitState::ET_TRANSFORM:
+ break;
+ case TextureUnitState::ET_PROJECTIVE_TEXTURE:
+ _setTextureCoordCalculation(texUnit, TEXCALC_PROJECTIVE_TEXTURE,
+ effi->second.frustum);
+ anyCalcs = true;
+ break;
+ }
+ }
+ // Ensure any previous texcoord calc settings are reset if there are now none
+ if (!anyCalcs)
+ {
+ _setTextureCoordCalculation(texUnit, TEXCALC_NONE);
+ }
+
+ // Change tetxure matrix
+ _setTextureMatrix(texUnit, tl.getTextureTransform());
+ }
+-}
+ return ()
+{-
+ const Matrix4& TextureUnitState::getTextureTransform() const
+ {
+ if (mRecalcTexMatrix)
+ recalcTextureMatrix();
+ return mTexModMatrix;
+
+ }
+-}
+calcTextureMatrix tus = do
+ return ()
+{-
+ //-----------------------------------------------------------------------
+ void TextureUnitState::recalcTextureMatrix() const
+ {
+ // Assumption: 2D texture coords
+ Matrix4 xform;
+
+ xform = Matrix4::IDENTITY;
+ if (mUScale != 1 || mVScale != 1)
+ {
+ // Offset to center of texture
+ xform[0][0] = 1/mUScale;
+ xform[1][1] = 1/mVScale;
+ // Skip matrix concat since first matrix update
+ xform[0][3] = (-0.5 * xform[0][0]) + 0.5;
+ xform[1][3] = (-0.5 * xform[1][1]) + 0.5;
+ }
+
+ if (mUMod || mVMod)
+ {
+ Matrix4 xlate = Matrix4::IDENTITY;
+
+ xlate[0][3] = mUMod;
+ xlate[1][3] = mVMod;
+
+ xform = xlate * xform;
+ }
+
+ if (mRotate != Radian(0))
+ {
+ Matrix4 rot = Matrix4::IDENTITY;
+ Radian theta ( mRotate );
+ Real cosTheta = Math::Cos(theta);
+ Real sinTheta = Math::Sin(theta);
+
+ rot[0][0] = cosTheta;
+ rot[0][1] = -sinTheta;
+ rot[1][0] = sinTheta;
+ rot[1][1] = cosTheta;
+ // Offset center of rotation to center of texture
+ rot[0][3] = 0.5 + ( (-0.5 * cosTheta) - (-0.5 * sinTheta) );
+ rot[1][3] = 0.5 + ( (-0.5 * sinTheta) + (-0.5 * cosTheta) );
+
+ xform = rot * xform;
+ }
+
+ mTexModMatrix = xform;
+ mRecalcTexMatrix = false;
+
+ }
+-}
diff --git a/Graphics/LambdaCube/RenderSystem/GL.hs b/Graphics/LambdaCube/RenderSystem/GL.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL.hs
@@ -0,0 +1,13 @@
+module Graphics.LambdaCube.RenderSystem.GL (mkGLRenderSystem,GLEntity,GLRenderEntity,GLVertexBuffer,GLIndexBuffer) where
+
+import Graphics.LambdaCube.Entity
+import Graphics.LambdaCube.RenderSystem
+import Graphics.LambdaCube.RenderSystem.GL.GLRenderSystem
+import Graphics.LambdaCube.RenderSystem.GL.GLVertexBuffer
+import Graphics.LambdaCube.RenderSystem.GL.GLIndexBuffer
+import Graphics.LambdaCube.RenderSystem.GL.GLTexture
+import Graphics.LambdaCube.RenderSystem.GL.GLGpuProgram
+
+type GLEntity = Entity GLVertexBuffer GLIndexBuffer GLTexture GLLinkedGpuProgram
+
+type GLRenderEntity = RenderEntity GLVertexBuffer GLIndexBuffer GLTexture GLLinkedGpuProgram
diff --git a/Graphics/LambdaCube/RenderSystem/GL/GLCapabilities.hs b/Graphics/LambdaCube/RenderSystem/GL/GLCapabilities.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL/GLCapabilities.hs
@@ -0,0 +1,404 @@
+module Graphics.LambdaCube.RenderSystem.GL.GLCapabilities where
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Graphics.LambdaCube.Types
+import Graphics.LambdaCube.RenderSystemCapabilities
+
+ {-
+ vendor, renderer, glVersion, glExtensions, shadingLanguageVersion,
+ majorMinor, contextProfile
+vendor :: GettableStateVar String
+renderer :: GettableStateVar String
+glVersion :: GettableStateVar String
+glExtensions :: GettableStateVar [String]
+shadingLanguageVersion :: GettableStateVar String
+
+ = DriverVersion
+ { dvMajor :: Int
+ , dvMinor :: Int
+ , dvRelease :: Int
+ , dvBuild :: Int
+ }
+ -}
+
+
+--mkRenderSystemCapabilities :: IO RenderSystemCapabilities
+mkGLCapabilities = do
+ vendorS <- GL.get GL.vendor
+ versionS <- GL.get GL.glVersion
+ extSList <- GL.get GL.glExtensions
+ shLngVerS <- GL.get GL.shadingLanguageVersion
+
+ -- setup driver version
+ {-
+ StringVector tokens = StringUtil::split(mGLSupport->getGLVersion(), ".");
+
+ if (!tokens.empty())
+ {
+ mDriverVersion.major = StringConverter::parseInt(tokens[0]);
+ if (tokens.size() > 1)
+ mDriverVersion.minor = StringConverter::parseInt(tokens[1]);
+ if (tokens.size() > 2)
+ mDriverVersion.release = StringConverter::parseInt(tokens[2]);
+ }
+ mDriverVersion.build = 0;
+ -}
+ -- setup device name
+ deviceName <- GL.get GL.renderer
+ {-
+ const char* deviceName = (const char*)glGetString(GL_RENDERER);
+ rsc->setDeviceName(deviceName);
+ -}
+ -- setup vendor
+ let v = words vendorS
+ vendorName = if elem "NVIDIA" v then GPU_NVIDIA
+ else if elem "ATI" v then GPU_ATI
+ else if elem "Intel" v then GPU_INTEL
+ else if elem "S3" v then GPU_S3
+ else if elem "Matrox" v then GPU_MATROX
+ else if elem "3DLabs" v then GPU_3DLABS
+ else if elem "SiS" v then GPU_SIS
+ else GPU_UNKNOWN
+
+ (major,minor) <- GL.get $ GL.majorMinor GL.glVersion
+ -- setup capabilities
+ let ext = Set.fromList extSList
+ glVer a b = major > a || (major >= a && minor >= b)
+ supports s = Set.member s ext
+ driverVersion = DriverVersion major minor 0 0 -- TODO
+ caps0 =
+ [ RSC_FIXED_FUNCTION -- Supports fixed-function
+ , RSC_SCISSOR_TEST -- Scissor test is standard in GL 1.2 (is it emulated on some cards though?)
+ , RSC_USER_CLIP_PLANES -- As are user clipping planes
+ , RSC_VERTEX_FORMAT_UBYTE4 -- UBYTE4 always supported
+ , RSC_INFINITE_FAR_PLANE -- Infinite far plane always supported
+ , RSC_TEXTURE_3D -- 3D textures should be supported by GL 1.2, which is our minimum version
+ ]
+
+ -- Check for hardware mipmapping support.
+ caps1 = if not (glVer 1 4 || supports "GL_SGIS_generate_mipmap") then [] else
+ [RSC_AUTOMIPMAP] -- FIXME
+ {-
+ case vendorName of
+ { GPU_ATI -> [] -- Apple & Linux ATI drivers have faults in hardware mipmap generation
+ -- The Intel 915G frequently corrupts textures when using hardware mip generation
+ -- I'm not currently sure how many generations of hardware this affects,
+ -- so for now, be safe.
+ ; GPU_INTEL -> []
+ ; GPU_SIS -> [] -- SiS chipsets also seem to have problems with this
+ ; _ -> [RSC_AUTOMIPMAP]
+ }
+ -}
+ -- Check for blending support
+ caps2 = if (glVer 1 3 || supports "GL_ARB_texture_env_combine" || supports "GL_EXT_texture_env_combine") then [RSC_BLENDING] else []
+
+ -- Check for Multitexturing support and set number of texture units
+ numTexUnits <- case glVer 1 3 || supports "GL_ARB_multitexture" of
+ { True -> do
+ GL.TextureUnit mtu <- GL.get GL.maxTextureUnit
+ mtimu <- case supports "GL_ARB_fragment_program" of
+ { True -> do
+ -- Also check GL_MAX_TEXTURE_IMAGE_UNITS_ARB since NV at least
+ -- only increased this on the FX/6x00 series
+ GL.get GL.maxTextureImageUnits
+ ; False -> return 0
+ }
+ -- FIXME: enable at becoming hgl binding
+ return mtimu -- $ max mtu (fromIntegral mtimu)
+ ; False -> return 1
+ }
+
+ -- Check for Anisotropy support
+ let caps3 = if (supports "GL_EXT_texture_filter_anisotropic") then [RSC_ANISOTROPY] else []
+
+ -- Check for DOT3 support
+ caps4 = if (glVer 1 3 || supports "GL_ARB_texture_env_dot3" || supports "GL_EXT_texture_env_dot3") then [RSC_DOT3] else []
+
+ -- Check for cube mapping
+ caps5 = if (glVer 1 3 || supports "GL_ARB_texture_cube_map" || supports "GL_EXT_texture_cube_map") then [RSC_CUBEMAPPING] else []
+
+ -- Point sprites
+ caps6 = if (glVer 2 0 || supports "GL_ARB_point_sprite") then [RSC_POINT_SPRITES] else []
+
+ -- Check for point parameters
+ caps7 = if (glVer 1 4) then [RSC_POINT_EXTENDED_PARAMETERS] else []
+ caps8 = if (supports "GL_ARB_point_parameters") then [RSC_POINT_EXTENDED_PARAMETERS_ARB] else []
+ caps9 = if (supports "GL_EXT_point_parameters") then [RSC_POINT_EXTENDED_PARAMETERS_EXT] else []
+
+ -- Check for hardware stencil support and set bit depth
+ stencilBits <- GL.get GL.stencilBits
+ let caps10 = if stencilBits > 0 then [RSC_HWSTENCIL] else []
+
+ caps11 = if not (glVer 1 5 || supports "GL_ARB_vertex_buffer_object") then [] else
+ [RSC_VBO] ++ (if not (supports "GL_ARB_vertex_buffer_object") then [RSC_GL1_5_NOVBO] else [])
+-- TODO: haskell gl binding does not support query for GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB
+{-
+ if(GLEW_ARB_vertex_program)
+ {
+ rsc->setCapability(RSC_VERTEX_PROGRAM);
+
+ // Vertex Program Properties
+ rsc->setVertexProgramConstantBoolCount(0);
+ rsc->setVertexProgramConstantIntCount(0);
+
+ GLint floatConstantCount;
+ glGetProgramivARB(GL_VERTEX_PROGRAM_ARB, GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB, &floatConstantCount);
+ rsc->setVertexProgramConstantFloatCount(floatConstantCount);
+
+ rsc->addShaderProfile("arbvp1");
+ if (GLEW_NV_vertex_program2_option)
+ {
+ rsc->addShaderProfile("vp30");
+ }
+
+ if (GLEW_NV_vertex_program3)
+ {
+ rsc->addShaderProfile("vp40");
+ }
+
+ if (GLEW_NV_vertex_program4)
+ {
+ rsc->addShaderProfile("gp4vp");
+ rsc->addShaderProfile("gpu_vp");
+ }
+ }
+-}
+ (prof1,caps12) = if supports "GL_NV_register_combiners2" && supports "GL_NV_texture_shader" then (["fp20"],[RSC_FRAGMENT_PROGRAM]) else ([],[])
+
+ -- check for ATI fragment shader support
+ -- no boolean params allowed
+ -- no integer params allowed
+ -- only 8 Vector4 constant floats supported
+ (prof2,caps13,fragConstBool,fragConstInt,fragConstFloat) = if supports "GL_ATI_fragment_shader" then (["ps_1_4","ps_1_3","ps_1_2","ps_1_1"],[RSC_FRAGMENT_PROGRAM],0,0,8) else ([],[],0,0,0)
+-- TODO
+------------------------------------------------------------------------------
+{-
+ (prof,cap,fragConstBool,fragConstInt,fragConstFloat) <- case supports "GL_ARB_fragment_program" of
+ { True -> do
+ -- Fragment Program Properties
+ return ([],[RSC_FRAGMENT_PROGRAM],0,0,)
+ ; False -> ([],[],0,0,0)
+ }
+-}
+{-
+
+ if (GLEW_ARB_fragment_program)
+ {
+ rsc->setCapability(RSC_FRAGMENT_PROGRAM);
+
+ // Fragment Program Properties
+ rsc->setFragmentProgramConstantBoolCount(0);
+ rsc->setFragmentProgramConstantIntCount(0);
+
+ GLint floatConstantCount;
+ glGetProgramivARB(GL_FRAGMENT_PROGRAM_ARB, GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB, &floatConstantCount);
+ rsc->setFragmentProgramConstantFloatCount(floatConstantCount);
+
+ rsc->addShaderProfile("arbfp1");
+ if (GLEW_NV_fragment_program_option)
+ {
+ rsc->addShaderProfile("fp30");
+ }
+
+ if (GLEW_NV_fragment_program2)
+ {
+ rsc->addShaderProfile("fp40");
+ }
+ }
+-}
+------------------------------------------------------------------------------
+ -- Check if GLSL is supported
+ prof3 = if glVer 2 0 ||
+ (supports "GL_ARB_shading_language_100"
+ && supports "GL_ARB_shader_objects"
+ && supports "GL_ARB_fragment_shader"
+ && supports "GL_ARB_vertex_shader") then ["glsl"] else []
+-- TODO
+--------------------------------------------------------------------------------------
+ -- Check if geometry shaders are supported
+ {-
+ (cap,prof,boolC,intC,floatC,outVertN) <- case glVer 2 0 && supports "GL_EXT_geometry_shader4" of
+ { True -> do
+ return ([RSC_GEOMETRY_PROGRAM],["nvgp4","gpu_gp","gp4gp"],0,0,)
+ ; False -> return ([],[],0,0,0,0)
+ }
+ -}
+{-
+ // Check if geometry shaders are supported
+ if (GLEW_VERSION_2_0 &&
+ GLEW_EXT_geometry_shader4)
+ {
+ rsc->setCapability(RSC_GEOMETRY_PROGRAM);
+ rsc->addShaderProfile("nvgp4");
+
+ //Also add the CG profiles
+ rsc->addShaderProfile("gpu_gp");
+ rsc->addShaderProfile("gp4gp");
+
+ rsc->setGeometryProgramConstantBoolCount(0);
+ rsc->setGeometryProgramConstantIntCount(0);
+
+ GLint floatConstantCount;
+ glGetProgramivARB(GL_GEOMETRY_PROGRAM_NV, GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB, &floatConstantCount);
+ rsc->setGeometryProgramConstantFloatCount(floatConstantCount);
+
+ GLint maxOutputVertices;
+ glGetIntegerv(GL_MAX_GEOMETRY_OUTPUT_VERTICES_EXT,&maxOutputVertices);
+ rsc->setGeometryProgramNumOutputVertices(maxOutputVertices);
+ }
+-}
+--------------------------------------------------------------------------------------
+ -- Check if render to vertex buffer (transform feedback in OpenGL)
+ caps14 = if (glVer 2 0 && supports "GL_NV_transform_feedback") then [RSC_HWRENDER_TO_VERTEX_BUFFER] else []
+
+ -- Check for texture compression
+ caps15 = if not (glVer 1 3 || supports "GL_ARB_texture_compression") then [] else
+ [RSC_TEXTURE_COMPRESSION]
+ -- Check for dxt compression
+ --------------------------------------------------------------------------------
+ {- FIXME: we should disable DXT on (apple && ati && ppc)
+ -- if defined(__APPLE__) && defined(__PPC__)
+ -- // Apple on ATI & PPC has errors in DXT
+ -- if (mGLSupport->getGLVendor().find("ATI") == std::string::npos)
+ -- endif
+ -}
+ --------------------------------------------------------------------------------
+ ++ (if supports "GL_EXT_texture_compression_s3tc" then [RSC_TEXTURE_COMPRESSION_DXT] else [])
+ -- Check for vtc compression
+ ++ (if supports "GL_NV_texture_compression_vtc" then [RSC_TEXTURE_COMPRESSION_VTC] else [])
+
+ -- 2-sided stencil?
+ caps16 = if (glVer 2 0 || supports "GL_EXT_stencil_two_side") then [RSC_TWO_SIDED_STENCIL] else []
+ caps17 = if (glVer 1 4 || supports "GL_EXT_stencil_wrap") then [RSC_STENCIL_WRAP] else []
+
+ -- Check for hardware occlusion support
+ caps18 = case glVer 1 5 || supports "GL_ARB_occlusion_query" of
+ -- Some buggy driver claim that it is GL 1.5 compliant and not support ARB_occlusion_query
+ { True -> [RSC_HWOCCLUSION] ++ (if not (supports "GL_ARB_occlusion_query") then [RSC_GL1_5_NOHWOCCLUSION] else [])
+ -- Support NV extension too for old hardware
+ ; False -> if supports "GL_NV_occlusion_query" then [RSC_HWOCCLUSION] else []
+ }
+ -- Check for non-power-of-2 texture support
+ caps19 = if (supports "GL_ARB_texture_non_power_of_two") then [RSC_NON_POWER_OF_2_TEXTURES] else []
+
+ -- Check for Float textures
+ caps20 = if (supports "GL_ATI_texture_float" || supports "GL_ARB_texture_float") then [RSC_TEXTURE_FLOAT] else []
+
+ -- Check for framebuffer object extension
+ (numMTR,caps21) <- case supports "GL_EXT_framebuffer_object" of
+ { True -> do
+ -- Probe number of draw buffers
+ -- Only makes sense with FBO support, so probe here
+ (n,c) <- case glVer 2 0 || supports "GL_ARB_draw_buffers" || supports "GL_ATI_draw_buffers" of
+ { True -> do
+ m <- GL.get GL.maxDrawBuffers
+ -- Before GL version 2.0, we need to get one of the extensions
+ let cp = case (glVer 2 0, supports "GL_ARB_draw_buffers", supports "GL_ATI_draw_buffers") of
+ { (False,True,True) -> [RSC_FBO_ARB,RSC_FBO_ATI]
+ ; (False,True,False) -> [RSC_FBO_ARB]
+ ; (False,False,True) -> [RSC_FBO_ATI]
+ ; _ -> []
+ }
+ -- Set FBO flag for all 3 'subtypes'
+ return (m,[RSC_MRT_DIFFERENT_BIT_DEPTHS,RSC_FBO] ++ cp)
+ ; False -> return (0,[])
+ }
+ return (n,RSC_HWRENDER_TO_TEXTURE:c)
+ ; False -> do
+ -- TODO
+ ----------------------------------------------
+ {-
+ // Check GLSupport for PBuffer support
+ if(mGLSupport->supportsPBuffers())
+ {
+ // Use PBuffers
+ rsc->setCapability(RSC_HWRENDER_TO_TEXTURE);
+ rsc->setCapability(RSC_PBUFFER);
+ }
+ -}
+ ----------------------------------------------
+ return (0,[])
+ }
+ ------------------------------------------------------
+ -- FIXE: haskell gl binding does not have query for GL_POINT_SIZE_RANGE
+ -- Point size
+ (_,maxPointSize) <- GL.get GL.pointSizeRange
+ {-
+ if (GLEW_VERSION_1_4)
+ {
+ float ps;
+ glGetFloatv(GL_POINT_SIZE_MAX, &ps);
+ rsc->setMaxPointSize(ps);
+ }
+ else
+ {
+ GLint vSize[2];
+ glGetIntegerv(GL_POINT_SIZE_RANGE,vSize);
+ rsc->setMaxPointSize(vSize[1]);
+ }
+ -}
+ -- Point size: Ends here
+ ------------------------------------------------------
+
+ -- Vertex texture fetching
+ (numVertTexUnits,caps22,vertTexUnitsShared) <- case supports "GL_ARB_vertex_shader" of
+ { True -> do
+ vunits <- GL.get GL.maxVertexTextureImageUnits
+ -- GL always shares vertex and fragment texture units (for now?)
+ return (vunits,if vunits > 0 then [RSC_VERTEX_TEXTURE_FETCH] else [], True)
+ ; False -> return (0,[],False)
+ }
+
+ -- Mipmap LOD biasing?
+ let caps23 = if (glVer 1 4 || supports "GL_EXT_texture_lod_bias") then [RSC_MIPMAP_LOD_BIAS] else []
+
+ -- Alpha to coverage?
+ -- Alpha to coverage always 'supported' when MSAA is available
+ -- although card may ignore it if it doesn't specifically support A2C
+ caps24 = if (supports "GL_ARB_multisample") then [RSC_ALPHA_TO_COVERAGE] else []
+
+ -- Advanced blending operations
+ caps25 = if (glVer 2 0) then [RSC_ADVANCED_BLEND_OPERATIONS] else []
+ return RenderSystemCapabilities
+ { rscDriverVersion = driverVersion
+ , rscVendor = vendorName
+
+-- , rscNumWorldMatrices :: Int -- ^ The number of world matrices available
+ , rscNumTextureUnits = fromIntegral numTexUnits
+ , rscStencilBufferBitDepth = fromIntegral stencilBits
+-- , rscNumVertexBlendMatrices :: Int
+ , rscCapabilities = Set.fromList $ caps0 ++ caps1 ++ caps2 ++ caps3 ++ caps4 ++ caps5 ++ caps6 ++ caps7 ++ caps8 ++ caps9
+ ++ caps10 ++ caps11 ++ caps12 ++ caps13 ++ caps14 ++ caps15 ++ caps16 ++ caps17 ++ caps18 ++ caps19
+ ++ caps20 ++ caps21 ++ caps22 ++ caps23 ++ caps24 ++ caps25
+
+ , rscDeviceName = deviceName
+ , rscRenderSystemName = "OpenGL Rendering Subsystem"
+-- TODO
+ , rscVertexProgramConstantFloatCount = undefined
+ , rscVertexProgramConstantIntCount = undefined
+ , rscVertexProgramConstantBoolCount = undefined
+
+ , rscGeometryProgramConstantFloatCount = undefined
+ , rscGeometryProgramConstantIntCount = undefined
+ , rscGeometryProgramConstantBoolCount = undefined
+
+ , rscFragmentProgramConstantFloatCount = fragConstFloat
+ , rscFragmentProgramConstantIntCount = fragConstInt
+ , rscFragmentProgramConstantBoolCount = fragConstBool
+
+ , rscNumMultiRenderTargets = fromIntegral numMTR
+ , rscMaxPointSize = realToFrac maxPointSize
+ , rscNonPOW2TexturesLimited = False
+ , rscNumVertexTextureUnits = fromIntegral numVertTexUnits
+ , rscVertexTextureUnitsShared = vertTexUnitsShared
+-- TODO
+ , rscGeometryProgramNumOutputVertices = undefined
+
+ , rscSupportedShaderProfiles = Set.fromList $ prof1 ++ prof2 ++ prof3
+ }
+
diff --git a/Graphics/LambdaCube/RenderSystem/GL/GLGpuProgram.hs b/Graphics/LambdaCube/RenderSystem/GL/GLGpuProgram.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL/GLGpuProgram.hs
@@ -0,0 +1,147 @@
+module Graphics.LambdaCube.RenderSystem.GL.GLGpuProgram where
+
+import Data.Either
+
+import System.Log.Logger
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Graphics.LambdaCube.HardwareVertexBuffer
+import Graphics.LambdaCube.GpuProgram
+import Graphics.LambdaCube.GpuProgramParams
+
+-- Some drivers (e.g. OS X on nvidia) incorrectly determine the attribute binding automatically
+-- and end up aliasing existing built-ins. So avoid! Fixed builtins are:
+
+-- a builtin custom attrib name
+-- ----------------------------------------------
+-- 0 gl_Vertex vertex
+-- 1 n/a blendWeights
+-- 2 gl_Normal normal
+-- 3 gl_Color colour
+-- 4 gl_SecondaryColor secondary_colour
+-- 5 gl_FogCoord fog_coord
+-- 7 n/a blendIndices
+-- 8 gl_MultiTexCoord0 uv0
+-- 9 gl_MultiTexCoord1 uv1
+-- 10 gl_MultiTexCoord2 uv2
+-- 11 gl_MultiTexCoord3 uv3
+-- 12 gl_MultiTexCoord4 uv4
+-- 13 gl_MultiTexCoord5 uv5
+-- 14 gl_MultiTexCoord6 uv6, tangent
+-- 15 gl_MultiTexCoord7 uv7, binormal
+getFixedAttributeIndex :: VertexElementSemantic -> Int -> Int
+getFixedAttributeIndex semantic index = case semantic of
+ { VES_POSITION -> 0
+ ; VES_BLEND_WEIGHTS -> 1
+ ; VES_NORMAL -> 2
+ ; VES_DIFFUSE -> 3
+ ; VES_SPECULAR -> 4
+ ; VES_BLEND_INDICES -> 7
+ ; VES_TEXTURE_COORDINATES -> 8 + index
+ ; VES_TANGENT -> 14
+ ; VES_BINORMAL -> 15
+ --; _ -> error "Missing attribute!"
+ }
+
+isAttributeValid :: VertexElementSemantic -> Int -> Bool
+isAttributeValid semantic index = case semantic of
+ { VES_POSITION -> False
+ ; VES_NORMAL -> False
+ ; VES_DIFFUSE -> False
+ ; VES_SPECULAR -> False
+ ; VES_TEXTURE_COORDINATES -> False
+ ; VES_BLEND_WEIGHTS -> True
+ ; VES_BLEND_INDICES -> True
+ ; VES_BINORMAL -> True
+ ; VES_TANGENT -> True
+ }
+{-
+data GLGpuProgram
+ = GLGpuProgram
+ { glgpType :: GpuProgramType -- ^ The type of the program
+ , glgpFilename :: String -- ^ The name of the file to load source from (may be blank)
+ , glgpSource :: String -- ^ The assembler source of the program (may be blank until file loaded)
+ , glgpLoadFromFile :: Bool -- ^ Whether we need to load source from file or not
+ , glgpSyntaxCode :: String -- ^ Syntax code e.g. arbvp1, vs_2_0 etc
+ , glgpSkeletalAnimation :: Bool -- ^ Does this (vertex) program include skeletal animation?
+ , glgpMorphAnimation :: Bool -- ^ Does this (vertex) program include morph animation?
+ , glgpPoseAnimation :: Int -- ^ Does this (vertex) program include pose animation (count of number of poses supported)
+ , glgpVertexTextureFetch :: Bool -- ^ Does this (vertex) program require support for vertex texture fetch?
+ , glgpNeedsAdjacencyInfo :: Bool -- ^ Does this (geometry) program require adjacency information?
+ , glgpDefaultParams :: GpuProgramParameters -- ^ The default parameters for use with this object
+ , glgpCompileError :: Bool -- ^ Did we encounter a compilation error?
+
+ , glgpProgramObject :: GL.Program
+ }
+-}
+data GLGpuProgram
+ = GLGpuProgram
+ { glgpShaderObject :: Either GL.VertexShader GL.FragmentShader
+ }
+ deriving Eq
+
+data GLLinkedGpuProgram
+ = GLLinkedGpuProgram
+ { gllgpProgramObject :: GL.Program
+ }
+ deriving Eq
+
+instance LinkedGpuProgram GLLinkedGpuProgram --where
+
+instance GpuProgram GLGpuProgram --where
+-- gpType = undefined
+
+compileShader src = do
+ [shader] <- GL.genObjectNames 1
+ GL.shaderSource shader $= [src]
+ GL.compileShader shader
+
+ -- TEMP CODE
+ infoLog <- GL.get (GL.shaderInfoLog shader)
+ infoM "ResourceLibrary" $ "infoLog cmp " ++ infoLog
+ ok <- GL.get (GL.compileStatus shader)
+ case ok of
+ { False -> do
+ GL.deleteObjectNames [shader]
+ errl <- GL.get GL.errors
+ return $ Right $ "shader compilation failed: " ++ concat [show c ++ " - " ++ m ++ "\n" | GL.Error c m <- errl]
+ ; True -> return $ Left shader
+ }
+
+mkGLGpuProgram ptype src = case ptype of
+ { GPT_VERTEX_PROGRAM -> do
+ debugM "ResourceLibrary" $ "compiling vertex shader: "
+ s <- compileShader src
+ case s of
+ { Right m -> return $ Right m
+ ; Left sh -> return $ Left $ GLGpuProgram $ Left sh
+ }
+ ; GPT_FRAGMENT_PROGRAM -> do
+ debugM "ResourceLibrary" $ "compiling fragment shader: "
+ s <- compileShader src
+ case s of
+ { Right m -> return $ Right m
+ ; Left sh -> return $ Left $ GLGpuProgram $ Right sh
+ }
+ ; GPT_GEOMETRY_PROGRAM -> undefined
+ }
+
+mkGLLinkedGpuProgram :: [GLGpuProgram] -> IO (Either GLLinkedGpuProgram String)
+mkGLLinkedGpuProgram pl = do
+ [p] <- GL.genObjectNames 1
+ let vp = lefts $ map glgpShaderObject pl
+ fp = rights $ map glgpShaderObject pl
+ GL.attachedShaders p $= (vp, fp)
+ GL.linkProgram p
+
+ ok <- GL.get (GL.linkStatus p)
+ infoLog <- GL.get (GL.programInfoLog p)
+ infoM "ResourceLibrary" $ "infoLog link " ++ infoLog
+ case ok of
+ { False -> do
+ GL.deleteObjectNames [p]
+ errl <- GL.get GL.errors
+ return $ Right $ "GpuProgram linking failed: " ++ concat [show c ++ " - " ++ m ++ "\n" | GL.Error c m <- errl]
+ ; True -> return $ Left $ GLLinkedGpuProgram p
+ }
diff --git a/Graphics/LambdaCube/RenderSystem/GL/GLIndexBuffer.hs b/Graphics/LambdaCube/RenderSystem/GL/GLIndexBuffer.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL/GLIndexBuffer.hs
@@ -0,0 +1,142 @@
+module Graphics.LambdaCube.RenderSystem.GL.GLIndexBuffer where
+
+import Data.Word
+import Data.Maybe
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
+import Foreign.Storable
+import Foreign.C.Types
+import Foreign.Ptr
+import Data.IORef
+import Control.Monad
+
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Graphics.LambdaCube.RenderSystem
+import Graphics.LambdaCube.HardwareBuffer
+import Graphics.LambdaCube.HardwareIndexBuffer
+import Graphics.LambdaCube.RenderSystem.GL.GLUtils
+
+
+-- | Specialisation of HardwareIndexBuffer for GL
+data GLIndexBuffer
+ = GLIndexBuffer
+ { glibType :: IndexType
+ , glibNumIndexes :: Int
+
+ , glibUsage :: Usage
+ , glibLockInfo :: IORef (Maybe (Int,Int,Bool)) -- LockStart LockSize RequireUpdate
+
+ , glibShadowBuffer :: Maybe (Ptr Word8)
+ , glibBufferObject :: Maybe GL.BufferObject
+ }
+ deriving Eq
+
+instance HardwareIndexBuffer GLIndexBuffer where
+ getIndexType = glibType
+ getNumIndexes = glibNumIndexes
+ getIndexSize b = case getIndexType b of
+ { IT_16BIT -> 2
+ ; IT_32BIT -> 4
+ }
+
+instance HardwareBuffer GLIndexBuffer where
+ getSizeInBytes b = getIndexSize b * glibNumIndexes b
+ isSystemMemory = isNothing . glibBufferObject
+ hasShadowBuffer b = (isJust $ glibShadowBuffer b) && (isJust $ glibBufferObject b)
+ getUsage = glibUsage
+ isLocked = glibIsLocked
+ unlock = glibUnlock
+ lock = glibLock
+
+glibIsLocked b = do
+ i <- readIORef $ glibLockInfo b
+ return $ isJust i
+
+glibLock a offs len opts = do
+ lockinfo <- readIORef (glibLockInfo a)
+ when (isJust lockinfo) $ error "Cannot lock this buffer, it is already locked!"
+ writeIORef (glibLockInfo a) $ Just (offs,len,opts /= HBL_READ_ONLY)
+ case glibShadowBuffer a of
+ { Just b -> return $ plusPtr b offs
+ ; Nothing -> do
+ GL.bindBuffer GL.ElementArrayBuffer $= (glibBufferObject a)
+ -- Discard if required
+ when (opts == HBL_DISCARD) $ GL.bufferData GL.ElementArrayBuffer $= (fromIntegral $ getSizeInBytes a, nullPtr, getGLUsage $ getUsage a)
+ let isWriteOnly = case getUsage a of
+ { HBU_WRITE_ONLY -> True
+ ; HBU_STATIC_WRITE_ONLY -> True
+ ; HBU_DYNAMIC_WRITE_ONLY -> True
+ ; HBU_DYNAMIC_WRITE_ONLY_DISCARDABLE -> True
+ ; _ -> False
+ }
+ access = case (isWriteOnly,opts == HBL_READ_ONLY) of
+ { (False,False) -> GL.ReadWrite
+ ; (False,True) -> GL.ReadOnly
+ ; (True,_) -> GL.WriteOnly
+ }
+ mb <- GL.mapBuffer GL.ElementArrayBuffer access
+ case mb of
+ { Just b -> return $ plusPtr b offs
+ ; Nothing -> error "Index Buffer: Out of memory"
+ }
+ }
+
+glibUnlock a = do
+ lockinfo <- readIORef (glibLockInfo a)
+ let (lockStart,lockSize,reqUpdate) = case lockinfo of
+ { Just li -> li
+ ; Nothing -> error "Cannot unlock this buffer, it is not locked!"
+ }
+ writeIORef (glibLockInfo a) Nothing
+ case glibShadowBuffer a of
+ { Just b -> when reqUpdate $ do -- If we used the shadow buffer this time...
+ GL.bindBuffer GL.ElementArrayBuffer $= (glibBufferObject a)
+ case lockStart == 0 && lockSize == getSizeInBytes a of
+ { True -> GL.bufferData GL.ElementArrayBuffer $= (fromIntegral lockSize, b, getGLUsage $ getUsage a)
+ ; False -> GL.bufferSubData GL.ElementArrayBuffer GL.WriteToBuffer (fromIntegral lockStart) (fromIntegral lockSize) b
+ }
+ ; Nothing -> do
+ GL.bindBuffer GL.ElementArrayBuffer $= (glibBufferObject a)
+ ok <- GL.unmapBuffer GL.ElementArrayBuffer
+ unless ok $ error "Buffer data corrupted, please reload"
+ }
+
+--mkGLIndexBuffer :: RenderSystem rs vb _ _ => rs -> IndexType -> Int -> Usage -> Bool -> IO GLIndexBuffer
+mkGLIndexBuffer rs itype numIndexes usage useShadowBuffer = do
+ let isize = case itype of
+ { IT_16BIT -> 2
+ ; IT_32BIT -> 4
+ }
+ lockinfo <- newIORef Nothing
+ [bufferObject] <- GL.genObjectNames 1
+ GL.bindBuffer GL.ElementArrayBuffer $= Just bufferObject
+ GL.bufferData GL.ElementArrayBuffer $= (fromIntegral $ numIndexes * isize, nullPtr, getGLUsage usage)
+ shadowBuffer <- case useShadowBuffer of
+ { True -> do
+ b <- mallocBytes $ numIndexes * isize
+ return $ Just b
+ ; False -> return Nothing
+ }
+ return $ GLIndexBuffer
+ { glibType = itype
+ , glibNumIndexes = numIndexes
+
+ , glibUsage = usage
+ , glibLockInfo = lockinfo
+
+ , glibShadowBuffer = shadowBuffer
+ , glibBufferObject = Just bufferObject
+ }
+
+rmGLIndexBuffer :: GLIndexBuffer -> IO ()
+rmGLIndexBuffer a = do
+ case glibBufferObject a of
+ { Just b -> GL.deleteObjectNames [b]
+ ; Nothing -> return ()
+ }
+ case glibShadowBuffer a of
+ { Just b -> free b
+ ; Nothing -> return ()
+ }
diff --git a/Graphics/LambdaCube/RenderSystem/GL/GLOcclusionQuery.hs b/Graphics/LambdaCube/RenderSystem/GL/GLOcclusionQuery.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL/GLOcclusionQuery.hs
@@ -0,0 +1,37 @@
+module Graphics.LambdaCube.RenderSystem.GL.GLOcclusionQuery where
+
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Graphics.LambdaCube.HardwareOcclusionQuery
+
+data GLOcclusionQuery
+ = GLOcclusionQuery
+ { gloqQueryObject :: GL.QueryObject
+ }
+
+instance HardwareOcclusionQuery GLOcclusionQuery where
+ beginOcclusionQuery = glBeginOcclusionQuery
+ endOcclusionQuery = glEndOcclusionQuery
+ pullOcclusionQuery = glPullOcclusionQuery
+-- getLastQuerysPixelcount :: a -> IO Int
+ isStillOutstanding = glStillOutstanding
+
+mkGLOcclusionQuery = do
+ [q] <- GL.genObjectNames 1
+ return $ GLOcclusionQuery q
+
+rmGLOcclusionQuery o = do
+ GL.deleteObjectNames [gloqQueryObject o]
+
+glBeginOcclusionQuery o = GL.beginQuery GL.SamplesPassed $ gloqQueryObject o
+
+glEndOcclusionQuery o = GL.endQuery GL.SamplesPassed
+
+glPullOcclusionQuery o = do
+ c <- GL.get $ GL.queryResult $ gloqQueryObject o
+ return $ fromIntegral c
+
+glStillOutstanding o = do
+ b <- GL.get $ GL.queryResultAvailable $ gloqQueryObject o
+ return $ not b
diff --git a/Graphics/LambdaCube/RenderSystem/GL/GLRenderSystem.hs b/Graphics/LambdaCube/RenderSystem/GL/GLRenderSystem.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL/GLRenderSystem.hs
@@ -0,0 +1,1402 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Graphics.LambdaCube.RenderSystem.GL.GLRenderSystem where
+
+import Data.IntMap ((!))
+import qualified Data.Map as Map
+import qualified Data.IntMap as IntMap
+import qualified Data.Set as Set
+import Data.IORef
+import Data.Word
+import Data.Maybe
+import Control.Monad
+import Foreign.C.Types
+import Foreign.Ptr
+
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Graphics.LambdaCube.Types
+import Graphics.LambdaCube.Common
+import Graphics.LambdaCube.Math
+import Graphics.LambdaCube.BlendMode
+import Graphics.LambdaCube.HardwareBuffer
+import Graphics.LambdaCube.HardwareVertexBuffer
+import Graphics.LambdaCube.HardwareIndexBuffer
+import Graphics.LambdaCube.VertexIndexData
+import Graphics.LambdaCube.RenderOperation
+import Graphics.LambdaCube.Texture
+import Graphics.LambdaCube.TextureUnitState
+import Graphics.LambdaCube.GpuProgram
+import Graphics.LambdaCube.RenderSystemCapabilities
+import Graphics.LambdaCube.RenderSystem
+import Graphics.LambdaCube.RenderSystem.GL.GLGpuProgram
+import Graphics.LambdaCube.RenderSystem.GL.GLTexture
+import Graphics.LambdaCube.RenderSystem.GL.GLVertexBuffer
+import Graphics.LambdaCube.RenderSystem.GL.GLIndexBuffer
+import Graphics.LambdaCube.RenderSystem.GL.GLOcclusionQuery
+import Graphics.LambdaCube.RenderSystem.GL.GLUtils
+import Graphics.LambdaCube.RenderSystem.GL.GLCapabilities
+
+data GLRenderSystem
+ = GLRenderSystem
+ { glrsWorldMatrix :: IORef (GL.GLmatrix GL.GLfloat)
+ , glrsViewMatrix :: IORef (GL.GLmatrix GL.GLfloat)
+ , glrsCapabilities :: RenderSystemCapabilities
+ }
+
+mkGLRenderSystem = do
+ mat <- toGLMatrix $ scal 1
+ worldMat <- newIORef mat
+ viewMat <- newIORef mat
+ cap <- mkGLCapabilities
+
+ -- Initialize OpenGL
+ extSList <- GL.get GL.glExtensions
+ (major,minor) <- GL.get $ GL.majorMinor GL.glVersion
+ -- setup capabilities
+ let ext = Set.fromList extSList
+ glVer a b = major > a || (major >= a && minor >= b)
+ supports s = Set.member s ext
+
+ when (glVer 1 2) $ do
+ -- Set nicer lighting model -- d3d9 has this by default
+ GL.lightModelColorControl $= GL.SeparateSpecularColor
+ GL.lightModelLocalViewer $= GL.Enabled
+
+ when (glVer 1 4) $ do
+ GL.colorSum $= GL.Enabled
+ GL.dither $= GL.Disabled
+
+ -- Check for FSAA
+ when (supports "GL_ARB_multisample") $ do
+ fsaa <- GL.get GL.sampleBuffers
+ when (fsaa > 0) $
+ GL.multisample $= GL.Enabled
+
+ return $ GLRenderSystem
+ { glrsWorldMatrix = worldMat
+ , glrsViewMatrix = viewMat
+ , glrsCapabilities = cap
+ }
+
+glDirtyHackCopyTexImage tex x y w h = do
+ GL.textureBinding GL.Texture2D $= (Just $ gltxTextureObject tex)
+ -- only hint code: glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_LUMINANCE, 0, 0, 128, 128, 0);
+ GL.copyTexImage2D Nothing 0 GL.RGBA' (GL.Position (fromIntegral x) (fromIntegral y)) (GL.TextureSize2D (fromIntegral w) (fromIntegral h)) 0
+
+
+instance RenderSystem GLRenderSystem GLVertexBuffer GLIndexBuffer GLOcclusionQuery GLTexture GLGpuProgram GLLinkedGpuProgram where
+ dirtyHackCopyTexImage _ = glDirtyHackCopyTexImage
+ getName _ = "OpenGL Rendering Subsystem"
+ getCapabilities = glrsCapabilities
+ createVertexBuffer = mkGLVertexBuffer
+ createIndexBuffer = mkGLIndexBuffer
+ createOcclusionQuery _ = mkGLOcclusionQuery
+ createTexture rs = mkGLTexture (glrsCapabilities rs)
+ createGpuProgram _ = mkGLGpuProgram
+ createLinkedGpuProgram _ = mkGLLinkedGpuProgram
+ bindLinkedGpuProgram _ = glBindLinkedGpuProgram
+ unbindLinkedGpuProgram _ = glUnBindLinkedGpuProgram
+ render _ = glRender
+ bindGeometry _ = glBindGeometry
+ unbindGeometry rs = glUnBindGeometry (glrsCapabilities rs)
+ setViewport _ x y w h = glSetViewport x y w h
+ setPolygonMode _ pm = glSetPolygonMode pm
+ setWorldMatrix = glSetWorldMatrix
+ setViewMatrix = glSetViewMatrix
+ setProjectionMatrix _ m = glSetProjectionMatrix m
+ clearFrameBuffer _ b c d s = glClearFrameBuffer b c d s
+ setShadingType _ = glSetShadingType
+ setCullingMode _ = glSetCullingMode
+ setAlphaRejectSettings rs = glSetAlphaRejectSettings (glrsCapabilities rs)
+ setDepthBias _ = glSetDepthBias
+ setDepthBufferWriteEnabled _ = glSetDepthBufferWriteEnabled
+ setDepthBufferFunction _ = glSetDepthBufferFunction --FIXME
+ setColourBufferWriteEnabled _ = glSetColourBufferWriteEnabled
+ setSurfaceParams _ = glSetSurfaceParams
+ setLightingEnabled _ = glSetLightingEnabled
+ setFog _ = glSetFog
+ setSceneBlending _ = glSetSceneBlending
+ setSeparateSceneBlending _ = glSetSeparateSceneBlending
+ setPointParameters = glSetPointParameters
+ setPointSpritesEnabled rs = glSetPointSpritesEnabled (glrsCapabilities rs)
+ setActiveTextureUnit _ = glSetActiveTextureUnit
+ setTexture _ = glSetTexture
+ setTextureAddressingMode _ = glSetTextureAddressingMode
+ setTextureUnitFiltering _ = glSetTextureUnitFiltering
+ setTextureLayerAnisotropy _ = glSetTextureLayerAnisotropy
+ setTextureMipmapBias _ = glSetTextureMipmapBias
+ setTextureMatrix _ = glSetTextureMatrix
+ setTextureBorderColour _ = glSetTextureBorderColour
+ setTextureCoordCalculation _ = glSetTextureCoordCalculation
+ setTextureBlendMode rs = glSetTextureBlendMode (glrsCapabilities rs)
+ getMinimumDepthInputValue _ = -1
+ getMaximumDepthInputValue _ = 1
+
+
+glSetDepthBias constantBias slopeScaleBias = case constantBias /= 0 || slopeScaleBias /= 0 of
+ { True -> do
+ GL.polygonOffsetFill $= GL.Enabled
+ GL.polygonOffsetPoint $= GL.Enabled
+ GL.polygonOffsetLine $= GL.Enabled
+ GL.polygonOffset $= (realToFrac (-slopeScaleBias), realToFrac (-constantBias))
+ ; False -> do
+ GL.polygonOffsetFill $= GL.Disabled
+ GL.polygonOffsetPoint $= GL.Disabled
+ GL.polygonOffsetLine $= GL.Disabled
+ }
+
+glSetViewport x y w h = do
+ let x' = fromIntegral x
+ y' = fromIntegral y
+ w' = fromIntegral w
+ h' = fromIntegral h
+ GL.viewport $= (GL.Position x' y', GL.Size w' h')
+ GL.scissor $= Just (GL.Position x' y', GL.Size w' h') -- Configure the viewport clipping
+
+glSetPolygonMode pm = case pm of
+ { PM_POINTS -> GL.polygonMode $= (GL.Point,GL.Point)
+ ; PM_WIREFRAME -> GL.polygonMode $= (GL.Line,GL.Line)
+ ; PM_SOLID -> GL.polygonMode $= (GL.Fill,GL.Fill)
+ }
+
+glSetWorldMatrix rs m = do
+ worldMat <- toGLMatrix m
+ writeIORef (glrsWorldMatrix rs) worldMat
+ viewMat <- readIORef $ glrsViewMatrix rs
+ GL.matrixMode $= (GL.Modelview 0)
+ GL.matrix (Just (GL.Modelview 0)) $= viewMat
+ GL.multMatrix worldMat
+
+glSetViewMatrix rs m = do
+ viewMat <- toGLMatrix m
+ writeIORef (glrsViewMatrix rs) viewMat
+ worldMat <- readIORef $ glrsWorldMatrix rs
+ GL.matrixMode $= (GL.Modelview 0)
+ GL.matrix (Just (GL.Modelview 0)) $= viewMat
+ GL.multMatrix worldMat
+
+glSetProjectionMatrix m = do
+ mat <- toGLMatrix m
+ GL.matrix (Just GL.Projection) $= mat
+
+glClearFrameBuffer buffers colour depth stencil = do
+ tmpColorMask <- GL.get GL.colorMask
+ tmpDepthMask <- GL.get GL.depthMask
+ tmpStencilMask <- GL.get GL.stencilMask
+ tmpScissor <- GL.get GL.scissor
+
+ when (fbtColour buffers) $ do
+ let (r',g',b',a') = colour
+ (r,g,b,a) = (f r',f g',f b',f a')
+ f :: FloatType -> GL.GLclampf
+ f = realToFrac
+ GL.colorMask $= GL.Color4 GL.Enabled GL.Enabled GL.Enabled GL.Enabled
+ GL.clearColor $= GL.Color4 r g b a
+
+ when (fbtDepth buffers) $ do
+ let f :: FloatType -> GL.GLclampd
+ f = realToFrac
+ GL.depthMask $= GL.Enabled
+ GL.clearDepth $= f depth
+
+ when (fbtStencil buffers) $ do
+ let f :: Word16 -> GL.GLint
+ f = fromIntegral
+ GL.stencilMask $= (maxBound::GL.GLuint)
+ GL.clearStencil $= f stencil
+
+ view <- GL.get GL.viewport
+ GL.scissor $= Just view
+
+ -- HINT: workaround for a mesa gma bug
+ when (fbtColour buffers) $ GL.clear [GL.ColorBuffer]
+ when (fbtDepth buffers) $ GL.clear [GL.DepthBuffer]
+ when (fbtStencil buffers) $ GL.clear [GL.StencilBuffer]
+ --GL.clear $ map fst $ filter (\(_,b) -> b) $ zip [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] [fbtColour buffers, fbtDepth buffers, fbtStencil buffers]
+
+ GL.scissor $= tmpScissor
+
+ GL.depthMask $= tmpDepthMask
+ GL.colorMask $= tmpColorMask
+ GL.stencilMask $= tmpStencilMask
+
+
+--glBindGeometry :: (HardwareVertexBuffer vb, HardwareIndexBuffer ib) => RenderOperation vb ib -> IO ()
+--glBindGeometry :: RenderOperation GLVertexBuffer GLIndexBuffer -> IO ()
+glBindGeometry ro tl = do
+ let multitexturing = True -- 1 < (rscNumTextureUnits rcap)
+ vertexData = roVertexData ro
+ decl = vdVertexDeclaration vertexData
+ checkBinding e = case vdVertexBufferBinding vertexData of
+ VertexBufferBinding bm -> veSource e `IntMap.member` bm
+ -- bind vertex elements
+ mapM_ (bindElement ro tl) $ filter checkBinding $ vdElementList decl
+
+ when multitexturing $ GL.clientActiveTexture $= GL.TextureUnit 0
+ -- bind index data and call draw operation
+ case roIndexData ro of
+ { Just indexData -> do
+ let indexBuffer = idIndexBuffer indexData
+ GL.bindBuffer GL.ElementArrayBuffer $= glibBufferObject indexBuffer
+ ; Nothing -> return ()
+ }
+
+--glUnBindGeometry :: RenderOperation GLVertexBuffer GLIndexBuffer -> IO ()
+glUnBindGeometry rsc ro = do
+ let multitexturing = True -- 1 < (rscNumTextureUnits rcap)
+ f :: Int -> GL.GLuint
+ f = fromIntegral
+
+ GL.clientState GL.VertexArray $= GL.Disabled
+
+ -- only valid up to GL_MAX_TEXTURE_UNITS, which is recorded in mFixedFunctionTextureUnits
+ case multitexturing of
+ { True -> do
+ forM_ [0..(rscNumTextureUnits rsc - 1)] $ \stage -> do
+ GL.clientActiveTexture $= (GL.TextureUnit $ f stage)
+ GL.clientState GL.TextureCoordArray $= GL.Disabled
+ GL.clientActiveTexture $= GL.TextureUnit 0
+ ; False -> GL.clientState GL.TextureCoordArray $= GL.Disabled
+ }
+ GL.clientState GL.NormalArray $= GL.Disabled
+ GL.clientState GL.ColorArray $= GL.Disabled
+ GL.clientState GL.SecondaryColorArray $= GL.Disabled
+
+ -- unbind any custom attributes
+ {-
+ for (vector::type::iterator ai = attribsBound.begin(); ai != attribsBound.end(); ++ai)
+ {
+ glDisableVertexAttribArrayARB(*ai);
+ }
+ -}
+
+ -- unbind buffers
+ GL.bindBuffer GL.ElementArrayBuffer $= Nothing
+ GL.bindBuffer GL.ArrayBuffer $= Nothing
+
+-- _render :: RenderSystemCapabilities -> RenderOperation -> IO ()
+--glRender :: Int -> GLRenderState -> RenderOperation -> IO GLRenderState
+--glRender :: (HardwareVertexBuffer vb, HardwareIndexBuffer ib) => Int -> RenderOperation vb ib -> IO ()
+glRender :: RenderOperation GLVertexBuffer GLIndexBuffer -> IO ()
+glRender ro = do
+ -- TODO:
+ -- calculate statistics
+ {-
+ -- Update stats
+ size_t val;
+
+ if (op.useIndexes)
+ val = op.indexData->indexCount;
+ else
+ val = op.vertexData->vertexCount;
+
+ -- account for a pass having multiple iterations
+ if (mCurrentPassIterationCount > 1)
+ val *= mCurrentPassIterationCount;
+ mCurrentPassIterationNum = 0;
+
+ switch(op.operationType)
+ {
+ case RenderOperation::OT_TRIANGLE_LIST:
+ mFaceCount += val / 3;
+ break;
+ case RenderOperation::OT_TRIANGLE_STRIP:
+ case RenderOperation::OT_TRIANGLE_FAN:
+ mFaceCount += val - 2;
+ break;
+ case RenderOperation::OT_POINT_LIST:
+ case RenderOperation::OT_LINE_LIST:
+ case RenderOperation::OT_LINE_STRIP:
+ break;
+ }
+
+ mVertexCount += op.vertexData->vertexCount;
+ mBatchCount += mCurrentPassIterationCount;
+
+ -- sort out clip planes
+ -- have to do it here in case of matrix issues
+ if (mClipPlanesDirty)
+ {
+ setClipPlanesImpl(mClipPlanes);
+ mClipPlanesDirty = false;
+ }
+ -}
+ -- TODO
+ let vertexData = roVertexData ro
+ multitexturing = True -- 1 < (rscNumTextureUnits rcap)
+ --Use adjacency if there is a geometry program and it requested adjacency info
+ -- TODO
+ --bool useAdjacency = (mGeometryProgramBound && mCurrentGeometryProgram->isAdjacencyInfoRequired());
+ primType = case roOperationType ro of -- Find the correct type to render
+ { OT_POINT_LIST -> GL.Points
+ ; OT_LINE_LIST -> GL.Lines
+ ; OT_LINE_STRIP -> GL.LineStrip
+ ; OT_TRIANGLE_LIST -> GL.Triangles
+ ; OT_TRIANGLE_STRIP -> GL.TriangleStrip
+ ; OT_TRIANGLE_FAN -> GL.TriangleFan
+ }
+ {-
+ GLint primType;
+ switch (op.operationType)
+ {
+ case RenderOperation::OT_POINT_LIST:
+ primType = GL_POINTS;
+ break;
+ case RenderOperation::OT_LINE_LIST:
+ primType = useAdjacency ? GL_LINES_ADJACENCY_EXT : GL_LINES;
+ break;
+ case RenderOperation::OT_LINE_STRIP:
+ primType = useAdjacency ? GL_LINE_STRIP_ADJACENCY_EXT : GL_LINE_STRIP;
+ break;
+ default:
+ case RenderOperation::OT_TRIANGLE_LIST:
+ primType = useAdjacency ? GL_TRIANGLES_ADJACENCY_EXT : GL_TRIANGLES;
+ break;
+ case RenderOperation::OT_TRIANGLE_STRIP:
+ primType = useAdjacency ? GL_TRIANGLE_STRIP_ADJACENCY_EXT : GL_TRIANGLE_STRIP;
+ break;
+ case RenderOperation::OT_TRIANGLE_FAN:
+ primType = GL_TRIANGLE_FAN;
+ break;
+ }
+ -}
+
+ -- bind index data and call draw operation
+ case roIndexData ro of
+ { Just indexData -> do
+ let indexBuffer = idIndexBuffer indexData
+ dp = if isJust $ glibBufferObject indexBuffer then nullPtr else fromMaybe (error "fromJust 7") $ glibShadowBuffer indexBuffer
+ pBufferData = plusPtr dp $ idIndexStart indexData * getIndexSize indexBuffer
+ indexType = if getIndexType indexBuffer == IT_16BIT then GL.UnsignedShort else GL.UnsignedInt
+ GL.drawElements primType (fromIntegral (idIndexCount indexData)) indexType pBufferData
+ ; Nothing -> do
+ GL.drawArrays primType 0 (fromIntegral (vdVertexCount vertexData))
+ }
+
+-- GL.color $ GL.Color4 1 1 1 (1 :: GL.GLfloat)
+-- GL.secondaryColor $ GL.Color3 0 0 (0 :: GL.GLfloat)
+ return ()
+{-
+ bool RenderSystem::updatePassIterationRenderState(void)
+ {
+ if (mCurrentPassIterationCount <= 1)
+ return false;
+
+ --mCurrentPassIterationCount;
+ ++mCurrentPassIterationNum;
+ if (!mActiveVertexGpuProgramParameters.isNull())
+ {
+ mActiveVertexGpuProgramParameters->incPassIterationNumber();
+ bindGpuProgramPassIterationParameters(GPT_VERTEX_PROGRAM);
+ }
+ if (!mActiveGeometryGpuProgramParameters.isNull())
+ {
+ mActiveGeometryGpuProgramParameters->incPassIterationNumber();
+ bindGpuProgramPassIterationParameters(GPT_GEOMETRY_PROGRAM);
+ }
+ if (!mActiveFragmentGpuProgramParameters.isNull())
+ {
+ mActiveFragmentGpuProgramParameters->incPassIterationNumber();
+ bindGpuProgramPassIterationParameters(GPT_FRAGMENT_PROGRAM);
+ }
+ return true;
+ }
+
+-}
+
+bindElement rop tl elem = do
+ let vertexData = roVertexData $ rop
+
+ case vdVertexBufferBinding vertexData of
+ VertexBufferBinding bm -> let vertexBuffer = bm ! (veSource elem) in do
+ dp <- case glvbBufferObject vertexBuffer of
+ { Just b -> do
+ GL.bindBuffer GL.ArrayBuffer $= Just b
+ return nullPtr
+ ; Nothing -> return $ fromMaybe (error "fromJust 8") $ glvbShadowBuffer vertexBuffer
+ }
+ let pBufferData = plusPtr dp $ vdVertexStart vertexData * getVertexSize vertexBuffer + veOffset elem
+ sem = veSemantic elem
+ isCustomAttrib = False
+ bindArray t = do
+ GL.arrayPointer t $= GL.VertexArrayDescriptor (fromIntegral . getTypeCount . veType $ elem) (getGLType . veType $ elem) (fromIntegral . getVertexSize $ vertexBuffer) pBufferData
+ GL.clientState t $= GL.Enabled
+ {-
+ if (mCurrentVertexProgram)
+ isCustomAttrib = mCurrentVertexProgram->isAttributeValid(sem, elem->getIndex());
+ -}
+ --bind vertexBuffer
+ case isCustomAttrib of
+ { True -> do
+ -- Custom attribute support
+ -- tangents, binormals, blendweights etc always via this route
+ -- builtins may be done this way too
+ let attrib = GL.AttribLocation . fromIntegral . getFixedAttributeIndex sem $ veIndex elem
+ GL.vertexAttribPointer attrib $= (GL.KeepIntegral,GL.VertexArrayDescriptor (fromIntegral . getTypeCount . veType $ elem) (getGLType . veType $ elem) (fromIntegral . getVertexSize $ vertexBuffer) pBufferData)
+ GL.vertexAttribArray attrib $= GL.Enabled
+ --attribsBound.push_back(attrib);
+ ; False -> case sem of -- fixed-function & builtin attribute support
+ { VES_POSITION -> bindArray GL.VertexArray
+ ; VES_NORMAL -> bindArray GL.NormalArray
+ ; VES_DIFFUSE -> bindArray GL.ColorArray
+ ; VES_SPECULAR -> bindArray GL.SecondaryColorArray
+ ; VES_TEXTURE_COORDINATES -> do
+ -- TODO
+ let idx = veIndex elem
+ tus = map fst $ filter (\(_,a)-> idx==a) $ zip [0..] $ map tusTextureCoordSetIndex tl
+ f :: Int -> GL.GLuint
+ f = fromIntegral
+ forM_ tus $ \tidx -> do
+ --print $ "bind stage="++show tidx ++ " texcoord="++show idx
+ GL.clientActiveTexture $= (GL.TextureUnit $ f tidx)
+ bindArray GL.TextureCoordArray
+ -- TEMP CODE
+{-
+ if (mCurrentVertexProgram)
+ {
+ -- Programmable pipeline - direct UV assignment
+ glClientActiveTextureARB(GL_TEXTURE0 + elem->getIndex());
+ glTexCoordPointer(
+ VertexElement::getTypeCount(elem->getType()),
+ GLBufferManager::getGLType(elem->getType()),
+ static_cast(vertexBuffer->getVertexSize()),
+ pBufferData);
+ glEnableClientState( GL_TEXTURE_COORD_ARRAY );
+ }
+ else
+ {
+ -- fixed function matching to units based on tex_coord_set
+ for (i = 0; i < mDisabledTexUnitsFrom; i++)
+ {
+ -- Only set this texture unit's texcoord pointer if it
+ -- is supposed to be using this element's index
+ if (mTextureCoordIndex[i] == elem->getIndex() && i < mFixedFunctionTextureUnits)
+ {
+ if (multitexturing)
+ glClientActiveTextureARB(GL_TEXTURE0 + i);
+ glTexCoordPointer(
+ VertexElement::getTypeCount(elem->getType()),
+ GLBufferManager::getGLType(elem->getType()),
+ static_cast(vertexBuffer->getVertexSize()),
+ pBufferData);
+ glEnableClientState( GL_TEXTURE_COORD_ARRAY );
+ }
+ }
+ }
+-}
+ }
+ }
+
+
+glSetShadingType so = case so of
+ { SO_FLAT -> GL.shadeModel $= GL.Flat
+ ; _ -> GL.shadeModel $= GL.Smooth
+ }
+
+glSetAlphaRejectSettings rsc func value alphaToCoverage = do
+ let caps = rscCapabilities rsc
+ f :: Int -> GL.GLclampf
+ f = fromIntegral
+ case func == CMPF_ALWAYS_PASS of
+ { True -> do
+ GL.alphaFunc $= Nothing
+ GL.sampleAlphaToCoverage $= GL.Disabled
+ ; False -> do
+ GL.alphaFunc $= Just (convertCompareFunction func, f value / 255)
+ let f x = case x of
+ { True -> GL.Enabled
+ ; False -> GL.Disabled
+ }
+ when (Set.member RSC_ALPHA_TO_COVERAGE caps) $
+ GL.sampleAlphaToCoverage $= f alphaToCoverage
+ }
+
+glSetDepthBufferWriteEnabled enabled = case enabled of
+ { True -> GL.depthMask $= GL.Enabled
+ ; False -> GL.depthMask $= GL.Disabled
+ }
+
+glSetDepthBufferFunction enabled func = do
+ GL.depthFunc $= if enabled then Just $ convertCompareFunction func else Nothing
+--FIXME: gl haskell binding has unified api for depthFunc
+--glSetDepthBufferCheckEnabled enabled = case enabled of
+
+glSetPointSpritesEnabled rsc enabled = do
+ case enabled of
+ { True -> GL.pointSprite $= GL.Enabled
+ ; False -> GL.pointSprite $= GL.Disabled
+ }
+ --FIXME: Haskell GL bininding does not support these
+ {-
+ let maxTex = rscNumTextureUnits rsc
+ a <- GL.get GL.activeTexture
+ -- Set sprite texture coord generation
+ -- Don't offer this as an option since D3D links it to sprite enabled
+ for (ushort i = 0; i < mFixedFunctionTextureUnits; ++i)
+ {
+ activateGLTextureUnit(i);
+ glTexEnvi(GL_POINT_SPRITE, GL_COORD_REPLACE,
+ enabled ? GL_TRUE : GL_FALSE);
+ }
+ GL.activeTexture $= a
+ -}
+
+glSetSceneBlending sourceFactor destFactor op = do
+ case sourceFactor == SBF_ONE && destFactor == SBF_ZERO of
+ { True -> GL.blend $= GL.Disabled
+ ; False -> do
+ GL.blend $= GL.Enabled
+ GL.blendFunc $= (getBlendMode sourceFactor, getBlendMode destFactor)
+ }
+ GL.blendEquation $= getBlendEquation op
+ -- FIXME
+ {-
+ if(GLEW_VERSION_1_4 || GLEW_ARB_imaging)
+ {
+ glBlendEquation(func);
+ }
+ else if(GLEW_EXT_blend_minmax && (func == GL_MIN || func == GL_MAX))
+ {
+ glBlendEquationEXT(func);
+ }
+ -}
+
+glSetSurfaceParams ambient diffuse specular emissive shininess (TrackVertexColourType a d s e) = do
+ -- Track vertex colour
+ -- There are actually 15 different combinations for tracking, of which
+ -- GL only supports the most used 5. This means that we have to do some
+ -- magic to find the best match. NOTE:
+ -- GL_AMBIENT_AND_DIFFUSE != GL_AMBIENT | GL__DIFFUSE
+ case (a,d,s,e) of
+ { (False,False,False,False) -> GL.colorMaterial $= Nothing
+ ; (True,True,_,_) -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.AmbientAndDiffuse)
+ ; (True,False,_,_) -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.Ambient)
+ ; (_,True,_,_) -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.Diffuse)
+ ; (_,_,True,_) -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.Specular)
+ ; (_,_,_,True) -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.Emission)
+ }
+ let f = realToFrac
+ c (r,g,b,a) = GL.Color4 (f r) (f g) (f b) (f a)
+ GL.materialDiffuse GL.FrontAndBack $= c diffuse
+ GL.materialAmbient GL.FrontAndBack $= c ambient
+ GL.materialSpecular GL.FrontAndBack $= c specular
+ GL.materialEmission GL.FrontAndBack $= c emissive
+ GL.materialShininess GL.FrontAndBack $= f shininess
+
+glSetLightingEnabled enabled = case enabled of
+ { True -> GL.lighting $= GL.Enabled
+ ; False -> GL.lighting $= GL.Disabled
+ }
+
+glSetFog mode colour density start end = do
+ let c (r,g,b,a) = GL.Color4 (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a)
+ case mode of
+ { FOG_NONE -> do
+ GL.fog $= GL.Disabled
+ ; FOG_EXP -> do
+ GL.fog $= GL.Enabled
+ GL.fogMode $= (GL.Exp $ realToFrac density)
+ GL.fogColor $= c colour
+ ; FOG_EXP2 -> do
+ GL.fog $= GL.Enabled
+ GL.fogMode $= (GL.Exp2 $ realToFrac density)
+ GL.fogColor $= c colour
+ ; FOG_LINEAR-> do
+ GL.fog $= GL.Enabled
+ GL.fogMode $= (GL.Linear (realToFrac start) (realToFrac end))
+ GL.fogColor $= c colour
+ }
+
+glSetSeparateSceneBlending sourceFactor destFactor sourceFactorAlpha destFactorAlpha op alphaOp = do
+ case sourceFactor == SBF_ONE && destFactor == SBF_ZERO &&
+ sourceFactorAlpha == SBF_ONE && destFactorAlpha == SBF_ZERO of
+ { True -> GL.blend $= GL.Disabled
+ ; False -> do
+ let f = getBlendMode
+ GL.blend $= GL.Enabled
+ GL.blendFuncSeparate $= ((f sourceFactor, f sourceFactorAlpha), (f destFactor, f destFactorAlpha))
+ }
+ GL.blendEquationSeparate $= (getBlendEquation op, getBlendEquation alphaOp)
+--FIXME: gl binding does not access these
+{-
+ if(GLEW_VERSION_2_0) {
+ glBlendEquationSeparate(func, alphaFunc);
+ }
+ else if(GLEW_EXT_blend_equation_separate) {
+ glBlendEquationSeparateEXT(func, alphaFunc);
+ }
+-}
+
+glSetPointParameters rs size attenuationEnabled constant linear quadratic minSize maxSize = do
+ let rsc = getCapabilities rs
+ caps = rscCapabilities rsc
+ (size',minSize',maxSize',constant',linear',quadratic') <- case attenuationEnabled of
+ { True -> do
+ -- Point size is still calculated in pixels even when attenuation is
+ -- enabled, which is pretty awkward, since you typically want a viewport
+ -- independent size if you're looking for attenuation.
+ -- So, scale the point size up by viewport size (this is equivalent to
+ -- what D3D does as standard)
+
+ -- TODO
+ {-
+ size = size * mActiveViewport->getActualHeight();
+ minSize = minSize * mActiveViewport->getActualHeight();
+ if (maxSize == 0.0f)
+ maxSize = mCurrentCapabilities->getMaxPointSize(); // pixels
+ else
+ maxSize = maxSize * mActiveViewport->getActualHeight();
+ -}
+ when (Set.member RSC_VERTEX_PROGRAM caps) $ GL.vertexProgramPointSize $= GL.Enabled
+ -- XXX: why do I need this for results to be consistent with D3D?
+ -- Equations are supposedly the same once you factor in vp height
+ let correction = 0.005
+ return (size,minSize,if maxSize == 0 then rscMaxPointSize rsc else maxSize,constant,linear * correction,quadratic * correction)
+ ; False -> do
+ when (Set.member RSC_VERTEX_PROGRAM caps) $ GL.vertexProgramPointSize $= GL.Disabled
+ return (size,minSize,if maxSize == 0 then rscMaxPointSize rsc else maxSize,constant,linear,quadratic)
+ }
+ --no scaling required
+ -- GL has no disabled flag for this so just set to constant
+ let f = realToFrac
+ GL.pointSize $= f size'
+ GL.pointDistanceAttenuation $= (f constant',f linear',f quadratic')
+ GL.pointSizeRange $= (f minSize',f maxSize')
+ -- FIXME: gl binding handles this
+ {-
+ if (mCurrentCapabilities->hasCapability(RSC_POINT_EXTENDED_PARAMETERS))
+ {
+ glPointParameterfv(GL_POINT_DISTANCE_ATTENUATION, val);
+ glPointParameterf(GL_POINT_SIZE_MIN, minSize);
+ glPointParameterf(GL_POINT_SIZE_MAX, maxSize);
+ }
+ else if (mCurrentCapabilities->hasCapability(RSC_POINT_EXTENDED_PARAMETERS_ARB))
+ {
+ glPointParameterfvARB(GL_POINT_DISTANCE_ATTENUATION, val);
+ glPointParameterfARB(GL_POINT_SIZE_MIN, minSize);
+ glPointParameterfARB(GL_POINT_SIZE_MAX, maxSize);
+ }
+ else if (mCurrentCapabilities->hasCapability(RSC_POINT_EXTENDED_PARAMETERS_EXT))
+ {
+ glPointParameterfvEXT(GL_POINT_DISTANCE_ATTENUATION, val);
+ glPointParameterfEXT(GL_POINT_SIZE_MIN, minSize);
+ glPointParameterfEXT(GL_POINT_SIZE_MAX, maxSize);
+ }
+ -}
+ return ()
+
+glSetActiveTextureUnit stage = do
+ let f :: Int -> GL.GLuint
+ f = fromIntegral
+ GL.activeTexture $= GL.TextureUnit (f stage)
+{-
+ if (GLEW_VERSION_1_2 && unit < getCapabilities()->getNumTextureUnits())
+ {
+ glActiveTextureARB(GL_TEXTURE0 + unit);
+ mActiveTextureUnit = unit;
+ return true;
+ }
+ else if (!unit)
+ {
+ // always ok to use the first unit
+ return true;
+ }
+ else
+ {
+ return false;
+ }
+-}
+
+glSetTexture tex = case tex of
+ { Just t -> do
+ --TEMP CODE
+ GL.texture GL.Texture1D $= GL.Disabled
+ GL.textureBinding GL.Texture1D $= Nothing
+
+ GL.texture GL.Texture2D $= GL.Disabled
+ GL.textureBinding GL.Texture2D $= Nothing
+
+ GL.texture GL.Texture3D $= GL.Disabled
+ GL.textureBinding GL.Texture3D $= Nothing
+
+ GL.texture GL.TextureCubeMap $= GL.Disabled
+ GL.textureBinding GL.TextureCubeMap $= Nothing
+
+ let target = getGLTextureTarget $ txTextureType t
+ GL.texture target $= GL.Enabled
+ GL.textureBinding target $= (Just $ gltxTextureObject t)
+ ; Nothing -> do
+ --TODO
+ GL.texture GL.Texture1D $= GL.Disabled
+ GL.textureBinding GL.Texture1D $= Nothing
+
+ GL.texture GL.Texture2D $= GL.Disabled
+ GL.textureBinding GL.Texture2D $= Nothing
+
+ GL.texture GL.Texture3D $= GL.Disabled
+ GL.textureBinding GL.Texture3D $= Nothing
+
+ GL.texture GL.TextureCubeMap $= GL.Disabled
+ GL.textureBinding GL.TextureCubeMap $= Nothing
+ }
+
+{-
+ void GLRenderSystem::_setTexture(size_t stage, bool enabled, const TexturePtr &texPtr)
+ {
+ GLTexturePtr tex = texPtr;
+
+ GLenum lastTextureType = mTextureTypes[stage];
+
+ if (!activateGLTextureUnit(stage))
+ return;
+
+ if (enabled)
+ {
+ if (!tex.isNull())
+ {
+ // note used
+ tex->touch();
+ mTextureTypes[stage] = tex->getGLTextureTarget();
+ }
+ else
+ // assume 2D
+ mTextureTypes[stage] = GL_TEXTURE_2D;
+
+ if(lastTextureType != mTextureTypes[stage] && lastTextureType != 0)
+ {
+ if (stage < mFixedFunctionTextureUnits)
+ {
+ glDisable( lastTextureType );
+ }
+ }
+
+ if (stage < mFixedFunctionTextureUnits)
+ {
+ glEnable( mTextureTypes[stage] );
+ }
+
+ if(!tex.isNull())
+ glBindTexture( mTextureTypes[stage], tex->getGLID() );
+ else
+ glBindTexture( mTextureTypes[stage], static_cast(mTextureManager)->getWarningTextureID() );
+ }
+ else
+ {
+ if (stage < mFixedFunctionTextureUnits)
+ {
+ if (lastTextureType != 0)
+ {
+ glDisable( mTextureTypes[stage] );
+ }
+ glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
+ }
+ // bind zero texture
+ glBindTexture(GL_TEXTURE_2D, 0);
+ }
+
+ activateGLTextureUnit(0);
+ }
+
+ void GLRenderSystem::_setTextureCoordSet(size_t stage, size_t index)
+ {
+ mTextureCoordIndex[stage] = index;
+ }
+-}
+{-
+ void GLRenderSystem::_useLights(const LightList& lights, unsigned short limit)
+ {
+ // Save previous modelview
+ glMatrixMode(GL_MODELVIEW);
+ glPushMatrix();
+ // just load view matrix (identity world)
+ GLfloat mat[16];
+ makeGLMatrix(mat, mViewMatrix);
+ glLoadMatrixf(mat);
+
+ LightList::const_iterator i, iend;
+ iend = lights.end();
+ unsigned short num = 0;
+ for (i = lights.begin(); i != iend && num < limit; ++i, ++num)
+ {
+ setGLLight(num, *i);
+ mLights[num] = *i;
+ }
+ // Disable extra lights
+ for (; num < mCurrentLights; ++num)
+ {
+ setGLLight(num, NULL);
+ mLights[num] = NULL;
+ }
+ mCurrentLights = std::min(limit, static_cast(lights.size()));
+
+ setLights();
+
+ // restore previous
+ glPopMatrix();
+
+ }
+
+ void GLRenderSystem::setGLLight(size_t index, Light* lt)
+ {
+ GLenum gl_index = GL_LIGHT0 + index;
+
+ if (!lt)
+ {
+ // Disable in the scene
+ glDisable(gl_index);
+ }
+ else
+ {
+ switch (lt->getType())
+ {
+ case Light::LT_SPOTLIGHT:
+ glLightf( gl_index, GL_SPOT_CUTOFF, 0.5f * lt->getSpotlightOuterAngle().valueDegrees() );
+ glLightf(gl_index, GL_SPOT_EXPONENT, lt->getSpotlightFalloff());
+ break;
+ default:
+ glLightf( gl_index, GL_SPOT_CUTOFF, 180.0 );
+ break;
+ }
+
+ // Color
+ ColourValue col;
+ col = lt->getDiffuseColour();
+
+
+ GLfloat f4vals[4] = {col.r, col.g, col.b, col.a};
+ glLightfv(gl_index, GL_DIFFUSE, f4vals);
+
+ col = lt->getSpecularColour();
+ f4vals[0] = col.r;
+ f4vals[1] = col.g;
+ f4vals[2] = col.b;
+ f4vals[3] = col.a;
+ glLightfv(gl_index, GL_SPECULAR, f4vals);
+
+
+ // Disable ambient light for movables;
+ f4vals[0] = 0;
+ f4vals[1] = 0;
+ f4vals[2] = 0;
+ f4vals[3] = 1;
+ glLightfv(gl_index, GL_AMBIENT, f4vals);
+
+ setGLLightPositionDirection(lt, gl_index);
+
+
+ // Attenuation
+ glLightf(gl_index, GL_CONSTANT_ATTENUATION, lt->getAttenuationConstant());
+ glLightf(gl_index, GL_LINEAR_ATTENUATION, lt->getAttenuationLinear());
+ glLightf(gl_index, GL_QUADRATIC_ATTENUATION, lt->getAttenuationQuadric());
+ // Enable in the scene
+ glEnable(gl_index);
+
+ }
+
+ }
+
+ void GLRenderSystem::setLights()
+ {
+ for (size_t i = 0; i < MAX_LIGHTS; ++i)
+ {
+ if (mLights[i] != NULL)
+ {
+ Light* lt = mLights[i];
+ setGLLightPositionDirection(lt, GL_LIGHT0 + i);
+ }
+ }
+ }
+
+ void GLRenderSystem::setGLLightPositionDirection(Light* lt, GLenum lightindex)
+ {
+ // Set position / direction
+ Vector4 vec;
+ // Use general 4D vector which is the same as GL's approach
+ vec = lt->getAs4DVector(true);
+
+#if OGRE_DOUBLE_PRECISION
+ // Must convert to float*
+ float tmp[4] = {vec.x, vec.y, vec.z, vec.w};
+ glLightfv(lightindex, GL_POSITION, tmp);
+#else
+ glLightfv(lightindex, GL_POSITION, vec.ptr());
+#endif
+ // Set spotlight direction
+ if (lt->getType() == Light::LT_SPOTLIGHT)
+ {
+ vec = lt->getDerivedDirection();
+ vec.w = 0.0;
+#if OGRE_DOUBLE_PRECISION
+ // Must convert to float*
+ float tmp2[4] = {vec.x, vec.y, vec.z, vec.w};
+ glLightfv(lightindex, GL_SPOT_DIRECTION, tmp2);
+#else
+ glLightfv(lightindex, GL_SPOT_DIRECTION, vec.ptr());
+#endif
+ }
+ }
+-}
+
+glSetTextureAddressingMode texTarget (UVWAddressingMode u v w) = do
+ let target = getGLTextureTarget texTarget
+ GL.textureWrapMode target GL.S $= getTextureAddressingMode u
+ GL.textureWrapMode target GL.T $= getTextureAddressingMode v
+ GL.textureWrapMode target GL.R $= getTextureAddressingMode w
+
+glSetTextureBorderColour texTarget (r,g,b,a) = do
+ let target = getGLTextureTarget texTarget
+ f = realToFrac
+ GL.textureBorderColor target $= GL.Color4 (f r) (f g) (f b) (f a)
+
+glSetTextureUnitFiltering texTarget minFilter magFilter mipFilter = do
+ let target = getGLTextureTarget texTarget
+ mag = case magFilter of
+ { FO_ANISOTROPIC -> GL.Linear'
+ ; FO_LINEAR -> GL.Linear'
+ ; FO_POINT -> GL.Nearest
+ ; FO_NONE -> GL.Nearest
+ }
+ min = case minFilter of
+ { FO_ANISOTROPIC -> GL.Linear'
+ ; FO_LINEAR -> GL.Linear'
+ ; FO_POINT -> GL.Nearest
+ ; FO_NONE -> GL.Nearest
+ }
+ mip = case mipFilter of
+ { FO_ANISOTROPIC -> Just GL.Linear'
+ ; FO_LINEAR -> Just GL.Linear'
+ ; FO_POINT -> Just GL.Nearest
+ ; FO_NONE -> Nothing
+ }
+ GL.textureFilter target $= ((min,mip),mag)
+
+glSetTextureLayerAnisotropy texTarget maxAnisotropy = do
+ let target = getGLTextureTarget texTarget
+ maxSupportedAnisotropy <- GL.get GL.maxTextureMaxAnisotropy
+ GL.textureMaxAnisotropy target $= (min (realToFrac maxAnisotropy) (realToFrac maxSupportedAnisotropy))
+
+glSetTextureMipmapBias bias = do
+ GL.textureUnitLODBias $= realToFrac bias
+
+{-
+ = LayerBlendModeEx
+ { lbBlendType :: LayerBlendType -- ^ The type of blending (colour or alpha)
+ , lbOperation :: LayerBlendOperationEx -- ^ The operation to be applied
+ , lbSource1 :: LayerBlendSource -- ^ The first source of colour/alpha
+ , lbSource2 :: LayerBlendSource -- ^ The second source of colour/alpha
+ , lbColourArg1 :: ColourValue -- ^ Manual colour value for manual source1
+ , lbColourArg2 :: ColourValue -- ^ Manual colour value for manual source2
+ , lbAlphaArg1 :: FloatType -- ^ Manual alpha value for manual source1
+ , lbAlphaArg2 :: FloatType -- ^ Manual alpha value for manual source2
+ , lbFactor :: FloatType -- ^ Manual blending factor
+ }
+
+doc: http://www.informit.com/articles/article.aspx?p=770639&seqNum=6
+FIXME: Test this code
+-}
+glSetTextureBlendMode rsc colorbm alphabm = do
+ let caps = rscCapabilities rsc
+ hasDot3 = Set.member RSC_DOT3 caps
+ csrc1op = getLayerBlendSource $ lbSource1 colorbm
+ csrc2op = getLayerBlendSource $ lbSource2 colorbm
+ ccmd = getTextureCombineFunction hasDot3 $ lbOperation colorbm
+ asrc1op = getLayerBlendSource $ lbSource1 alphabm
+ asrc2op = getLayerBlendSource $ lbSource2 alphabm
+ acmd = getTextureCombineFunction hasDot3 $ lbOperation alphabm
+ f = realToFrac
+
+ GL.textureFunction $= GL.Combine
+ GL.combineRGB $= ccmd
+ GL.argRGB GL.Arg0 $= GL.Arg GL.SrcColor csrc1op
+ GL.argRGB GL.Arg1 $= GL.Arg GL.SrcColor csrc2op
+ GL.argRGB GL.Arg2 $= GL.Arg GL.SrcColor GL.Constant
+ GL.combineAlpha $= acmd
+ GL.argAlpha GL.Arg0 $= GL.Arg GL.SrcAlpha asrc1op
+ GL.argAlpha GL.Arg1 $= GL.Arg GL.SrcAlpha asrc2op
+ GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.Constant
+
+ let argf bm cv1 cv2 = do
+ case lbOperation bm of
+ { LBX_BLEND_DIFFUSE_COLOUR -> do
+ GL.argRGB GL.Arg2 $= GL.Arg GL.SrcColor GL.PrimaryColor
+ GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.PrimaryColor
+ ; LBX_BLEND_DIFFUSE_ALPHA -> do
+ GL.argRGB GL.Arg2 $= GL.Arg GL.SrcAlpha GL.PrimaryColor
+ GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.PrimaryColor
+ ; LBX_BLEND_TEXTURE_ALPHA -> do
+ GL.argRGB GL.Arg2 $= GL.Arg GL.SrcAlpha GL.CurrentUnit
+ GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.CurrentUnit
+ ; LBX_BLEND_CURRENT_ALPHA -> do
+ GL.argRGB GL.Arg2 $= GL.Arg GL.SrcAlpha GL.Previous
+ GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.Previous
+ ; LBX_BLEND_MANUAL -> do
+ GL.constantColor $= GL.Color4 0 0 0 (f $ lbFactor bm)
+ ; _ -> return ()
+ }
+
+ when (LBS_MANUAL == lbSource1 bm) $
+ GL.constantColor $= cv1
+
+ when (LBS_MANUAL == lbSource2 bm) $
+ GL.constantColor $= cv2
+
+ (cr1,cg1,cb1,ca1) = lbColourArg1 colorbm
+ (cr2,cg2,cb2,ca2) = lbColourArg2 colorbm
+ cf r g b a = GL.Color4 (f r) (f g) (f b) (f a)
+ aa1 = lbAlphaArg1 alphabm
+ aa2 = lbAlphaArg2 alphabm
+ argf colorbm (cf cr1 cg1 cb1 ca1) (cf cr2 cg2 cb2 ca2)
+ argf alphabm (cf cr1 cg1 cb1 aa1) (cf cr2 cg2 cb2 aa2)
+
+ case lbOperation colorbm of
+ { LBX_MODULATE_X2 -> GL.rgbScale $= 2
+ ; LBX_MODULATE_X4 -> GL.rgbScale $= 4
+ ; _ -> GL.rgbScale $= 1
+ }
+
+ case lbOperation alphabm of
+ { LBX_MODULATE_X2 -> GL.alphaScale $= 2
+ ; LBX_MODULATE_X4 -> GL.alphaScale $= 4
+ ; _ -> GL.alphaScale $= 1
+ }
+
+glSetCullingMode mode = case mode of
+ { CULL_NONE -> GL.cullFace $= Nothing
+ ; CULL_CLOCKWISE -> GL.cullFace $= (Just GL.Back)
+ ; CULL_ANTICLOCKWISE -> GL.cullFace $= (Just GL.Front)
+ }
+
+glSetColourBufferWriteEnabled r g b a = do
+ let f x = case x of
+ { True -> GL.Enabled
+ ; False -> GL.Disabled
+ }
+ GL.colorMask $= GL.Color4 (f r) (f g) (f b) (f a)
+
+glBindLinkedGpuProgram lp = do
+ GL.currentProgram $= Just (gllgpProgramObject lp)
+ --TEMP CODE
+ let p = gllgpProgramObject lp
+ loc_tex0 <- GL.get (GL.uniformLocation p "tex0")
+ loc_tex1 <- GL.get (GL.uniformLocation p "tex1")
+ (GL.uniform loc_tex0) GL.$=! (GL.Index1 (0::GL.GLint))
+ (GL.uniform loc_tex1) GL.$=! (GL.Index1 (1::GL.GLint))
+
+glUnBindLinkedGpuProgram = do
+ GL.currentProgram $= Nothing
+
+{-
+ void GLRenderSystem::unbindGpuProgram(GpuProgramType gptype)
+ {
+
+ if (gptype == GPT_VERTEX_PROGRAM && mCurrentVertexProgram)
+ {
+ mActiveVertexGpuProgramParameters.setNull();
+ mCurrentVertexProgram->unbindProgram();
+ mCurrentVertexProgram = 0;
+ }
+ else if (gptype == GPT_GEOMETRY_PROGRAM && mCurrentGeometryProgram)
+ {
+ mActiveGeometryGpuProgramParameters.setNull();
+ mCurrentGeometryProgram->unbindProgram();
+ mCurrentGeometryProgram = 0;
+ }
+ else if (gptype == GPT_FRAGMENT_PROGRAM && mCurrentFragmentProgram)
+ {
+ mActiveFragmentGpuProgramParameters.setNull();
+ mCurrentFragmentProgram->unbindProgram();
+ mCurrentFragmentProgram = 0;
+ }
+ RenderSystem::unbindGpuProgram(gptype);
+
+ }
+
+ void RenderSystem::unbindGpuProgram(GpuProgramType gptype)
+ {
+ switch(gptype)
+ {
+ case GPT_VERTEX_PROGRAM:
+ // mark clip planes dirty if changed (programmable can change space)
+ if (mVertexProgramBound && !mClipPlanes.empty())
+ mClipPlanesDirty = true;
+ mVertexProgramBound = false;
+ break;
+ case GPT_GEOMETRY_PROGRAM:
+ mGeometryProgramBound = false;
+ break;
+ case GPT_FRAGMENT_PROGRAM:
+ mFragmentProgramBound = false;
+ break;
+ }
+ }
+-}
+
+--glSetTextureMatrix :: Matrix4 -> IO ()
+glSetTextureMatrix xform = do
+ mat <- toGLMatrix xform
+ GL.matrix (Just GL.Texture) $= mat
+
+{-
+ void GLRenderSystem::_setTextureMatrix(size_t stage, const Matrix4& xform)
+ {
+ if (stage >= mFixedFunctionTextureUnits)
+ {
+ // Can't do this
+ return;
+ }
+
+ GLfloat mat[16];
+ makeGLMatrix(mat, xform);
+
+ if (!activateGLTextureUnit(stage))
+ return;
+ glMatrixMode(GL_TEXTURE);
+
+ // Load this matrix in
+ glLoadMatrixf(mat);
+
+ if (mUseAutoTextureMatrix)
+ {
+ // Concat auto matrix
+ glMultMatrixf(mAutoTextureMatrix);
+ }
+
+ glMatrixMode(GL_MODELVIEW);
+ activateGLTextureUnit(0);
+ }
+-}
+
+-- glSetTextureCoordCalculation :: TexCoordCalcMethod -> IO ()
+glSetTextureCoordCalculation m = case m of
+ { TEXCALC_NONE -> do
+ GL.textureGenMode GL.S $= Nothing
+ GL.textureGenMode GL.T $= Nothing
+ GL.textureGenMode GL.R $= Nothing
+ GL.textureGenMode GL.Q $= Nothing
+
+ ; TEXCALC_ENVIRONMENT_MAP -> do
+ GL.textureGenMode GL.S $= Just GL.SphereMap
+ GL.textureGenMode GL.T $= Just GL.SphereMap
+ GL.textureGenMode GL.R $= Nothing
+ GL.textureGenMode GL.Q $= Nothing
+ -- TODO
+ {-
+ // Need to use a texture matrix to flip the spheremap
+ mUseAutoTextureMatrix = true;
+ memset(mAutoTextureMatrix, 0, sizeof(GLfloat)*16);
+ mAutoTextureMatrix[0] = mAutoTextureMatrix[10] = mAutoTextureMatrix[15] = 1.0f;
+ mAutoTextureMatrix[5] = -1.0f;
+ -}
+
+ ; TEXCALC_ENVIRONMENT_MAP_PLANAR -> do
+ GL.textureGenMode GL.S $= Just GL.SphereMap
+ GL.textureGenMode GL.T $= Just GL.SphereMap
+ GL.textureGenMode GL.R $= Nothing
+ GL.textureGenMode GL.Q $= Nothing
+
+ ; TEXCALC_ENVIRONMENT_MAP_REFLECTION -> do
+ GL.textureGenMode GL.S $= Just GL.ReflectionMap
+ GL.textureGenMode GL.T $= Just GL.ReflectionMap
+ GL.textureGenMode GL.R $= Just GL.ReflectionMap
+ GL.textureGenMode GL.Q $= Nothing
+ {-
+ // We need an extra texture matrix here
+ // This sets the texture matrix to be the inverse of the view matrix
+ mUseAutoTextureMatrix = true;
+ makeGLMatrix( M, mViewMatrix);
+
+ // Transpose 3x3 in order to invert matrix (rotation)
+ // Note that we need to invert the Z _before_ the rotation
+ // No idea why we have to invert the Z at all, but reflection is wrong without it
+ mAutoTextureMatrix[0] = M[0]; mAutoTextureMatrix[1] = M[4]; mAutoTextureMatrix[2] = -M[8];
+ mAutoTextureMatrix[4] = M[1]; mAutoTextureMatrix[5] = M[5]; mAutoTextureMatrix[6] = -M[9];
+ mAutoTextureMatrix[8] = M[2]; mAutoTextureMatrix[9] = M[6]; mAutoTextureMatrix[10] = -M[10];
+ mAutoTextureMatrix[3] = mAutoTextureMatrix[7] = mAutoTextureMatrix[11] = 0.0f;
+ mAutoTextureMatrix[12] = mAutoTextureMatrix[13] = mAutoTextureMatrix[14] = 0.0f;
+ mAutoTextureMatrix[15] = 1.0f;
+ -}
+
+ ; TEXCALC_ENVIRONMENT_MAP_NORMAL -> do
+ GL.textureGenMode GL.S $= Just GL.NormalMap
+ GL.textureGenMode GL.T $= Just GL.NormalMap
+ GL.textureGenMode GL.R $= Just GL.NormalMap
+ GL.textureGenMode GL.Q $= Nothing
+
+ ; TEXCALC_PROJECTIVE_TEXTURE -> do
+ GL.textureGenMode GL.S $= Just (GL.EyeLinear $ GL.Plane 1 0 0 0)
+ GL.textureGenMode GL.T $= Just (GL.EyeLinear $ GL.Plane 0 1 0 0)
+ GL.textureGenMode GL.R $= Just (GL.EyeLinear $ GL.Plane 0 0 1 0)
+ GL.textureGenMode GL.Q $= Just (GL.EyeLinear $ GL.Plane 0 0 0 1)
+ {-
+ mUseAutoTextureMatrix = true;
+
+ // Set scale and translation matrix for projective textures
+ projectionBias = Matrix4::CLIPSPACE2DTOIMAGESPACE;
+
+ projectionBias = projectionBias * frustum->getProjectionMatrix();
+ if(mTexProjRelative)
+ {
+ Matrix4 viewMatrix;
+ frustum->calcViewMatrixRelative(mTexProjRelativeOrigin, viewMatrix);
+ projectionBias = projectionBias * viewMatrix;
+ }
+ else
+ {
+ projectionBias = projectionBias * frustum->getViewMatrix();
+ }
+ projectionBias = projectionBias * mWorldMatrix;
+
+ makeGLMatrix(mAutoTextureMatrix, projectionBias);
+ -}
+ }
+
+{-
+ void GLRenderSystem::_setTextureCoordCalculation(size_t stage, TexCoordCalcMethod m,
+ const Frustum* frustum)
+ {
+ if (stage >= mFixedFunctionTextureUnits)
+ {
+ // Can't do this
+ return;
+ }
+
+
+ GLfloat M[16];
+ Matrix4 projectionBias;
+
+ // Default to no extra auto texture matrix
+ mUseAutoTextureMatrix = false;
+
+ GLfloat eyePlaneS[] = {1.0, 0.0, 0.0, 0.0};
+ GLfloat eyePlaneT[] = {0.0, 1.0, 0.0, 0.0};
+ GLfloat eyePlaneR[] = {0.0, 0.0, 1.0, 0.0};
+ GLfloat eyePlaneQ[] = {0.0, 0.0, 0.0, 1.0};
+
+ if (!activateGLTextureUnit(stage))
+ return;
+
+ switch( m )
+ {
+ case TEXCALC_NONE:
+ glDisable( GL_TEXTURE_GEN_S );
+ glDisable( GL_TEXTURE_GEN_T );
+ glDisable( GL_TEXTURE_GEN_R );
+ glDisable( GL_TEXTURE_GEN_Q );
+ break;
+
+ case TEXCALC_ENVIRONMENT_MAP:
+ glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP );
+ glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP );
+
+ glEnable( GL_TEXTURE_GEN_S );
+ glEnable( GL_TEXTURE_GEN_T );
+ glDisable( GL_TEXTURE_GEN_R );
+ glDisable( GL_TEXTURE_GEN_Q );
+
+ // Need to use a texture matrix to flip the spheremap
+ mUseAutoTextureMatrix = true;
+ memset(mAutoTextureMatrix, 0, sizeof(GLfloat)*16);
+ mAutoTextureMatrix[0] = mAutoTextureMatrix[10] = mAutoTextureMatrix[15] = 1.0f;
+ mAutoTextureMatrix[5] = -1.0f;
+
+ break;
+
+ case TEXCALC_ENVIRONMENT_MAP_PLANAR:
+ // XXX This doesn't seem right?!
+#ifdef GL_VERSION_1_3
+ glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
+ glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
+ glTexGeni( GL_R, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
+
+ glEnable( GL_TEXTURE_GEN_S );
+ glEnable( GL_TEXTURE_GEN_T );
+ glEnable( GL_TEXTURE_GEN_R );
+ glDisable( GL_TEXTURE_GEN_Q );
+#else
+ glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP );
+ glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP );
+
+ glEnable( GL_TEXTURE_GEN_S );
+ glEnable( GL_TEXTURE_GEN_T );
+ glDisable( GL_TEXTURE_GEN_R );
+ glDisable( GL_TEXTURE_GEN_Q );
+#endif
+ break;
+ case TEXCALC_ENVIRONMENT_MAP_REFLECTION:
+
+ glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
+ glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
+ glTexGeni( GL_R, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
+
+ glEnable( GL_TEXTURE_GEN_S );
+ glEnable( GL_TEXTURE_GEN_T );
+ glEnable( GL_TEXTURE_GEN_R );
+ glDisable( GL_TEXTURE_GEN_Q );
+
+ // We need an extra texture matrix here
+ // This sets the texture matrix to be the inverse of the view matrix
+ mUseAutoTextureMatrix = true;
+ makeGLMatrix( M, mViewMatrix);
+
+ // Transpose 3x3 in order to invert matrix (rotation)
+ // Note that we need to invert the Z _before_ the rotation
+ // No idea why we have to invert the Z at all, but reflection is wrong without it
+ mAutoTextureMatrix[0] = M[0]; mAutoTextureMatrix[1] = M[4]; mAutoTextureMatrix[2] = -M[8];
+ mAutoTextureMatrix[4] = M[1]; mAutoTextureMatrix[5] = M[5]; mAutoTextureMatrix[6] = -M[9];
+ mAutoTextureMatrix[8] = M[2]; mAutoTextureMatrix[9] = M[6]; mAutoTextureMatrix[10] = -M[10];
+ mAutoTextureMatrix[3] = mAutoTextureMatrix[7] = mAutoTextureMatrix[11] = 0.0f;
+ mAutoTextureMatrix[12] = mAutoTextureMatrix[13] = mAutoTextureMatrix[14] = 0.0f;
+ mAutoTextureMatrix[15] = 1.0f;
+
+ break;
+ case TEXCALC_ENVIRONMENT_MAP_NORMAL:
+ glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP );
+ glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP );
+ glTexGeni( GL_R, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP );
+
+ glEnable( GL_TEXTURE_GEN_S );
+ glEnable( GL_TEXTURE_GEN_T );
+ glEnable( GL_TEXTURE_GEN_R );
+ glDisable( GL_TEXTURE_GEN_Q );
+ break;
+ case TEXCALC_PROJECTIVE_TEXTURE:
+ glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
+ glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
+ glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
+ glTexGeni(GL_Q, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
+ glTexGenfv(GL_S, GL_EYE_PLANE, eyePlaneS);
+ glTexGenfv(GL_T, GL_EYE_PLANE, eyePlaneT);
+ glTexGenfv(GL_R, GL_EYE_PLANE, eyePlaneR);
+ glTexGenfv(GL_Q, GL_EYE_PLANE, eyePlaneQ);
+ glEnable(GL_TEXTURE_GEN_S);
+ glEnable(GL_TEXTURE_GEN_T);
+ glEnable(GL_TEXTURE_GEN_R);
+ glEnable(GL_TEXTURE_GEN_Q);
+
+ mUseAutoTextureMatrix = true;
+
+ // Set scale and translation matrix for projective textures
+ projectionBias = Matrix4::CLIPSPACE2DTOIMAGESPACE;
+
+ projectionBias = projectionBias * frustum->getProjectionMatrix();
+ if(mTexProjRelative)
+ {
+ Matrix4 viewMatrix;
+ frustum->calcViewMatrixRelative(mTexProjRelativeOrigin, viewMatrix);
+ projectionBias = projectionBias * viewMatrix;
+ }
+ else
+ {
+ projectionBias = projectionBias * frustum->getViewMatrix();
+ }
+ projectionBias = projectionBias * mWorldMatrix;
+
+ makeGLMatrix(mAutoTextureMatrix, projectionBias);
+ break;
+ default:
+ break;
+ }
+ activateGLTextureUnit(0);
+ }
+-}
diff --git a/Graphics/LambdaCube/RenderSystem/GL/GLTexture.hs b/Graphics/LambdaCube/RenderSystem/GL/GLTexture.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL/GLTexture.hs
@@ -0,0 +1,361 @@
+module Graphics.LambdaCube.RenderSystem.GL.GLTexture where
+
+import qualified Data.Set as Set
+import Data.Maybe
+import Control.Monad
+import Foreign.Ptr
+
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
+import System.Log.Logger
+
+import Graphics.LambdaCube.Types
+import Graphics.LambdaCube.PixelFormat
+import Graphics.LambdaCube.Texture
+import Graphics.LambdaCube.Image
+import Graphics.LambdaCube.HardwareBuffer
+import Graphics.LambdaCube.RenderSystemCapabilities
+import Graphics.LambdaCube.RenderSystem.GL.GLUtils
+
+data GLTexture
+ = GLTexture
+ { gltxName :: String
+ , gltxWidth :: Int
+ , gltxHeight :: Int
+ , gltxDepth :: Int
+ , gltxNumRequestedMipmaps :: TextureMipmap
+ , gltxNumMipmaps :: Int
+ , gltxMipmapsHardwareGenerated :: Bool
+ , gltxGamma :: FloatType
+ , gltxHwGamma :: Bool
+ , gltxFSAA :: Int
+ , gltxFSAAHint :: String
+ , gltxTextureType :: TextureType
+ , gltxFormat :: PixelFormat
+ , gltxUsage :: TextureUsage
+ , gltxSrcFormat :: PixelFormat
+ , gltxSrcWidth :: Int
+ , gltxSrcHeight :: Int
+ , gltxSrcDepth :: Int
+
+ , gltxDesiredFormat :: PixelFormat
+ , gltxDesiredIntegerBitDepth :: Int
+ , gltxDesiredFloatBitDepth :: Int
+ , gltxTreatLuminanceAsAlpha :: Bool
+
+ , gltxTextureObject :: GL.TextureObject
+ }
+
+instance Eq GLTexture where
+ (==) a b = gltxTextureObject a == gltxTextureObject b
+
+instance HardwareBuffer GLTexture
+
+instance Texture GLTexture where
+ txName = gltxName
+ txWidth = gltxWidth
+ txHeight = gltxHeight
+ txDepth = gltxDepth
+ txNumRequestedMipmaps = gltxNumRequestedMipmaps
+ txNumMipmaps = gltxNumMipmaps
+ txMipmapsHardwareGenerated = gltxMipmapsHardwareGenerated
+ txGamma = gltxGamma
+ txHwGamma = gltxHwGamma
+ txFSAA = gltxFSAA
+ txFSAAHint = gltxFSAAHint
+ txTextureType = gltxTextureType
+ txFormat = gltxFormat
+-- txUsage = gltxUsage
+ txSrcFormat = gltxSrcFormat
+ txSrcWidth = gltxSrcWidth
+ txSrcHeight = gltxSrcHeight
+ txSrcDepth = gltxSrcDepth
+
+ txDesiredFormat = gltxDesiredFormat
+ txDesiredIntegerBitDepth = gltxDesiredIntegerBitDepth
+ txDesiredFloatBitDepth = gltxDesiredFloatBitDepth
+ txTreatLuminanceAsAlpha = gltxTreatLuminanceAsAlpha
+
+{-
+ virtual TexturePtr createManual(const String & name, const String& group,
+ TextureType texType, uint width, uint height, uint depth,
+ int num_mips, PixelFormat format, int usage = TU_DEFAULT, ManualResourceLoader* loader = 0,
+ bool hwGammaCorrection = false, uint fsaa = 0, const String& fsaaHint = StringUtil::BLANK);
+-}
+--createTexture :: a -> String -> TextureType -> Int -> Int -> Int -> Int -> PixelFormat -> TextueUsage -> Bool -> Int -> String -> IO t
+{-
+ virtual TexturePtr createManual(const String & name, const String& group,
+ TextureType texType, uint width, uint height, uint depth,
+ int num_mips, PixelFormat format, int usage = TU_DEFAULT, ManualResourceLoader* loader = 0,
+ bool hwGammaCorrection = false, uint fsaa = 0, const String& fsaaHint = StringUtil::BLANK);
+ TextureUsage = bufferUsage::Usage, autoMipmap::Bool, isTarget::Bool
+ createTexture :: a -> String -> TextureType -> Int -> Int -> Int -> Int -> PixelFormat -> Usage -> Bool -> Bool -> Bool -> Int -> String -> IO t
+-}
+mkGLTexture :: RenderSystemCapabilities -> String -> TextureType -> Int -> Int -> Int -> TextureMipmap -> PixelFormat -> TextureUsage -> Bool -> Int -> String -> Maybe [Image] -> IO GLTexture
+--FIXME: image parameter is temporary!!!!
+mkGLTexture rcaps name texType width height depth numMips format usage hwGammaCorrection fsaa fsaaHint mimage = do
+ let caps = rscCapabilities rcaps
+ debugM "createTexture" $ "create " ++ show texType ++ " texture: " ++ name
+
+ when (texType == TEX_TYPE_3D && Set.notMember RSC_TEXTURE_3D caps) $ error "3D Textures not supported before OpenGL 1.2"
+
+ (major,minor) <- GL.get $ GL.majorMinor GL.glVersion
+
+ let glVer a b = major > a || (major >= a && minor >= b)
+ texTarget = (getGLTextureTarget texType)
+ -- Convert to nearest power-of-two size if required
+ mWidth = optionalPO2 rcaps width
+ mHeight = optionalPO2 rcaps height
+ mDepth = optionalPO2 rcaps depth
+
+ -- Adjust format if required
+ mFormat = getNativeFormat texType format False -- TODO
+
+ -- Check requested number of mipmaps
+ maxMips = getMaxMipmaps mWidth mHeight mDepth mFormat
+ mNumMipmaps = maxMips -- TODO min maxMips numMips
+
+ -- Generate texture name
+ [mTextureID] <- GL.genObjectNames 1
+
+ -- Set texture type
+ GL.textureBinding texTarget $= Just mTextureID
+
+ -- This needs to be set otherwise the texture doesn't get rendered
+ when (glVer 1 2) $ GL.textureLevelRange texTarget $= (0,fromIntegral mNumMipmaps)
+
+ -- Set some misc default parameters so NVidia won't complain, these can of course be changed later
+ GL.textureFilter texTarget $= ((GL.Nearest,Nothing),GL.Nearest)
+
+ when (glVer 1 2) $ do
+ GL.textureWrapMode texTarget GL.S $= (GL.Repeated, GL.ClampToEdge)
+ GL.textureWrapMode texTarget GL.T $= (GL.Repeated, GL.ClampToEdge)
+
+ -- If we can do automip generation and the user desires this, do so
+ let mMipmapsHardwareGenerated = Set.member RSC_AUTOMIPMAP caps
+ -- FIXME
+ {-
+ // NVIDIA 175.16 drivers break hardware mip generation for non-compressed
+ // textures - disable until fixed
+ // Leave hardware gen on compressed textures since that's the only way we
+ // can realistically do it since GLU doesn't support DXT
+ // However DON'T do this on Apple, their drivers aren't subject to this
+ // problem yet and in fact software generation appears to cause a crash
+ // in some cases which I've yet to track down
+if OGRE_PLATFORM != OGRE_PLATFORM_APPLE
+ if (Root::getSingleton().getRenderSystem()->getCapabilities()->getVendor() == GPU_NVIDIA
+ && !PixelUtil::isCompressed(mFormat))
+ {
+ mMipmapsHardwareGenerated = false;
+ }
+endif
+ -}
+--TODO
+ let moreMips = case numMips of
+ { MIP_UNLIMITED -> True
+ ; MIP_DEFAULT -> True -- TODO
+ ; MIP_NUMBER n -> n > 0
+ }
+
+ when (tuAutoMipmap usage && moreMips && mMipmapsHardwareGenerated) $ GL.generateMipmap texTarget $= GL.Enabled
+
+ -- Allocate internal buffer so that glTexSubImageXD can be used
+ -- Internal format
+ let format' = getClosestGLInternalFormat mFormat hwGammaCorrection
+ isCompressed _ = False -- TODO
+ case isCompressed mFormat of
+ { True -> do
+ {-
+ // Compressed formats
+ size_t size = PixelUtil::getMemorySize(mWidth, mHeight, mDepth, mFormat);
+ // Provide temporary buffer filled with zeroes as glCompressedTexImageXD does not
+ // accept a 0 pointer like normal glTexImageXD
+ // Run through this process for every mipmap to pregenerate mipmap piramid
+ uint8 *tmpdata = new uint8[size];
+ memset(tmpdata, 0, size);
+
+ for(size_t mip=0; mip<=mNumMipmaps; mip++)
+ {
+ size = PixelUtil::getMemorySize(width, height, depth, mFormat);
+ switch(mTextureType)
+ {
+ case TEX_TYPE_1D:
+ glCompressedTexImage1DARB(GL_TEXTURE_1D, mip, format',
+ width, 0,
+ size, tmpdata);
+ break;
+ case TEX_TYPE_2D:
+ glCompressedTexImage2DARB(GL_TEXTURE_2D, mip, format',
+ width, height, 0,
+ size, tmpdata);
+ break;
+ case TEX_TYPE_3D:
+ glCompressedTexImage3DARB(GL_TEXTURE_3D, mip, format',
+ width, height, depth, 0,
+ size, tmpdata);
+ break;
+ case TEX_TYPE_CUBE_MAP:
+ for(int face=0; face<6; face++) {
+ glCompressedTexImage2DARB(GL_TEXTURE_CUBE_MAP_POSITIVE_X + face, mip, format',
+ width, height, 0,
+ size, tmpdata);
+ }
+ break;
+ };
+ if(width>1) width = width/2;
+ if(height>1) height = height/2;
+ if(depth>1) depth = depth/2;
+ }
+ delete [] tmpdata;
+ -}
+
+ -- Compressed formats
+ -- Provide temporary buffer filled with zeroes as glCompressedTexImageXD does not
+ -- accept a 0 pointer like normal glTexImageXD
+ -- TODO: support compressed textures
+ {-
+ let setMip tmpdata (w,h,d) mip = do
+ -- compressedTexImage1D :: Proxy -> Level -> TextureSize1D -> Border -> CompressedPixelData a -> IO ()
+ -- CompressedPixelData !CompressedTextureFormat GLsizei (Ptr a)
+ let size = getMemorySize w h d mFormat
+ case texType of
+ { TEX_TYPE_1D -> GL.compressedTexImage1D GL.NoProxy mip (GL.TextureSize1D w) 0 (GL.CompressedPixelData (CompressedTextureFormat ) size tmpdata)
+ ; TEX_TYPE_2D ->
+ ; TEX_TYPE_3D ->
+ ; TEX_TYPE_CUBE_MAP -> do
+ }
+ return (max 1 (w `div` 2), max 1 (h `div` 2), max 1 (d `div` 2))
+ setMips :: Ptr Word8 -> IO ()
+ setMips tmpdata = do
+ pokeArray tmpdata $ replicate size 0
+ -- Run through this process for every mipmap to pregenerate mipmap piramid
+ foldM_ (setMip tmpdata) (mWidth,mHeight,mDepth) [0..mNumMipmaps]
+ allocaArray (getMemorySize mWidth mHeight mDepth mFormat) setMips
+ -}
+ return ()
+ ; False -> do
+ let setMip (w,h,d) mip = do
+ -- Normal formats
+ case texType of
+ { TEX_TYPE_1D -> GL.texImage1D GL.NoProxy mip format' (GL.TextureSize1D w) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ ; TEX_TYPE_2D -> GL.texImage2D Nothing GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ ; TEX_TYPE_3D -> GL.texImage3D GL.NoProxy mip format' (GL.TextureSize3D w h d) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ ; TEX_TYPE_CUBE_MAP -> do
+ GL.texImage2D (Just GL.TextureCubeMapPositiveX) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ GL.texImage2D (Just GL.TextureCubeMapNegativeX) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ GL.texImage2D (Just GL.TextureCubeMapPositiveY) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ GL.texImage2D (Just GL.TextureCubeMapNegativeY) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ GL.texImage2D (Just GL.TextureCubeMapPositiveZ) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ GL.texImage2D (Just GL.TextureCubeMapNegativeZ) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
+ }
+ return (max 1 (w `div` 2), max 1 (h `div` 2), max 1 (d `div` 2))
+ f = fromIntegral
+ -- Run through this process to pregenerate mipmap piramid
+ foldM_ setMip (f mWidth,f mHeight,f mDepth) [0..(fromIntegral mNumMipmaps)]
+ }
+
+ -- TODO
+ -- TEMP CODE
+ when (isJust mimage) $ do
+ let images = fromJust mimage
+ imInfo i = (fmt,f w,f h)
+ where
+ f = fromIntegral
+ fmt = case imFormat i of
+ { PF_L8 -> GL.Luminance
+ ; PF_BYTE_LA -> GL.LuminanceAlpha
+ ; PF_R8G8B8 -> GL.RGB
+ ; PF_R8G8B8A8 -> GL.RGBA
+ }
+ w = imWidth i
+ h = imHeight i
+ upload2D target i = do
+ let (fmt,w,h) = imInfo i
+ debugM "createTexture" $ "upload2d: " ++ imName i
+ GL.texImage2D target GL.NoProxy 0 format' (GL.TextureSize2D w h) 0 (GL.PixelData fmt GL.UnsignedByte $ imData i)
+
+ errl <- GL.get GL.errors
+ unless (null errl) $ debugM "createTexture" $ "glerrors: \"" ++ concat [show c ++ " - " ++ m ++ "\n" | GL.Error c m <- errl] ++ "\""
+ case texType of
+ { TEX_TYPE_1D -> do
+ let (fmt,w,h) = imInfo image
+ image = head images
+ GL.texImage1D GL.NoProxy 0 format' (GL.TextureSize1D w) 0 (GL.PixelData fmt GL.UnsignedByte $ imData image)
+ ; TEX_TYPE_2D -> upload2D Nothing $ head images
+ ; TEX_TYPE_CUBE_MAP -> mapM_ (uncurry upload2D) $ zip [ Just GL.TextureCubeMapPositiveZ -- front
+ , Just GL.TextureCubeMapNegativeZ -- back
+ , Just GL.TextureCubeMapPositiveY -- up
+ , Just GL.TextureCubeMapNegativeY -- down
+ , Just GL.TextureCubeMapNegativeX -- left
+ , Just GL.TextureCubeMapPositiveX -- right
+ ] images
+ ; _ -> return ()
+ }
+ --_createSurfaceList();
+
+ -- Get final internal format
+ -- TODO
+ --mFormat = getBuffer(0,0)->getFormat();
+ debugM "createTexture" $ "created texture: " ++ name
+ return GLTexture
+ { gltxName = name
+ , gltxWidth = 0 --TODO
+ , gltxHeight = 0 --TODO
+ , gltxDepth = 0 --TODO
+ , gltxNumRequestedMipmaps = MIP_DEFAULT --TODO
+ , gltxNumMipmaps = 0 --TODO
+ , gltxMipmapsHardwareGenerated = True --TODO
+ , gltxGamma = 0 --TODO
+ , gltxHwGamma = True --TODO
+ , gltxFSAA = 0 --TODO
+ , gltxFSAAHint = "" --TODO
+ , gltxTextureType = texType
+ , gltxFormat = PF_R8G8B8 -- TODO
+ , gltxUsage = TextureUsage HBU_WRITE_ONLY False False-- TODO
+ , gltxSrcFormat = PF_R8G8B8 -- TODO
+ , gltxSrcWidth = 0 --TODO
+ , gltxSrcHeight = 0 --TODO
+ , gltxSrcDepth = 0 --TODO
+
+ , gltxDesiredFormat = PF_R8G8B8 --TODO
+ , gltxDesiredIntegerBitDepth = 0 --TODO
+ , gltxDesiredFloatBitDepth = 0 --TODO
+ , gltxTreatLuminanceAsAlpha = True --TODO
+
+ , gltxTextureObject = mTextureID
+ }
+{-
+ void GLTexture::_createSurfaceList()
+ {
+ mSurfaceList.clear();
+
+ // For all faces and mipmaps, store surfaces as HardwarePixelBufferSharedPtr
+ bool wantGeneratedMips = (mUsage & TU_AUTOMIPMAP)!=0;
+
+ // Do mipmapping in software? (uses GLU) For some cards, this is still needed. Of course,
+ // only when mipmap generation is desired.
+ bool doSoftware = wantGeneratedMips && !mMipmapsHardwareGenerated && getNumMipmaps();
+
+ for(size_t face=0; face(mUsage), doSoftware && mip==0, mHwGamma, mFSAA);
+ mSurfaceList.push_back(HardwarePixelBufferSharedPtr(buf));
+
+ /// Check for error
+ if(buf->getWidth()==0 || buf->getHeight()==0 || buf->getDepth()==0)
+ {
+ OGRE_EXCEPT(
+ Exception::ERR_RENDERINGAPI_ERROR,
+ "Zero sized texture surface on texture "+getName()+
+ " face "+StringConverter::toString(face)+
+ " mipmap "+StringConverter::toString(mip)+
+ ". Probably, the GL driver refused to create the texture.",
+ "GLTexture::_createSurfaceList");
+ }
+ }
+ }
+ }
+-}
diff --git a/Graphics/LambdaCube/RenderSystem/GL/GLUtils.hs b/Graphics/LambdaCube/RenderSystem/GL/GLUtils.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL/GLUtils.hs
@@ -0,0 +1,326 @@
+module Graphics.LambdaCube.RenderSystem.GL.GLUtils where
+
+import qualified Data.Set as Set
+import Data.Bits
+import Unsafe.Coerce
+
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Graphics.LambdaCube.Types
+import Graphics.LambdaCube.Math
+import Graphics.LambdaCube.Common
+import Graphics.LambdaCube.PixelFormat
+import Graphics.LambdaCube.Texture
+import Graphics.LambdaCube.BlendMode
+import Graphics.LambdaCube.HardwareBuffer
+import Graphics.LambdaCube.HardwareVertexBuffer
+import Graphics.LambdaCube.RenderSystemCapabilities
+import Graphics.LambdaCube.TextureUnitState
+
+toGLMatrix :: Matrix4 -> IO (GL.GLmatrix GL.GLfloat)
+toGLMatrix m = GL.newMatrix GL.ColumnMajor $ unsafeCoerce $ toListsMatrix4 m
+
+getGLUsage :: Usage -> GL.BufferUsage
+getGLUsage usage = case usage of
+ { HBU_STATIC -> GL.StaticDraw
+ ; HBU_STATIC_WRITE_ONLY -> GL.StaticDraw
+ ; HBU_DYNAMIC -> GL.DynamicDraw
+ ; HBU_DYNAMIC_WRITE_ONLY -> GL.DynamicDraw
+ ; HBU_DYNAMIC_WRITE_ONLY_DISCARDABLE -> GL.StreamDraw
+ ; _ -> GL.DynamicDraw
+ }
+
+getGLType :: VertexElementType -> GL.DataType
+getGLType t = case t of
+ { VET_FLOAT1 -> GL.Float
+ ; VET_FLOAT2 -> GL.Float
+ ; VET_FLOAT3 -> GL.Float
+ ; VET_FLOAT4 -> GL.Float
+ ; VET_SHORT1 -> GL.Short
+ ; VET_SHORT2 -> GL.Short
+ ; VET_SHORT3 -> GL.Short
+ ; VET_SHORT4 -> GL.Short
+ ; VET_COLOUR_ABGR -> GL.UnsignedByte
+ ; VET_COLOUR_ARGB -> GL.UnsignedByte
+ ; VET_UBYTE4 -> GL.UnsignedByte
+ }
+
+getGLTextureTarget :: TextureType -> GL.TextureTarget
+getGLTextureTarget textureType = case textureType of
+ { TEX_TYPE_1D -> GL.Texture1D
+ ; TEX_TYPE_2D -> GL.Texture2D
+ ; TEX_TYPE_3D -> GL.Texture3D
+ ; TEX_TYPE_CUBE_MAP -> GL.TextureCubeMap
+ }
+
+
+optionalPO2 :: RenderSystemCapabilities -> Int -> Int
+optionalPO2 rcaps value = case Set.member RSC_NON_POWER_OF_2_TEXTURES (rscCapabilities rcaps) of
+ { True -> value
+ ; False -> 2 ^ ( 1 + log2 (value-1) )
+ }
+ where
+ log2 n = case n of
+ 0 -> -1
+ _ -> 1 + log2 (shiftR n 1)
+
+getMaxMipmaps :: Int -> Int -> Int -> PixelFormat -> Int
+getMaxMipmaps width height depth format = maximum [f width, f height, f depth]
+ where
+ f x = floor $ logBase 2 $ fromIntegral x
+{-
+ size_t GLPixelUtil::getMaxMipmaps(size_t width, size_t height, size_t depth, PixelFormat format)
+ {
+ size_t count = 0;
+ do {
+ if(width>1) width = width/2;
+ if(height>1) height = height/2;
+ if(depth>1) depth = depth/2;
+
+ count ++;
+ } while(!(width == 1 && height == 1 && depth == 1));
+
+ return count;
+ }
+-}
+-- TODO
+getNativeFormat :: TextureType -> PixelFormat -> Bool -> PixelFormat
+getNativeFormat ttype format isTarget = PF_R8G8B8
+{-
+ PixelFormat GLTextureManager::getNativeFormat(TextureType ttype, PixelFormat format, int usage)
+ {
+ // Adjust requested parameters to capabilities
+ const RenderSystemCapabilities *caps = Root::getSingleton().getRenderSystem()->getCapabilities();
+
+ // Check compressed texture support
+ // if a compressed format not supported, revert to PF_A8R8G8B8
+ if(PixelUtil::isCompressed(format) &&
+ !caps->hasCapability( RSC_TEXTURE_COMPRESSION_DXT ))
+ {
+ return PF_A8R8G8B8;
+ }
+ // if floating point textures not supported, revert to PF_A8R8G8B8
+ if(PixelUtil::isFloatingPoint(format) &&
+ !caps->hasCapability( RSC_TEXTURE_FLOAT ))
+ {
+ return PF_A8R8G8B8;
+ }
+
+ // Check if this is a valid rendertarget format
+ if( usage & TU_RENDERTARGET )
+ {
+ /// Get closest supported alternative
+ /// If mFormat is supported it's returned
+ return GLRTTManager::getSingleton().getSupportedAlternative(format);
+ }
+
+ // Supported
+ return format;
+ }
+
+ PixelFormat GLRTTManager::getSupportedAlternative(PixelFormat format)
+ {
+ if(checkFormat(format))
+ return format;
+ /// Find first alternative
+ PixelComponentType pct = PixelUtil::getComponentType(format);
+ switch(pct)
+ {
+ case PCT_BYTE: format = PF_A8R8G8B8; break;
+ case PCT_SHORT: format = PF_SHORT_RGBA; break;
+ case PCT_FLOAT16: format = PF_FLOAT16_RGBA; break;
+ case PCT_FLOAT32: format = PF_FLOAT32_RGBA; break;
+ case PCT_COUNT: break;
+ }
+ if(checkFormat(format))
+ return format;
+ /// If none at all, return to default
+ return PF_A8R8G8B8;
+ }
+-}
+getGLInternalFormat :: PixelFormat -> Bool -> GL.PixelInternalFormat
+getGLInternalFormat mFormat hwGamma = case mFormat of
+ { PF_L8 -> GL.Luminance8
+ ; PF_L16 -> GL.Luminance16
+ ; PF_A8 -> GL.Alpha8
+ ; PF_A4L4 -> GL.Luminance4Alpha4
+ ; PF_BYTE_LA -> GL.Luminance8Alpha8
+ ; PF_R3G3B2 -> GL.R3G3B2
+ ; PF_A1R5G5B5 -> GL.RGB5A1
+ ; PF_R5G6B5 -> GL.RGB5
+ ; PF_B5G6R5 -> GL.RGB5
+ ; PF_A4R4G4B4 -> GL.RGBA4
+ ; PF_R8G8B8 -> if hwGamma then GL.SRGB8 else GL.RGB8
+ ; PF_B8G8R8 -> if hwGamma then GL.SRGB8 else GL.RGB8
+ ; PF_X8B8G8R8 -> if hwGamma then GL.SRGB8 else GL.RGB8
+ ; PF_X8R8G8B8 -> if hwGamma then GL.SRGB8 else GL.RGB8
+ ; PF_A8R8G8B8 -> if hwGamma then GL.SRGB8Alpha8 else GL.RGBA8
+ ; PF_B8G8R8A8 -> if hwGamma then GL.SRGB8Alpha8 else GL.RGBA8
+ ; PF_A2R10G10B10 -> GL.RGB10A2
+ ; PF_A2B10G10R10 -> GL.RGB10A2
+--FIXME ; PF_FLOAT16_R -> GL_LUMINANCE16F_ARB
+--FIXME ; PF_FLOAT16_RGB -> GL_RGB16F_ARB
+--FIXME ; PF_FLOAT16_GR -> GL_LUMINANCE_ALPHA16F_ARB
+--FIXME ; PF_FLOAT16_RGBA -> GL_RGBA16F_ARB
+--FIXME ; PF_FLOAT32_R -> GL_LUMINANCE32F_ARB
+--FIXME ; PF_FLOAT32_GR -> GL_LUMINANCE_ALPHA32F_ARB
+--FIXME ; PF_FLOAT32_RGB -> GL_RGB32F_ARB
+--FIXME ; PF_FLOAT32_RGBA -> GL_RGBA32F_ARB
+ ; PF_SHORT_RGBA -> GL.RGBA16
+ ; PF_SHORT_RGB -> GL.RGB16
+ ; PF_SHORT_GR -> GL.Luminance16Alpha16
+-- case PF_DXT1:
+-- if (hwGamma)
+-- return GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT;
+-- else
+-- return GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
+-- case PF_DXT3:
+-- if (hwGamma)
+-- return GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT;
+-- else
+-- return GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
+-- case PF_DXT5:
+-- if (hwGamma)
+-- return GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT;
+-- else
+-- return GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
+ ; _ -> error "Unsupported pixel format"
+ }
+{-
+ GLenum GLPixelUtil::getGLInternalFormat(PixelFormat mFormat, bool hwGamma)
+ {
+ switch(mFormat) {
+ default:
+ return GL_NONE;
+ }
+ }
+ GLenum GLPixelUtil::getClosestGLInternalFormat(PixelFormat mFormat, bool hwGamma)
+ {
+ GLenum format = getGLInternalFormat(mFormat, hwGamma);
+ if(format==GL_NONE)
+ {
+ if (hwGamma)
+ return GL_SRGB8;
+ else
+ return GL_RGBA8;
+ }
+ else
+ return format;
+ }
+-}
+getClosestGLInternalFormat :: PixelFormat -> Bool -> GL.PixelInternalFormat
+getClosestGLInternalFormat mFormat hwGamma = case mFormat of
+ { PF_L8 -> GL.Luminance8
+ ; PF_L16 -> GL.Luminance16
+ ; PF_A8 -> GL.Alpha8
+ ; PF_A4L4 -> GL.Luminance4Alpha4
+ ; PF_BYTE_LA -> GL.Luminance8Alpha8
+ ; PF_R3G3B2 -> GL.R3G3B2
+ ; PF_A1R5G5B5 -> GL.RGB5A1
+ ; PF_R5G6B5 -> GL.RGB5
+ ; PF_B5G6R5 -> GL.RGB5
+ ; PF_A4R4G4B4 -> GL.RGBA4
+ ; PF_R8G8B8 -> if hwGamma then GL.SRGB8 else GL.RGB8
+ ; PF_B8G8R8 -> if hwGamma then GL.SRGB8 else GL.RGB8
+ ; PF_X8B8G8R8 -> if hwGamma then GL.SRGB8 else GL.RGB8
+ ; PF_X8R8G8B8 -> if hwGamma then GL.SRGB8 else GL.RGB8
+ ; PF_A8R8G8B8 -> if hwGamma then GL.SRGB8Alpha8 else GL.RGBA8
+ ; PF_B8G8R8A8 -> if hwGamma then GL.SRGB8Alpha8 else GL.RGBA8
+ ; PF_A2R10G10B10 -> GL.RGB10A2
+ ; PF_A2B10G10R10 -> GL.RGB10A2
+--FIXME ; PF_FLOAT16_R -> GL_LUMINANCE16F_ARB
+--FIXME ; PF_FLOAT16_RGB -> GL_RGB16F_ARB
+--FIXME ; PF_FLOAT16_GR -> GL_LUMINANCE_ALPHA16F_ARB
+--FIXME ; PF_FLOAT16_RGBA -> GL_RGBA16F_ARB
+--FIXME ; PF_FLOAT32_R -> GL_LUMINANCE32F_ARB
+--FIXME ; PF_FLOAT32_GR -> GL_LUMINANCE_ALPHA32F_ARB
+--FIXME ; PF_FLOAT32_RGB -> GL_RGB32F_ARB
+--FIXME ; PF_FLOAT32_RGBA -> GL_RGBA32F_ARB
+ ; PF_SHORT_RGBA -> GL.RGBA16
+ ; PF_SHORT_RGB -> GL.RGB16
+ ; PF_SHORT_GR -> GL.Luminance16Alpha16
+-- FIXME
+-- case PF_DXT1:
+-- if (hwGamma)
+-- return GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT1_EXT;
+-- else
+-- return GL_COMPRESSED_RGBA_S3TC_DXT1_EXT;
+-- case PF_DXT3:
+-- if (hwGamma)
+-- return GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT3_EXT;
+-- else
+-- return GL_COMPRESSED_RGBA_S3TC_DXT3_EXT;
+-- case PF_DXT5:
+-- if (hwGamma)
+-- return GL_COMPRESSED_SRGB_ALPHA_S3TC_DXT5_EXT;
+-- else
+-- return GL_COMPRESSED_RGBA_S3TC_DXT5_EXT;
+ ; _ -> if hwGamma then GL.SRGB8 else GL.RGBA8
+ }
+
+getBlendMode :: SceneBlendFactor -> GL.BlendingFactor
+getBlendMode blend = case blend of
+ { SBF_ONE -> GL.One
+ ; SBF_ZERO -> GL.Zero
+ ; SBF_DEST_COLOUR -> GL.DstColor
+ ; SBF_SOURCE_COLOUR -> GL.SrcColor
+ ; SBF_ONE_MINUS_DEST_COLOUR -> GL.OneMinusDstColor
+ ; SBF_ONE_MINUS_SOURCE_COLOUR -> GL.OneMinusSrcColor
+ ; SBF_DEST_ALPHA -> GL.DstAlpha
+ ; SBF_SOURCE_ALPHA -> GL.SrcAlpha
+ ; SBF_ONE_MINUS_DEST_ALPHA -> GL.OneMinusDstAlpha
+ ; SBF_ONE_MINUS_SOURCE_ALPHA -> GL.OneMinusSrcAlpha
+ }
+
+getBlendEquation op = case op of
+ { SBO_ADD -> GL.FuncAdd
+ ; SBO_SUBTRACT -> GL.FuncSubtract
+ ; SBO_REVERSE_SUBTRACT -> GL.FuncReverseSubtract
+ ; SBO_MIN -> GL.Min
+ ; SBO_MAX -> GL.Max
+ }
+
+getTextureAddressingMode tam = case tam of
+ { TAM_WRAP -> (GL.Repeated, GL.Repeat)
+ ; TAM_MIRROR -> (GL.Mirrored, GL.Repeat)
+ ; TAM_CLAMP -> (GL.Repeated, GL.ClampToEdge)
+ ; TAM_BORDER -> (GL.Repeated, GL.ClampToBorder)
+ }
+
+getLayerBlendSource src = case src of
+ { LBS_CURRENT -> GL.Previous
+ ; LBS_TEXTURE -> GL.CurrentUnit
+ ; LBS_MANUAL -> GL.Constant
+ ; LBS_DIFFUSE -> GL.PrimaryColor
+ ; LBS_SPECULAR -> GL.PrimaryColor
+ }
+
+getTextureCombineFunction hasDot3 op = case op of
+ { LBX_SOURCE1 -> GL.Replace'
+ ; LBX_SOURCE2 -> GL.Replace'
+ ; LBX_MODULATE -> GL.Modulate'
+ ; LBX_MODULATE_X2 -> GL.Modulate'
+ ; LBX_MODULATE_X4 -> GL.Modulate'
+ ; LBX_ADD -> GL.AddUnsigned'
+ ; LBX_ADD_SIGNED -> GL.AddSigned
+ ; LBX_ADD_SMOOTH -> GL.Interpolate
+ ; LBX_SUBTRACT -> GL.Subtract
+ ; LBX_BLEND_DIFFUSE_COLOUR -> GL.Interpolate
+ ; LBX_BLEND_DIFFUSE_ALPHA -> GL.Interpolate
+ ; LBX_BLEND_TEXTURE_ALPHA -> GL.Interpolate
+ ; LBX_BLEND_CURRENT_ALPHA -> GL.Interpolate
+ ; LBX_BLEND_MANUAL -> GL.Interpolate
+ ; LBX_DOTPRODUCT -> if hasDot3 then GL.Dot3RGB else GL.Modulate'
+ }
+
+convertCompareFunction f = case f of
+ { CMPF_ALWAYS_FAIL -> GL.Never
+ ; CMPF_ALWAYS_PASS -> GL.Always
+ ; CMPF_LESS -> GL.Less
+ ; CMPF_LESS_EQUAL -> GL.Lequal
+ ; CMPF_EQUAL -> GL.Equal
+ ; CMPF_NOT_EQUAL -> GL.Notequal
+ ; CMPF_GREATER_EQUAL -> GL.Gequal
+ ; CMPF_GREATER -> GL.Greater
+ }
diff --git a/Graphics/LambdaCube/RenderSystem/GL/GLVertexBuffer.hs b/Graphics/LambdaCube/RenderSystem/GL/GLVertexBuffer.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystem/GL/GLVertexBuffer.hs
@@ -0,0 +1,133 @@
+module Graphics.LambdaCube.RenderSystem.GL.GLVertexBuffer where
+
+import Data.Word
+import Data.Maybe
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Utils
+import Foreign.Storable
+import Foreign.C.Types
+import Foreign.Ptr
+import Data.IORef
+import Control.Monad
+
+import Graphics.Rendering.OpenGL (($=))
+import qualified Graphics.Rendering.OpenGL as GL
+
+import Graphics.LambdaCube.RenderSystem
+import Graphics.LambdaCube.HardwareBuffer
+import Graphics.LambdaCube.HardwareVertexBuffer
+import Graphics.LambdaCube.RenderSystem.GL.GLUtils
+
+-- | Specialisation of HardwareVertexBuffer for GL
+data GLVertexBuffer
+ = GLVertexBuffer
+ { glvbNumVertices :: Int
+ , glvbVertexSize :: Int
+
+ , glvbUsage :: Usage
+ , glvbLockInfo :: IORef (Maybe (Int,Int,Bool)) -- LockStart LockSize RequireUpdate
+
+ , glvbShadowBuffer :: Maybe (Ptr Word8)
+ , glvbBufferObject :: Maybe GL.BufferObject
+ }
+ deriving Eq
+
+instance HardwareVertexBuffer GLVertexBuffer where
+ getVertexSize = glvbVertexSize
+ getNumVertices = glvbNumVertices
+
+instance HardwareBuffer GLVertexBuffer where
+ getSizeInBytes b = glvbVertexSize b * glvbNumVertices b
+ isSystemMemory = isNothing . glvbBufferObject
+ hasShadowBuffer b = (isJust $ glvbShadowBuffer b) && (isJust $ glvbBufferObject b)
+ getUsage = glvbUsage
+ isLocked = glvbIsLocked
+ unlock = glvbUnlock
+ lock = glvbLock
+
+glvbIsLocked b = do
+ i <- readIORef $ glvbLockInfo b
+ return $ isJust i
+
+glvbLock a offs len opts = do
+ lockinfo <- readIORef (glvbLockInfo a)
+ when (isJust lockinfo) $ error "Cannot lock this buffer, it is already locked!"
+ writeIORef (glvbLockInfo a) $ Just (offs,len,opts /= HBL_READ_ONLY)
+ case glvbShadowBuffer a of
+ { Just b -> return $ plusPtr b offs
+ ; Nothing -> do
+ GL.bindBuffer GL.ArrayBuffer $= (glvbBufferObject a)
+ -- Discard if required
+ when (opts == HBL_DISCARD) $ GL.bufferData GL.ArrayBuffer $= (fromIntegral $ getSizeInBytes a, nullPtr, getGLUsage $ getUsage a)
+ let isWriteOnly = case getUsage a of
+ { HBU_WRITE_ONLY -> True
+ ; HBU_STATIC_WRITE_ONLY -> True
+ ; HBU_DYNAMIC_WRITE_ONLY -> True
+ ; HBU_DYNAMIC_WRITE_ONLY_DISCARDABLE -> True
+ ; _ -> False
+ }
+ access = case (isWriteOnly,opts == HBL_READ_ONLY) of
+ { (False,False) -> GL.ReadWrite
+ ; (False,True) -> GL.ReadOnly
+ ; (True,_) -> GL.WriteOnly
+ }
+ mb <- GL.mapBuffer GL.ArrayBuffer access
+ case mb of
+ { Just b -> return $ plusPtr b offs
+ ; Nothing -> error "Vertex Buffer: Out of memory"
+ }
+ }
+
+glvbUnlock a = do
+ lockinfo <- readIORef (glvbLockInfo a)
+ let (lockStart,lockSize,reqUpdate) = case lockinfo of
+ { Just li -> li
+ ; Nothing -> error "Cannot unlock this buffer, it is not locked!"
+ }
+ writeIORef (glvbLockInfo a) Nothing
+ case glvbShadowBuffer a of
+ { Just b -> when reqUpdate $ do -- If we used the shadow buffer this time...
+ GL.bindBuffer GL.ArrayBuffer $= (glvbBufferObject a)
+ case lockStart == 0 && lockSize == getSizeInBytes a of
+ { True -> GL.bufferData GL.ArrayBuffer $= (fromIntegral lockSize, b, getGLUsage $ getUsage a)
+ ; False -> GL.bufferSubData GL.ArrayBuffer GL.WriteToBuffer (fromIntegral lockStart) (fromIntegral lockSize) b
+ }
+ ; Nothing -> do
+ GL.bindBuffer GL.ArrayBuffer $= (glvbBufferObject a)
+ ok <- GL.unmapBuffer GL.ArrayBuffer
+ unless ok $ error "Buffer data corrupted, please reload"
+ }
+
+--mkGLVertexBuffer :: RenderSystem rs => rs -> Int -> Int -> Usage -> Bool -> IO GLVertexBuffer
+mkGLVertexBuffer rs vertexSize numVerts usage useShadowBuffer = do
+ lockinfo <- newIORef Nothing
+ [bufferObject] <- GL.genObjectNames 1
+ GL.bindBuffer GL.ArrayBuffer $= Just bufferObject
+ GL.bufferData GL.ArrayBuffer $= (fromIntegral $ numVerts * vertexSize, nullPtr, getGLUsage usage)
+ shadowBuffer <- case useShadowBuffer of
+ { True -> do
+ b <- mallocBytes $ numVerts * vertexSize
+ return $ Just b
+ ; False -> return Nothing
+ }
+ return $ GLVertexBuffer
+ { glvbNumVertices = numVerts
+ , glvbVertexSize = vertexSize
+
+ , glvbUsage = usage
+ , glvbLockInfo = lockinfo
+
+ , glvbShadowBuffer = shadowBuffer
+ , glvbBufferObject = Just bufferObject
+ }
+
+rmGLVertexBuffer :: GLVertexBuffer -> IO ()
+rmGLVertexBuffer a = do
+ case glvbBufferObject a of
+ { Just b -> GL.deleteObjectNames [b]
+ ; Nothing -> return ()
+ }
+ case glvbShadowBuffer a of
+ { Just b -> free b
+ ; Nothing -> return ()
+ }
diff --git a/Graphics/LambdaCube/RenderSystemCapabilities.hs b/Graphics/LambdaCube/RenderSystemCapabilities.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/RenderSystemCapabilities.hs
@@ -0,0 +1,119 @@
+module Graphics.LambdaCube.RenderSystemCapabilities where
+
+import Data.Set
+
+import Graphics.LambdaCube.Types
+
+-- | Enum describing the different hardware capabilities we want to check for
+data Capabilities
+ = RSC_AUTOMIPMAP -- ^ Supports generating mipmaps in hardware
+ | RSC_BLENDING
+ | RSC_ANISOTROPY -- ^ Supports anisotropic texture filtering
+ | RSC_DOT3 -- ^ Supports fixed-function DOT3 texture blend
+ | RSC_CUBEMAPPING -- ^ Supports cube mapping
+ | RSC_HWSTENCIL -- ^ Supports hardware stencil buffer
+ | RSC_VBO -- ^ Supports hardware vertex and index buffers
+ | RSC_VERTEX_PROGRAM -- ^ Supports vertex programs (vertex shaders)
+ | RSC_FRAGMENT_PROGRAM -- ^ Supports fragment programs (pixel shaders)
+ | RSC_SCISSOR_TEST -- ^ Supports performing a scissor test to exclude areas of the screen
+ | RSC_TWO_SIDED_STENCIL -- ^ Supports separate stencil updates for both front and back faces
+ | RSC_STENCIL_WRAP -- ^ Supports wrapping the stencil value at the range extremeties
+ | RSC_HWOCCLUSION -- ^ Supports hardware occlusion queries
+ | RSC_USER_CLIP_PLANES -- ^ Supports user clipping planes
+ | RSC_VERTEX_FORMAT_UBYTE4 -- ^ Supports the VET_UBYTE4 vertex element type
+ | RSC_INFINITE_FAR_PLANE -- ^ Supports infinite far plane projection
+ | RSC_HWRENDER_TO_TEXTURE -- ^ Supports hardware render-to-texture (bigger than framebuffer)
+ | RSC_TEXTURE_FLOAT -- ^ Supports float textures and render targets
+ | RSC_NON_POWER_OF_2_TEXTURES -- ^ Supports non-power of two textures
+ | RSC_TEXTURE_3D -- ^ Supports 3d (volume) textures
+ | RSC_POINT_SPRITES -- ^ Supports basic point sprite rendering
+ | RSC_POINT_EXTENDED_PARAMETERS -- ^ Supports extra point parameters (minsize, maxsize, attenuation)
+ | RSC_VERTEX_TEXTURE_FETCH -- ^ Supports vertex texture fetch
+ | RSC_MIPMAP_LOD_BIAS -- ^ Supports mipmap LOD biasing
+ | RSC_GEOMETRY_PROGRAM -- ^ Supports hardware geometry programs
+ | RSC_HWRENDER_TO_VERTEX_BUFFER -- ^ Supports rendering to vertex buffers
+
+ | RSC_TEXTURE_COMPRESSION -- ^ Supports compressed textures
+ | RSC_TEXTURE_COMPRESSION_DXT -- ^ Supports compressed textures in the DXT/ST3C formats
+ | RSC_TEXTURE_COMPRESSION_VTC -- ^ Supports compressed textures in the VTC format
+ | RSC_TEXTURE_COMPRESSION_PVRTC -- ^ Supports compressed textures in the PVRTC format
+ | RSC_FIXED_FUNCTION -- ^ Supports fixed-function pipeline
+ | RSC_MRT_DIFFERENT_BIT_DEPTHS -- ^ Supports MRTs with different bit depths
+ | RSC_ALPHA_TO_COVERAGE -- ^ Supports Alpha to Coverage (A2C)
+ | RSC_ADVANCED_BLEND_OPERATIONS -- ^ Supports Blending operations other than +
+
+ -- * DirectX specific caps
+ | RSC_PERSTAGECONSTANT -- ^ Is DirectX feature "per stage constants" supported
+
+ -- * GL Specific Caps
+ | RSC_GL1_5_NOVBO -- ^ Supports openGL GLEW version 1.5
+ | RSC_FBO -- ^ Support for Frame Buffer Objects (FBOs)
+ | RSC_FBO_ARB -- ^ Support for Frame Buffer Objects ARB implementation (regular FBO is higher precedence)
+ | RSC_FBO_ATI -- ^ Support for Frame Buffer Objects ATI implementation (ARB FBO is higher precedence)
+ | RSC_PBUFFER -- ^ Support for PBuffer
+ | RSC_GL1_5_NOHWOCCLUSION -- ^ Support for GL 1.5 but without HW occlusion workaround
+ | RSC_POINT_EXTENDED_PARAMETERS_ARB -- ^ Support for point parameters ARB implementation
+ | RSC_POINT_EXTENDED_PARAMETERS_EXT -- ^ Support for point parameters EXT implementation
+ deriving (Eq,Ord)
+
+data DriverVersion
+ = DriverVersion
+ { dvMajor :: Int
+ , dvMinor :: Int
+ , dvRelease :: Int
+ , dvBuild :: Int
+ }
+ deriving Eq
+
+-- | Enumeration of GPU vendors.
+data GPUVendor
+ = GPU_UNKNOWN
+ | GPU_NVIDIA
+ | GPU_ATI
+ | GPU_INTEL
+ | GPU_S3
+ | GPU_MATROX
+ | GPU_3DLABS
+ | GPU_SIS
+ | GPU_IMAGINATION_TECHNOLOGIES
+ | GPU_APPLE -- ^ Apple Software Renderer
+ deriving Eq
+
+{-| singleton class for storing the capabilities of the graphics card.
+@remarks
+This class stores the capabilities of the graphics card. This
+information is set by the individual render systems.
+-}
+data RenderSystemCapabilities
+ = RenderSystemCapabilities
+ { rscDriverVersion :: DriverVersion
+ , rscVendor :: GPUVendor -- ^ GPU Vendor
+
+-- , rscNumWorldMatrices :: Int -- ^ The number of world matrices available
+ , rscNumTextureUnits :: Int -- ^ The number of texture units available
+ , rscStencilBufferBitDepth :: Int -- ^ The stencil buffer bit depth
+-- , rscNumVertexBlendMatrices :: Int -- ^ The number of matrices available for hardware blending
+ , rscCapabilities :: Set Capabilities -- ^ Stores the capabilities flags.
+
+ , rscDeviceName :: String -- ^ The name of the device as reported by the render system
+ , rscRenderSystemName :: String -- ^ The identifier associated with the render system for which these capabilities are valid
+
+ , rscVertexProgramConstantFloatCount :: Int -- ^ The number of floating-point constants vertex programs support
+ , rscVertexProgramConstantIntCount :: Int -- ^ The number of integer constants vertex programs support
+ , rscVertexProgramConstantBoolCount :: Int -- ^ The number of boolean constants vertex programs support
+ , rscGeometryProgramConstantFloatCount :: Int -- ^ The number of floating-point constants geometry programs support
+ , rscGeometryProgramConstantIntCount :: Int -- ^ The number of integer constants vertex geometry support
+ , rscGeometryProgramConstantBoolCount :: Int -- ^ The number of boolean constants vertex geometry support
+ , rscFragmentProgramConstantFloatCount :: Int -- ^ The number of floating-point constants fragment programs support
+ , rscFragmentProgramConstantIntCount :: Int -- ^ The number of integer constants fragment programs support
+ , rscFragmentProgramConstantBoolCount :: Int -- ^ The number of boolean constants fragment programs support
+ , rscNumMultiRenderTargets :: Int -- ^ The number of simultaneous render targets supported
+ , rscMaxPointSize :: FloatType -- ^ The maximum point size
+ , rscNonPOW2TexturesLimited :: Bool -- ^ Are non-POW2 textures feature-limited?
+ , rscNumVertexTextureUnits :: Int -- ^ The number of vertex texture units supported
+ , rscVertexTextureUnitsShared :: Bool -- ^ Are vertex texture units shared with fragment processor?
+ , rscGeometryProgramNumOutputVertices :: Int -- ^ The number of vertices a geometry program can emit in a single run
+
+ , rscSupportedShaderProfiles :: Set String -- ^ The list of supported shader profiles
+ }
+
diff --git a/Graphics/LambdaCube/Resource.hs b/Graphics/LambdaCube/Resource.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/Resource.hs
@@ -0,0 +1,145 @@
+module Graphics.LambdaCube.Resource where
+
+import qualified Data.List as List
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Control.Monad
+import System.Directory
+import System.FilePath
+
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString as SB
+import Data.ByteString.Internal as B
+import Codec.Archive.Zip
+import System.Log.Logger
+
+import Graphics.LambdaCube.Loader.CompositorScript
+import Graphics.LambdaCube.Loader.MaterialScript
+import Graphics.LambdaCube.Loader.ResourceScript
+import Graphics.LambdaCube.Compositor
+import Graphics.LambdaCube.Material
+import Graphics.LambdaCube.Texture
+import Graphics.LambdaCube.GpuProgram
+import Graphics.LambdaCube.World
+
+-- load resources into resource library (initResources :: [ResourceGroup] -> ResourceLibrary)
+
+{-
+ Stores data about:
+ - loaded meshes (name)
+ - loaded and compiled materials (name)
+-}
+
+-- TODO: load all available materials
+-- scan path tree searching for *.material files
+data (Texture t, GpuProgram p, LinkedGpuProgram lp) => ResourceItem t p lp
+ = RI_Material (String,Material t lp)
+ | RI_GpuProgram (String,GpuProgramDescriptor p)
+ | RI_Compositor (String,Compositor t lp)
+
+addConfig cfgFile world = do
+ Just rp <- loadResourcesCfg cfgFile
+ addResourceLibrary rp world
+
+addResourceLibrary resPath w@World { wrResource = res } = do
+ -- fold on every group and path
+ -- getDirectoryContents :: FilePath -> IO [FilePath]
+ -- doesDirectoryExist :: FilePath -> IO Bool
+ -- takeExtension :: FilePath -> String
+ -- TODO:
+ -- scan whole resource path searching for resource files and load them:
+ -- .material
+ -- .program
+ -- add normal (uncompiled) materials to material library
+ let loadResGrp s (_,l) = foldM loadRes s l
+ loadRes l (PathZip,n) = return l
+ loadRes l p@(PathDir,n) = do
+ ok <- doesDirectoryExist n
+ case ok of
+ { True -> do
+ c <- getDirectoryContents n
+ foldM (loadItem n) l c
+ ; False -> return l
+ }
+ loadItem dn l n = do
+ --parseMaterial -> Maybe (mats,verts,frags)
+ case takeExtension n of
+ { ".material" -> do
+ debugM "ResourceLibrary" $ "load: " ++ n
+ f <- B.readFile $ dn ++ "/" ++ n -- FIXME: this is temporary solution
+ mb <- parseMaterial n $ map B.w2c $ B.unpack f
+ case mb of
+ { Nothing -> do
+ errorM "ResourceLibrary" $ "Syntax error in file " ++ n
+ return l
+ ; Just (ml,vpl,fpl) -> do
+ let ms = [RI_Material (mtName m,m) | m <- ml]
+ vs = [RI_GpuProgram (gpdName m,m) | m <- vpl]
+ fs = [RI_GpuProgram (gpdName m,m) | m <- fpl]
+ return $ l ++ ms ++ vs ++ fs
+ }
+ ; ".compositor" -> do
+ debugM "ResourceLibrary" $ "load: " ++ n
+ f <- B.readFile $ dn ++ "/" ++ n -- FIXME: this is temporary solution
+ mb <- parseCompositor n $ map B.w2c $ B.unpack f
+ case mb of
+ { Nothing -> do
+ errorM "ResourceLibrary" $ "Syntax error in file " ++ n
+ return l
+ ; Just cl -> do
+ return $ l ++ [RI_Compositor (cmpName m,m) | m <- cl]
+ }
+ ; _ -> return l
+ }
+ insertList = List.foldl' (flip (uncurry Map.insert))
+ l <- foldM loadResGrp [] resPath
+ return w { wrResource = res
+ { rlResourceGroups = resPath ++ rlResourceGroups res
+ , rlMaterialMap = insertList (rlMaterialMap res) [m | (RI_Material m) <- l]
+ , rlGpuProgramMap = insertList (rlGpuProgramMap res) [m | (RI_GpuProgram m) <- l]
+ , rlCompositorMap = insertList (rlCompositorMap res) [m | (RI_Compositor m) <- l]
+ }
+ }
+ --ResourceLibrary (resPath++path) meshes (Map.union mats materialMap) texes (Map.union shads shaderMap) progs
+
+{-
+loadResourceGroup
+dropResourceGroup
+-}
+
+{-
+--compileMaterial
+-- load textures from disk to opengl
+-- drops unnecessary techniques (include,exlude rules)
+compileMaterial :: ResourceLibrary -> String -> IO (ResourceLibrary,Material)
+compileMaterial rlib m = do
+ let mm = (rlMaterialMap rlib)
+ if Map.notMember m mm then error ("Unknown material: " ++ m) else return ()
+ let (mt,mcmt) = mm Map.! m
+ (rlib',cmt) <- if isJust mcmt then return (rlib,fromMaybe (error "fromJust 0") mcmt) else compMat rlib mt -- copy original material data and load texture units
+ return (rlib',cmt) where
+ compMat rl mat@(Material {mtTechnique=techs}) = do
+ debugM "ResourceLibrary" $ "compiling material: " ++ m
+ (rl',techs') <- foldM compTechnique (rl,[]) techs
+ let matmap' = insert m (mat,Just cmt') (rlMaterialMap rl)
+ cmt' = mat{mtTechnique=techs'}
+ return (rl'{rlMaterialMap=matmap'},cmt')
+ compTechnique (rl,l) t@(Technique {tcPass=p}) = do
+ excl <- excludeTechnique t
+ if excl then return (rl, l) else do
+ (rl',p') <- foldM compPass (rl,[]) p
+ return (rl',(l ++ [t{tcPass=p'}]))
+ compPass (rl,l) p = do
+ (rl',tu') <- foldM compTexUnit (rl,[]) $ psTextureUnit p
+ let (ProgRefName prog) = psShaderProgram p
+ (rl'',prog') <- compileProgram rl' prog
+ return (rl'',(l ++ [p{psTextureUnit=tu', psShaderProgram=(ProgRefObj prog')}]))
+ compTexUnit (rl,l) tu = do
+ (rl',texid) <- loadTexture rl $ head $ tuTexture tu
+ return (rl',(l ++ [tu{tuTextureObject=Just [texid]}]))
+ excludeTechnique t@(Technique {tcPass=p}) = do
+ -- exclude if shaders are not supported
+ version <- GL.get (GL.majorMinor GL.glVersion)
+ let reqShaders = not $ null $ filter (\(Pass {psShaderProgram=(ProgRefName (vp,pp))})-> isJust vp || isJust pp) p
+ if reqShaders && version < (2,0) then return True else return False
+-}
diff --git a/Graphics/LambdaCube/SceneGraph.hs b/Graphics/LambdaCube/SceneGraph.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/SceneGraph.hs
@@ -0,0 +1,141 @@
+module Graphics.LambdaCube.SceneGraph where
+
+import Data.Maybe
+import Data.Map as Map hiding (map)
+import qualified Data.IntMap as IntMap
+import Data.List as List
+import Control.Monad
+import System.FilePath
+
+import Data.Graph.Inductive
+
+import Graphics.LambdaCube.Types
+import Graphics.LambdaCube.Common
+import Graphics.LambdaCube.Math
+import Graphics.LambdaCube.Light
+import Graphics.LambdaCube.Material
+import Graphics.LambdaCube.Entity
+import Graphics.LambdaCube.Resource
+import Graphics.LambdaCube.RenderQueue
+import Graphics.LambdaCube.World
+import Graphics.LambdaCube.Texture
+import Graphics.LambdaCube.RenderSystem
+
+--type MkSceneObjectAction = World -> IO (World, SceneObject)
+--type MkNodeAction = ResourceLibrary -> IO (ResourceLibrary,(String,String),SceneNode)
+
+--simpleCamera :: String -> MkSceneObjectAction
+simpleCamera name w = return (w,cam)
+ where
+ cam = SO_Camera Camera
+ { cmName = name
+ , cmFov = 45
+ , cmNear = 0.1
+ , cmFar = 5000
+ , cmAspectRatio = Nothing
+ , cmPolygonMode = PM_SOLID
+ }
+
+--wireCamera :: String -> MkSceneObjectAction
+wireCamera name w = return (w,cam)
+ where
+ cam = SO_Camera Camera
+ { cmName = name
+ , cmFov = 45
+ , cmNear = 0.1
+ , cmFar = 5000
+ , cmAspectRatio = Nothing
+ , cmPolygonMode = PM_WIREFRAME
+ }
+
+--light :: MkSceneObjectAction
+light w = return (w,SO_Light $ Light {})
+
+--camera :: Camera -> MkSceneObjectAction
+camera cam w = return (w,SO_Camera cam)
+
+--mesh :: String -> MkSceneObjectAction
+mesh name w = do
+ (w',e) <- createEntity w name name
+ return (w', SO_Entity e)
+
+--meshMat :: String -> [String] -> MkSceneObjectAction
+meshMat name mats w0 = do
+ (w1,e0) <- createEntity w0 name name
+ (w2,e1) <- setEntityMaterial w1 mats e0
+ return (w2, SO_Entity e1)
+
+--mkNode :: String -> String -> Matrix4 -> [MkSceneObjectAction] -> MkNodeAction
+mkNode parent name t objActs w = do
+ (w',o) <- foldM mkObjs (w,[]) objActs
+ return (w',(parent,name),SceneNode name o t)
+ where
+ mkObjs (w,l) a = do
+ (w',so) <- a w
+ return (w',so:l)
+{-
+addSkyBox :: String -> World -> IO World
+addSkyBox s w@World { wrResource = rl, wrScene = scene } = do
+ (rl',mat) <- compileMaterial rl s
+ return w { wrResource = rl', wrScene = scene{scSky = Just $ SkyBox mat} }
+-}
+
+{-
+data Scene = Scene
+ { scGraph :: Gr String ()
+ -- use: bytestring-trie (efficient ByteString map)
+ , scMap :: Map String SceneNode
+ , scSky :: Maybe Sky
+ -- Fog settings
+ }
+-}
+--addScene :: [MkNodeAction] -> World -> IO World
+addScene nodes w@World { wrResource = rl, wrScene = scene } = do
+ -- done: create scene nodes
+ let mkNodes (w,pl,nl) a = do
+ (w',p,sn) <- a w
+ return (w',p:pl,sn:nl)
+ (w',p,nodel) <- foldM mkNodes (w,[],[]) nodes
+ -- done: register node ids and names to bimap
+ -- done: create graph nodes
+ -- done: create graph edges
+ let namel = map snName nodel
+ nodeids = newNodes (length nodes) $ scGraph scene
+ m' = (scMap scene) `Map.union` (Map.fromList $ zip namel $ zip nodeids nodel)
+ g = insEdges (map fe p) $ insNodes (zip nodeids namel) $ scGraph scene
+ fe (p,c) = (fst $ m' ! p, fst $ m' ! c,())
+ scene' = scene
+ { scGraph = g
+ , scMap = m'
+ --, scSky :: Maybe Sky
+ }
+
+ return w' { wrScene = scene' }
+
+--updateTransforms :: [(String,Matrix4)] -> World -> IO World
+updateTransforms l = return . mapScene (\s -> foldr updateSceneNode s l)
+ where
+ updateSceneNode (name,mat) scene = scene { scMap = Map.insert name (n,sn') m}
+ where
+ m = scMap scene
+ (n,sn) = m ! name
+ sn' = sn {snTransform = mat}
+
+--flattenScene :: Scene -> FlattenScene
+flattenScene s = FlattenScene
+ { fsCamera = [(m,c) | (m,SO_Camera c) <- fs]
+ , fsRenderable = [(m,prepare m e,rq,pr) | (m,SO_Entity e) <- fs]
+ , fsLight = [(m,l) | (m,SO_Light l) <- fs]
+ }
+ where
+ rq = constRenderQueueMain
+ pr = constRenderableDefaultPriority
+ fs = visitNode s 0 $ transl 0 0 0
+
+ --visitNode :: Scene -> Int -> Matrix4 -> [(Matrix4,SceneObject)]
+ visitNode g n t = [(lt,e) | e <- snObject ln ] ++ (concat [ visitNode g sn lt | sn <- suc (scGraph g) n ])
+ where
+ Just name = lab (scGraph g) n
+ ln = snd $ (scMap g) ! name
+ lt = (snTransform ln) <> t
+
diff --git a/Graphics/LambdaCube/Technique.hs b/Graphics/LambdaCube/Technique.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/Technique.hs
@@ -0,0 +1,84 @@
+module Graphics.LambdaCube.Technique where
+
+import Graphics.LambdaCube.RenderSystemCapabilities
+import Graphics.LambdaCube.Pass
+import Graphics.LambdaCube.Texture
+import Graphics.LambdaCube.GpuProgram
+
+-- | illumination pass state type
+data IlluminationPassesState
+ = IPS_COMPILE_DISABLED
+ | IPS_NOT_COMPILED
+ | IPS_COMPILED
+ deriving Eq
+
+{-| Directive used to manually control technique support based on the
+ inclusion or exclusion of some factor.
+-}
+data IncludeOrExclude
+ = INCLUDE -- ^ Inclusive - only support if present
+ | EXCLUDE -- ^ Exclusive - do not support if present
+ deriving Eq
+
+-- | Rule controlling whether technique is deemed supported based on GPU vendor
+data GPUVendorRule
+ = GPUVendorRule
+ { gvrVendor :: GPUVendor
+ , gvrIncludeOrExclude :: IncludeOrExclude
+ }
+ deriving Eq
+
+-- | Rule controlling whether technique is deemed supported based on GPU device name
+data GPUDeviceNameRule
+ = GPUDeviceNameRule
+ { gdrDevicePattern :: String
+ , gdrIncludeOrExclude :: IncludeOrExclude
+ , gdrCaseSensitive :: Bool
+ }
+ deriving Eq
+
+{-| Class representing an approach to rendering this particular Material.
+@remarks
+ Ogre will attempt to use the best technique supported by the active hardware,
+ unless you specifically request a lower detail technique (say for distant
+ rendering).
+-}
+data (Texture t, LinkedGpuProgram lp) => Technique t lp
+ = Technique
+ { tchPasses :: [Pass t lp] -- ^ List of primary passes
+-- , tchIlluminationPasses :: [IlluminationPass] -- ^ List of derived passes, categorised into IlluminationStage (ordered)
+
+-- , tchIsSupported :: Bool
+-- IlluminationPassesState mIlluminationPassesCompilationPhase;
+ , tchLodIndex :: Int -- ^ LOD level
+ {-| Scheme index, derived from scheme name but the names are held on
+ MaterialManager, for speed an index is used here.
+ -}
+ , tchSchemeIndex :: Int
+ , tchName :: String -- ^ optional name for the technique
+
+ {-| When casting shadow, if not using default Ogre shadow casting material, or
+ nor using fixed function casting, mShadowCasterMaterial let you customize per material
+ shadow caster behavior
+ -}
+-- , tchShadowCasterMaterial :: Material
+ {-| When casting shadow, if not using default Ogre shadow casting material, or
+ nor using fixed function casting, mShadowCasterMaterial let you customize per material
+ shadow caster behavior.There only material name is stored so that it can be loaded once all file parsed in a resource group.
+ -}
+-- , tchShadowCasterMaterialName :: String
+ {-| When receiving shadow, if not using default Ogre shadow receiving material, or
+ nor using fixed function texture projection receiving, mShadowReceiverMaterial let you customize per material
+ shadow caster behavior
+ -}
+-- , tchShadowReceiverMaterial :: Material
+ {-| When receiving shadow, if not using default Ogre shadow receiving material, or
+ nor using fixed function texture projection receiving, mShadowReceiverMaterial let you customize per material
+ shadow caster behavior. There only material name is stored so that it can be loaded once all file parsed in a resource group.
+ -}
+-- , tchShadowReceiverMaterialName :: String
+
+ , tchGPUVendorRules :: [GPUVendorRule]
+ , tchGPUDeviceNameRules :: [GPUDeviceNameRule]
+ }
+
diff --git a/Graphics/LambdaCube/Texture.hs b/Graphics/LambdaCube/Texture.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/Texture.hs
@@ -0,0 +1,81 @@
+module Graphics.LambdaCube.Texture where
+
+import Graphics.LambdaCube.Types
+import Graphics.LambdaCube.PixelFormat
+import Graphics.LambdaCube.HardwareBuffer
+
+
+-- | Enum identifying the texture usage
+data TextureUsage
+ = TextureUsage
+ { tuUsage :: Usage
+ , tuAutoMipmap :: Bool -- ^ mipmaps will be automatically generated for this texture
+ , tuRenderTarget :: Bool -- ^ this texture will be a render target, i.e. used as a target for render to texture
+ -- setting this flag will ignore all other texture usages except TU_AUTOMIPMAP
+ }
+ deriving Eq
+{-
+enum TextureUsage
+{
+ /// @copydoc HardwareBuffer::Usage
+ TU_STATIC = HardwareBuffer::HBU_STATIC,
+ TU_DYNAMIC = HardwareBuffer::HBU_DYNAMIC,
+ TU_WRITE_ONLY = HardwareBuffer::HBU_WRITE_ONLY,
+ TU_STATIC_WRITE_ONLY = HardwareBuffer::HBU_STATIC_WRITE_ONLY,
+ TU_DYNAMIC_WRITE_ONLY = HardwareBuffer::HBU_DYNAMIC_WRITE_ONLY,
+ TU_DYNAMIC_WRITE_ONLY_DISCARDABLE = HardwareBuffer::HBU_DYNAMIC_WRITE_ONLY_DISCARDABLE,
+ /// mipmaps will be automatically generated for this texture
+ TU_AUTOMIPMAP = 0x100,
+ /// this texture will be a render target, i.e. used as a target for render to texture
+ /// setting this flag will ignore all other texture usages except TU_AUTOMIPMAP
+ TU_RENDERTARGET = 0x200,
+ /// default to automatic mipmap generation static textures
+ TU_DEFAULT = TU_AUTOMIPMAP | TU_STATIC_WRITE_ONLY
+
+};
+-}
+
+-- | Enum identifying the texture type
+data TextureType
+ = TEX_TYPE_1D -- ^ 1D texture, used in combination with 1D texture coordinates
+ | TEX_TYPE_2D -- ^ 2D texture, used in combination with 2D texture coordinates (default)
+ | TEX_TYPE_3D -- ^ 3D volume texture, used in combination with 3D texture coordinates
+ | TEX_TYPE_CUBE_MAP -- ^ 3D cube map, used in combination with 3D texture coordinates
+ deriving (Eq,Show)
+
+-- | Enum identifying special mipmap numbers
+data TextureMipmap
+ = MIP_UNLIMITED -- ^ Generate mipmaps up to 1x1
+ | MIP_DEFAULT -- ^ Use TextureManager default
+ | MIP_NUMBER Int
+ deriving Eq
+
+class (Eq a, HardwareBuffer a) => Texture a where
+ txName :: a -> String
+ txWidth :: a -> Int
+ txHeight :: a -> Int
+ txDepth :: a -> Int
+ txNumRequestedMipmaps :: a -> TextureMipmap
+ txNumMipmaps :: a -> Int
+ txMipmapsHardwareGenerated :: a -> Bool
+ txGamma :: a -> FloatType
+ txHwGamma :: a -> Bool
+ txFSAA :: a -> Int
+ txFSAAHint :: a -> String
+ txTextureType :: a -> TextureType
+ txFormat :: a -> PixelFormat
+
+ --txUsage :: a -> TextureUsage
+ txAutoMipmap :: a -> Bool -- ^ mipmaps will be automatically generated for this texture
+ txRenderTarget :: a -> Bool -- ^ this texture will be a render target, i.e. used as a target for render to texture
+ -- setting this flag will ignore all other texture usages except TU_AUTOMIPMAP
+
+ txSrcFormat :: a -> PixelFormat
+ txSrcWidth :: a -> Int
+ txSrcHeight :: a -> Int
+ txSrcDepth :: a -> Int
+
+ txDesiredFormat :: a -> PixelFormat
+ txDesiredIntegerBitDepth :: a -> Int
+ txDesiredFloatBitDepth :: a -> Int
+ txTreatLuminanceAsAlpha :: a -> Bool
diff --git a/Graphics/LambdaCube/TextureUnitState.hs b/Graphics/LambdaCube/TextureUnitState.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/TextureUnitState.hs
@@ -0,0 +1,195 @@
+module Graphics.LambdaCube.TextureUnitState where
+
+import Graphics.LambdaCube.Types
+import Graphics.LambdaCube.Common
+import Graphics.LambdaCube.BlendMode
+import Graphics.LambdaCube.PixelFormat
+import Graphics.LambdaCube.Texture
+
+
+{-| Definition of the broad types of texture effect you can apply to a texture unit.
+@note
+ Note that these have no effect when using the programmable pipeline, since their
+ effect is overridden by the vertex / fragment programs.
+-}
+data TextureEffectType
+ = ET_ENVIRONMENT_MAP -- ^ Generate all texture coords based on angle between camera and vertex
+ | ET_PROJECTIVE_TEXTURE -- ^ Generate texture coords based on a frustum
+ | ET_UVSCROLL -- ^ Constant u/v scrolling effect
+ | ET_USCROLL -- ^ Constant u scrolling effect
+ | ET_VSCROLL -- ^ Constant u/v scrolling effect
+ | ET_ROTATE -- ^ Constant rotation
+ | ET_TRANSFORM -- ^ More complex transform
+ deriving Eq
+
+{-| Enumeration to specify type of envmap.
+@note
+ Note that these have no effect when using the programmable pipeline, since their
+ effect is overridden by the vertex / fragment programs.
+-}
+data EnvMapType
+ = ENV_PLANAR -- ^ Envmap based on vector from camera to vertex position, good for planar geometry
+ | ENV_CURVED -- ^ Envmap based on dot of vector from camera to vertex and vertex normal, good for curves
+ | ENV_REFLECTION -- ^ Envmap intended to supply reflection vectors for cube mapping
+ | ENV_NORMAL -- ^ Envmap intended to supply normal vectors for cube mapping
+
+{-| Useful enumeration when dealing with procedural transforms.
+@note
+ Note that these have no effect when using the programmable pipeline, since their
+ effect is overridden by the vertex / fragment programs.
+-}
+data TextureTransformType
+ = TT_TRANSLATE_U
+ | TT_TRANSLATE_V
+ | TT_SCALE_U
+ | TT_SCALE_V
+ | TT_ROTATE
+
+{-| Texture addressing modes - default is TAM_WRAP.
+@note
+ These settings are relevant in both the fixed-function and the
+ programmable pipeline.
+-}
+data TextureAddressingMode
+ = TAM_WRAP -- ^ Texture wraps at values over 1.0
+ | TAM_MIRROR -- ^ Texture mirrors (flips) at joins over 1.0
+ | TAM_CLAMP -- ^ Texture clamps at 1.0
+ | TAM_BORDER -- ^ Texture coordinates outside the range [0.0, 1.0] are set to the border colour
+ deriving Eq
+
+-- | Texture addressing mode for each texture coordinate.
+data UVWAddressingMode
+ = UVWAddressingMode
+ { amU :: TextureAddressingMode
+ , amV :: TextureAddressingMode
+ , amW :: TextureAddressingMode
+ }
+ deriving Eq
+
+-- | Enum identifying the frame indexes for faces of a cube map (not the composite 3D type.
+data TextureCubeFace
+ = CUBE_FRONT
+ | CUBE_BACK
+ | CUBE_LEFT
+ | CUBE_RIGHT
+ | CUBE_UP
+ | CUBE_DOWN
+
+{-
+ = ET_ENVIRONMENT_MAP -- ^ Generate all texture coords based on angle between camera and vertex
+ -- EnvMapType
+ | ET_PROJECTIVE_TEXTURE -- ^ Generate texture coords based on a frustum
+ | ET_UVSCROLL -- ^ Constant u/v scrolling effect
+ -- speedX speedY
+ | ET_ROTATE -- ^ Constant rotation
+ -- speed
+ | ET_TRANSFORM -- ^ More complex transform
+
+xform info:
+ - anim type (scroll,rotate,scale)
+ - wave type (sine,triangle,square,sawtooth,inversesawtooth)
+ - base
+ - frequency
+ - phase
+ - amplitude
+-}
+-- | Internal structure defining a texture effect.
+data TextureEffect
+ = TextureEffect
+ { teType :: TextureEffectType
+ , teSubType :: Int
+ , teArg1 :: FloatType
+ , teArg2 :: FloatType
+ , teWaveType :: WaveformType
+ , teBase :: FloatType
+ , teFrequency :: FloatType
+ , tePhase :: FloatType
+ , teAmplitude :: FloatType
+ }
+ deriving Eq
+
+-- | The type of unit to bind the texture settings to.
+data BindingType
+ = BT_FRAGMENT -- ^ Regular fragment processing unit - the default.
+ | BT_VERTEX -- ^ Vertex processing unit - indicates this unit will be used for
+ -- a vertex texture fetch.
+ deriving Eq
+
+-- | Enum identifying the type of content this texture unit contains.
+data ContentType
+ = CONTENT_NAMED -- ^ Normal texture identified by name
+ | CONTENT_SHADOW -- ^ A shadow texture, automatically bound by engine
+ deriving Eq
+
+-------------------------------------------------
+
+{-| Class representing the state of a single texture unit during a Pass of a
+ Technique, of a Material.
+@remarks
+ Texture units are pipelines for retrieving texture data for rendering onto
+ your objects in the world. Using them is common to both the fixed-function and
+ the programmable (vertex and fragment program) pipeline, but some of the
+ settings will only have an effect in the fixed-function pipeline (for example,
+ setting a texture rotation will have no effect if you use the programmable
+ pipeline, because this is overridden by the fragment program). The effect
+ of each setting as regards the 2 pipelines is commented in each setting.
+@par
+ When I use the term 'fixed-function pipeline' I mean traditional rendering
+ where you do not use vertex or fragment programs (shaders). Programmable
+ pipeline means that for this pass you are using vertex or fragment programs.
+-}
+data Texture t => TextureUnitState t
+ = TextureUnitState
+ { tusAnimDuration :: Maybe FloatType -- ^ Duration of animation in seconds
+ , tusCubic :: Bool -- ^ is this a series of 6 2D textures to make up a cube?
+
+ , tusTextureType :: TextureType
+ , tusDesiredFormat :: PixelFormat
+ , tusTextureSrcMipmaps :: TextureMipmap -- ^ Request number of mipmaps
+
+ , tusTextureCoordSetIndex :: Int
+ , tusAddressMode :: UVWAddressingMode
+ , tusBorderColour :: ColourValue
+
+ , tusColourBlendMode :: LayerBlendModeEx
+ , tusColourBlendFallbackSrc :: SceneBlendFactor
+ , tusColourBlendFallbackDest :: SceneBlendFactor
+
+ , tusAlphaBlendMode :: LayerBlendModeEx
+-- mutable bool mTextureLoadFailed;
+-- , tusTextureLoadFailed :: Bool
+ , tusIsAlpha :: Bool
+ , tusHwGamma :: Bool
+
+-- mutable bool mRecalcTexMatrix;
+ , tusUMod :: FloatType
+ , tusVMod :: FloatType
+ , tusUScale :: FloatType
+ , tusVScale :: FloatType
+ , tusRotate :: FloatType
+-- mutable Matrix4 mTexModMatrix;
+
+ , tusMinFilter :: FilterOptions -- ^ Texture filtering - minification
+ , tusMagFilter :: FilterOptions -- ^ Texture filtering - magnification
+ , tusMipFilter :: FilterOptions -- ^ Texture filtering - mipmapping
+
+ , tusMaxAniso :: Int -- ^ Texture anisotropy
+ , tusMipmapBias :: FloatType -- ^ Mipmap bias
+
+-- bool mIsDefaultAniso;
+-- bool mIsDefaultFiltering;
+ , tusBindingType :: BindingType -- ^ Binding type (fragment or vertex pipeline)
+ , tusContentType :: ContentType -- ^ Content type of texture (normal loaded texture, auto-texture)
+
+ , tusFrameNames :: [String]
+ , tusFrames :: Maybe [t]
+ , tusName :: String -- ^ optional name for the TUS
+ , tusTextureAlias :: String -- ^ optional alias for texture frames
+ , tusEffects :: [TextureEffect]
+--------------------------------------
+
+ -- typedef multimap::type EffectMap;
+ -- EffectMap mEffects;
+ }
+ deriving Eq
+
diff --git a/Graphics/LambdaCube/Types.hs b/Graphics/LambdaCube/Types.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/Types.hs
@@ -0,0 +1,26 @@
+module Graphics.LambdaCube.Types where
+
+import Foreign.C.Types
+
+type FloatType = Float
+--type FloatType = CFloat
+--type FloatType = Double
+--type FloatType = CDouble
+
+data Matrix4 = Matrix4
+ !FloatType !FloatType !FloatType !FloatType
+ !FloatType !FloatType !FloatType !FloatType
+ !FloatType !FloatType !FloatType !FloatType
+ !FloatType !FloatType !FloatType !FloatType
+ deriving (Read, Show, Eq)
+
+data Vec4 = Vec4 !FloatType !FloatType !FloatType !FloatType
+ deriving (Read, Show, Eq)
+
+
+type FloatType2 = (FloatType,FloatType)
+type FloatType3 = (FloatType,FloatType,FloatType)
+type FloatType4 = (FloatType,FloatType,FloatType,FloatType)
+
+type RGB = FloatType3
+type ColourValue = FloatType4
diff --git a/Graphics/LambdaCube/Utility.hs b/Graphics/LambdaCube/Utility.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/Utility.hs
@@ -0,0 +1,11 @@
+module Graphics.LambdaCube.Utility where
+
+import Data.List
+
+groupSetBy f l = foldl' g [] l
+ where
+ g el e = case partition ((f e) . head) el of
+ { ([],el') -> [e]:el'
+ ; ([gl],el') -> (e:gl):el'
+ ; _ -> error "Invalid case!"
+ }
diff --git a/Graphics/LambdaCube/VertexIndexData.hs b/Graphics/LambdaCube/VertexIndexData.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/VertexIndexData.hs
@@ -0,0 +1,239 @@
+module Graphics.LambdaCube.VertexIndexData where
+
+import Graphics.LambdaCube.HardwareVertexBuffer
+import Graphics.LambdaCube.HardwareIndexBuffer
+
+-- | Summary class collecting together vertex source information.
+data HardwareVertexBuffer vb => VertexData vb
+ = VertexData
+ {
+ {-| Declaration of the vertex to be used in this operation.
+ @remarks Note that this is created for you on construction.
+ -}
+ vdVertexDeclaration :: VertexDeclaration
+ {-| The vertex buffer bindings to be used.
+ @remarks Note that this is created for you on construction.
+ -}
+ , vdVertexBufferBinding :: VertexBufferBinding vb
+ ---- | Whether this class should delete the declaration and binding
+ --bool mDeleteDclBinding;
+ -- | The base vertex index to start from
+ , vdVertexStart :: Int
+ -- | The number of vertices used in this operation
+ , vdVertexCount :: Int
+ }
+ deriving Eq
+-- | Struct used to hold hardware morph / pose vertex data information
+--struct HardwareAnimationData
+--{
+-- const VertexElement* targetVertexElement;
+-- Real parametric;
+--};
+--typedef vector::type HardwareAnimationDataList;
+-- | VertexElements used for hardware morph / pose animation
+--HardwareAnimationDataList hwAnimationDataList;
+-- | Number of hardware animation data items used
+--size_t hwAnimDataItemsUsed;
+
+ {-| Clones this vertex data, potentially including replicating any vertex buffers.
+ @param copyData Whether to create new vertex buffers too or just reference the existing ones
+ @param mgr If supplied, the buffer manager through which copies should be made
+ @remarks The caller is expected to delete the returned pointer when ready
+ -}
+-- VertexData* clone(bool copyData = true, HardwareBufferManagerBase* mgr = 0) const;
+
+ {-| Modifies the vertex data to be suitable for use for rendering shadow geometry.
+ @remarks
+ Preparing vertex data to generate a shadow volume involves firstly ensuring that the
+ vertex buffer containing the positions is a standalone vertex buffer,
+ with no other components in it. This method will therefore break apart any existing
+ vertex buffers if position is sharing a vertex buffer.
+ Secondly, it will double the size of this vertex buffer so that there are 2 copies of
+ the position data for the mesh. The first half is used for the original, and the second
+ half is used for the 'extruded' version. The vertex count used to render will remain
+ the same though, so as not to add any overhead to regular rendering of the object.
+ Both copies of the position are required in one buffer because shadow volumes stretch
+ from the original mesh to the extruded version.
+ @par
+ It's important to appreciate that this method can fundamentally change the structure of your
+ vertex buffers, although in reality they will be new buffers. As it happens, if other
+ objects are using the original buffers then they will be unaffected because the reference
+ counting will keep them intact. However, if you have made any assumptions about the
+ structure of the vertex data in the buffers of this object, you may have to rethink them.
+ -}
+-- void prepareForShadowVolume(void);
+
+ {-| Additional shadow volume vertex buffer storage.
+ @remarks
+ This additional buffer is only used where we have prepared this VertexData for
+ use in shadow volume construction, and where the current render system supports
+ vertex programs. This buffer contains the 'w' vertex position component which will
+ be used by that program to differentiate between extruded and non-extruded vertices.
+ This 'w' component cannot be included in the original position buffer because
+ DirectX does not allow 4-component positions in the fixed-function pipeline, and the original
+ position buffer must still be usable for fixed-function rendering.
+ @par
+ Note that we don't store any vertex declaration or vertex buffer binding here because this
+ can be reused in the shadow algorithm.
+ -}
+-- HardwareVertexBufferSharedPtr hardwareShadowVolWBuffer;
+
+
+ {-| Reorganises the data in the vertex buffers according to the
+ new vertex declaration passed in. Note that new vertex buffers
+ are created and written to, so if the buffers being referenced
+ by this vertex data object are also used by others, then the
+ original buffers will not be damaged by this operation.
+ Once this operation has completed, the new declaration
+ passed in will overwrite the current one.
+ @param newDeclaration The vertex declaration which will be used
+ for the reorganised buffer state. Note that the new declaration
+ must not include any elements which do not already exist in the
+ current declaration; you can drop elements by
+ excluding them from the declaration if you wish, however.
+ @param bufferUsages Vector of usage flags which indicate the usage options
+ for each new vertex buffer created. The indexes of the entries must correspond
+ to the buffer binding values referenced in the declaration.
+ @param mgr Optional pointer to the manager to use to create new declarations
+ and buffers etc. If not supplied, the HardwareBufferManager singleton will be used
+ -}
+-- void reorganiseBuffers(VertexDeclaration* newDeclaration, const BufferUsageList& bufferUsage,
+-- HardwareBufferManagerBase* mgr = 0);
+
+ {-| Reorganises the data in the vertex buffers according to the
+ new vertex declaration passed in. Note that new vertex buffers
+ are created and written to, so if the buffers being referenced
+ by this vertex data object are also used by others, then the
+ original buffers will not be damaged by this operation.
+ Once this operation has completed, the new declaration
+ passed in will overwrite the current one.
+ This version of the method derives the buffer usages from the existing
+ buffers, by using the 'most flexible' usage from the equivalent sources.
+ @param newDeclaration The vertex declaration which will be used
+ for the reorganised buffer state. Note that the new delcaration
+ must not include any elements which do not already exist in the
+ current declaration; you can drop elements by
+ excluding them from the declaration if you wish, however.
+ @param mgr Optional pointer to the manager to use to create new declarations
+ and buffers etc. If not supplied, the HardwareBufferManager singleton will be used
+ -}
+-- void reorganiseBuffers(VertexDeclaration* newDeclaration, HardwareBufferManagerBase* mgr = 0);
+
+ {-| Remove any gaps in the vertex buffer bindings.
+ @remarks
+ This is useful if you've removed elements and buffers from this vertex
+ data and want to remove any gaps in the vertex buffer bindings. This
+ method is mainly useful when reorganising vertex data manually.
+ @note
+ This will cause binding index of the elements in the vertex declaration
+ to be altered to new binding index.
+ -}
+-- void closeGapsInBindings(void);
+
+ {-| Remove all vertex buffers that never used by the vertex declaration.
+ @remarks
+ This is useful if you've removed elements from the vertex declaration
+ and want to unreference buffers that never used any more. This method
+ is mainly useful when reorganising vertex data manually.
+ @note
+ This also remove any gaps in the vertex buffer bindings.
+ -}
+-- void removeUnusedBuffers(void);
+
+ {-| Convert all packed colour values (VET_COLOUR_*) in buffers used to
+ another type.
+ @param srcType The source colour type to assume if the ambiguous VET_COLOUR
+ is encountered.
+ @param destType The destination colour type, must be VET_COLOUR_ABGR or
+ VET_COLOUR_ARGB.
+ -}
+-- void convertPackedColour(VertexElementType srcType, VertexElementType destType);
+
+
+ {-| Allocate elements to serve a holder of morph / pose target data
+ for hardware morphing / pose blending.
+ @remarks
+ This method will allocate the given number of 3D texture coordinate
+ sets for use as a morph target or target pose offset (3D position).
+ These elements will be saved in hwAnimationDataList.
+ It will also assume that the source of these new elements will be new
+ buffers which are not bound at this time, so will start the sources to
+ 1 higher than the current highest binding source. The caller is
+ expected to bind these new buffers when appropriate. For morph animation
+ the original position buffer will be the 'from' keyframe data, whilst
+ for pose animation it will be the original vertex data.
+ -}
+-- void allocateHardwareAnimationElements(ushort count);
+
+
+
+
+-- | Summary class collecting together index data source information.
+data HardwareIndexBuffer ib => IndexData ib
+ = IndexData
+ { idIndexBuffer :: ib -- ^ pointer to the HardwareIndexBuffer to use, must be specified if useIndexes = true
+ , idIndexStart :: Int -- ^ index in the buffer to start from for this operation
+ , idIndexCount :: Int -- ^ The number of indexes to use from the buffer
+ }
+ deriving Eq
+
+ {-| Clones this index data, potentially including replicating the index buffer.
+ @param copyData Whether to create new buffers too or just reference the existing ones
+ @param mgr If supplied, the buffer manager through which copies should be made
+ @remarks The caller is expected to delete the returned pointer when finished
+ -}
+-- IndexData* clone(bool copyData = true, HardwareBufferManagerBase* mgr = 0) const;
+
+ {-| Re-order the indexes in this index data structure to be more
+ vertex cache friendly; that is to re-use the same vertices as close
+ together as possible.
+ @remarks
+ Can only be used for index data which consists of triangle lists.
+ It would in fact be pointless to use it on triangle strips or fans
+ in any case.
+ -}
+-- void optimiseVertexCacheTriList(void);
+
+
+{-| Vertex cache profiler.
+@remarks
+ Utility class for evaluating the effectiveness of the use of the vertex
+ cache by a given index buffer.
+-}
+{-
+class _OgreExport VertexCacheProfiler : public BufferAlloc
+{
+ public:
+ enum CacheType {
+ FIFO, LRU
+ };
+
+ VertexCacheProfiler(unsigned int cachesize = 16, CacheType cachetype = FIFO )
+ : size ( cachesize ), type ( cachetype ), tail (0), buffersize (0), hit (0), miss (0)
+ {
+ cache = OGRE_ALLOC_T(uint32, size, MEMCATEGORY_GEOMETRY);
+ };
+
+ ~VertexCacheProfiler()
+ {
+ OGRE_FREE(cache, MEMCATEGORY_GEOMETRY);
+ }
+
+ void profile(const HardwareIndexBufferSharedPtr& indexBuffer);
+ void reset() { hit = 0; miss = 0; tail = 0; buffersize = 0; };
+ void flush() { tail = 0; buffersize = 0; };
+
+ unsigned int getHits() { return hit; };
+ unsigned int getMisses() { return miss; };
+ unsigned int getSize() { return size; };
+ private:
+ unsigned int size;
+ uint32 *cache;
+ CacheType type;
+
+ unsigned int tail, buffersize;
+ unsigned int hit, miss;
+
+ bool inCache(unsigned int index);
+};
+-}
diff --git a/Graphics/LambdaCube/World.hs b/Graphics/LambdaCube/World.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/LambdaCube/World.hs
@@ -0,0 +1,904 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Graphics.LambdaCube.World where
+
+import Data.Maybe
+import qualified Data.List as List
+import Data.Map (Map,(!))
+import qualified Data.Map as Map
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Control.Applicative
+import Control.Monad
+import System.Directory
+import System.FilePath
+
+import System.Log.Logger
+import Data.Graph.Inductive
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString as SB
+import qualified Data.ByteString.Internal as SB
+import Codec.Archive.Zip
+
+import Graphics.LambdaCube.Common
+import Graphics.LambdaCube.Loader.ResourceScript
+import Graphics.LambdaCube.Loader.MeshXML
+import Graphics.LambdaCube.Compositor
+import Graphics.LambdaCube.Material
+import Graphics.LambdaCube.Pass
+import Graphics.LambdaCube.Technique
+import Graphics.LambdaCube.TextureUnitState
+import Graphics.LambdaCube.PixelFormat
+import Graphics.LambdaCube.Math
+import Graphics.LambdaCube.Light
+import Graphics.LambdaCube.Image
+import Graphics.LambdaCube.Entity
+import Graphics.LambdaCube.Mesh
+import Graphics.LambdaCube.Types
+import Graphics.LambdaCube.Texture
+import Graphics.LambdaCube.GpuProgram
+import Graphics.LambdaCube.GpuProgramUsage
+import Graphics.LambdaCube.RenderQueue
+import Graphics.LambdaCube.RenderSystem
+import Graphics.LambdaCube.HardwareBuffer
+import Graphics.LambdaCube.HardwareVertexBuffer
+import Graphics.LambdaCube.HardwareIndexBuffer
+--import Graphics.LambdaCube.Resource
+import Graphics.LambdaCube.RenderOperation
+
+
+-- * World
+
+data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => FlattenScene vb ib t lp
+ = FlattenScene
+ { fsRenderable :: [(Matrix4,[RenderEntity vb ib t lp],Int,Int)] -- ^ List of Renderable information including WorldMatrix RenderQueueID and RenderPriority
+ , fsCamera :: [(Matrix4,Camera)]
+ , fsLight :: [(Matrix4,Light)]
+ }
+
+data RenderSystem r vb ib q t p lp => World r vb ib q t p lp
+ = World
+ { wrResource :: ResourceLibrary vb ib t p lp -- IO related
+ , wrRenderSystem :: r -- IO related
+ , wrScene :: Scene vb ib t lp
+ , wrTargets :: Map String (RenderTarget t lp)
+ , wrRenderOptions :: IntMap RenderGroupOptions
+ , wrImageLoaders :: [ImageLoader]
+ }
+
+mapResource f w = w { wrResource = f (wrResource w) }
+mapScene f w = w { wrScene = f (wrScene w) }
+mapTargets f w = w { wrTargets = f (wrTargets w) }
+
+mkWorld :: RenderSystem r vb ib q t p lp => r -> [ImageLoader] -> IO (World r vb ib q t p lp)
+mkWorld rs imgLoaders = return World
+ { wrResource = mkResource
+ , wrRenderSystem = rs
+ , wrScene = mkScene
+ , wrTargets = Map.empty
+ , wrRenderOptions = IntMap.empty
+ , wrImageLoaders = imgLoaders
+ }
+
+mkResource :: (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, GpuProgram p, LinkedGpuProgram lp) => ResourceLibrary vb ib t p lp
+mkResource = ResourceLibrary [] Map.empty Map.empty Map.empty Map.empty Map.empty Map.empty
+
+mkScene :: (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => Scene vb ib t lp
+--mkScene = Scene (mkUGraph [0] []) (IntMap.fromList [(0, SceneNode "Root" [] (transl 0 0 0))]) (Map.fromList [("Root",0)]) Nothing
+-- TODO: update for new scene structure
+mkScene = Scene
+ { scGraph = mkGraph [(0,"Root")] []
+ -- use: bytestring-trie (efficient ByteString map)
+ , scMap = Map.fromList [("Root", (0,SceneNode "Root" [] (transl 0 0 0)))]
+ , scSky = Nothing
+ }
+
+-- * Resource
+
+data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, GpuProgram p, LinkedGpuProgram lp) => ResourceLibrary vb ib t p lp
+ = ResourceLibrary
+ { rlResourceGroups :: [ResourceGroup]
+ , rlMeshMap :: Map String (Mesh vb ib)
+ , rlMaterialMap :: Map String (Material t lp)
+ , rlTextureMap :: Map String t
+ , rlGpuProgramMap :: Map String (GpuProgramDescriptor p)
+ , rlLinkedGpuProgramMap :: Map (String,String,String) lp
+ , rlCompositorMap :: Map String (Compositor t lp)
+ }
+
+-- * SceneGraph
+
+data Camera
+ = Camera
+ { cmName :: String
+ , cmFov :: FloatType
+ , cmNear :: FloatType
+ , cmFar :: FloatType
+ , cmAspectRatio :: Maybe FloatType
+ , cmPolygonMode :: PolygonMode -- ^ Rendering type
+ }
+{-
+ name CDATA #IMPLIED
+ id ID #IMPLIED
+ FOVy CDATA "45"
+ aspectRatio CDATA "1.3333333"
+ projectionType (perspective | orthographic) "perspective"
+ polygonMode (points | wireframe | solid) "solid"
+ useRenderingDistance (yes | no) "yes"
+ lodBiasFactor CDATA "1.0"
+-}
+cameraProjectionMatrix :: FloatType -> Camera -> Matrix4
+cameraProjectionMatrix a cam = perpectiveMatrix fov aspect near far
+ where
+ Camera
+ { cmFov = fov
+ , cmNear = near
+ , cmFar = far
+ , cmAspectRatio = aspectr
+ } = cam
+ aspect = fromMaybe a aspectr
+
+data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => SceneObject vb ib t lp
+ = SO_Entity (Entity vb ib t lp)
+ | SO_Camera Camera
+ | SO_Light Light
+-- | SO_ParticleSystem ParticleSystem
+
+--data RenderTarget
+-- = RT_MainBuffer
+-- | RT_FrameBuffer
+
+{-
+data RenderWindow = RenderWindow
+ { rwWidth :: Int
+ , rwHeight :: Int
+ , rwViewport :: [Viewport]
+ --, rtTarget -- texture or screen
+ }
+-}
+
+data (Texture t, LinkedGpuProgram lp) => RenderTarget t lp
+ = RenderTarget
+ { rtName :: String
+ , rtWidth :: Int
+ , rtHeight :: Int
+ , rtViewport :: [Viewport t lp]
+ , rtTexture :: Maybe String
+ }
+
+data (Texture t, LinkedGpuProgram lp) => Viewport t lp
+ = Viewport
+ { vpLeft :: FloatType
+ , vpTop :: FloatType
+ , vpWidth :: FloatType
+ , vpHeight :: FloatType
+ , vpCamera :: String --Camera
+ , vpCompositors :: [Compositor t lp]
+ , vpBackColour :: ColourValue
+ , vpClearEveryFrame :: Bool
+ , vpClearBuffers :: FrameBufferType
+ }
+
+--getViewportSize :: RenderTarget -> Viewport -> (Int,Int,Int,Int)
+getViewportSize t v = (x,y,w,h)
+ where
+ ww = fromIntegral $ rtWidth t
+ wh = fromIntegral $ rtHeight t
+ x = floor $ ww * (vpLeft v)
+ y = floor $ wh * (vpTop v)
+ w = floor $ ww * (vpWidth v)
+ h = floor $ wh * (vpHeight v)
+
+data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => SceneNode vb ib t lp
+ = SceneNode
+ { snName :: String
+ , snObject :: [SceneObject vb ib t lp]
+ , snTransform :: Matrix4
+ }-- deriving (Show,Read)
+
+data Sky
+ = SkyBox --Material
+ | SkyDome
+ | SkyPlane
+
+{-
+data Scene = Scene
+ { scGraph :: Gr () ()
+-- , scMap :: Map Int SceneNode
+ , scMap :: IntMap SceneNode
+ , scNameMap :: Map String Int
+ , scSky :: Maybe Sky
+ -- Fog settings
+ }
+-}
+
+data (HardwareVertexBuffer vb, HardwareIndexBuffer ib, Texture t, LinkedGpuProgram lp) => Scene vb ib t lp
+ = Scene
+ { scGraph :: Gr String ()
+ -- use: bytestring-trie (efficient ByteString map)
+ , scMap :: Map String (Int,SceneNode vb ib t lp) -- ^ Contains GraphNodeID and SceneNode.
+ , scSky :: Maybe Sky
+ -- Fog settings
+ }
+
+getMesh name world = case Map.lookup name (rlMeshMap rl) of
+ Nothing -> do
+ f <- loadFile (rlResourceGroups rl) name
+ when (isNothing f) $ error $ "File not found: " ++ name
+ m <- case takeExtension name of
+ ".xml" -> do
+ debugM "ResourceLibrary" $ "parsing mesh XML file " ++ name
+ parseMesh rs $ map SB.w2c $ B.unpack $ fromMaybe (error "fromJust 9") f
+ _ -> error ("Unsupported format!")
+ return (m,world { wrResource = rl { rlMeshMap = Map.insert name m (rlMeshMap rl) } })
+ Just m -> return (m,world)
+ where
+ rl = wrResource world
+ rs = wrRenderSystem world
+
+--loadMaterialResources :: ResourceLibrary -> Material -> IO (ResourceLibrary,Material)
+loadMaterialResources rs loaders reslib0 mat = case isJust $ mtSupportedTechniques mat of
+ { True -> return (reslib0,mat) -- Material is already initialized
+ ; False -> do
+ let isSupportedTech _ = True -- TODO
+ loadImage name = do
+ d <- loadFile (rlResourceGroups reslib0) name
+ case d of
+ { Just imgdata -> do
+ let loadImg img loader = case img of
+ { Just _ -> return img
+ ; Nothing -> loader name imgdata
+ }
+ foldM loadImg Nothing loaders
+ ; Nothing -> do
+ debugM "Load image" $ "File not found: " ++ name
+ return Nothing
+ }
+ loadTextureUnit (rl0,tl) t = do
+ let loadTexture (rl0',tl') texname = case Map.lookup texname $ rlTextureMap rl0' of
+ { Just t -> return (rl0',t:tl') -- texture is loaded
+ ; Nothing -> do -- we have to create it
+ -- TODO: create and load texture via render system
+ i <- loadImage texname
+ case i of
+ { Just img -> do
+ {-
+ virtual TexturePtr createManual(const String & name, const String& group,
+ TextureType texType, uint width, uint height, uint depth,
+ int num_mips, PixelFormat format, int usage = TU_DEFAULT, ManualResourceLoader* loader = 0,
+ bool hwGammaCorrection = false, uint fsaa = 0, const String& fsaaHint = StringUtil::BLANK);
+
+ { imName :: String
+ , imHeight :: Int
+ , imWidth :: Int
+ , imDepth :: Int
+ , imSize :: Int
+ , imNumMipmaps :: Int
+-- uint flags;
+ , imFormat :: PixelFormat
+ , imData :: (Ptr Word8) -- ^ Image can be empty
+ }
+ mkGLTexture :: String -> TextureType -> Int -> Int -> Int -> Int -> PixelFormat -> TextureUsage -> Bool -> Int -> String -> IO GLTexture
+ mkGLTexture name texType width height depth numMips format usage hwGammaCorrection fsaa fsaaHint = do
+ -}
+ --createTexture :: a -> String -> TextureType -> Int -> Int -> Int -> Int -> PixelFormat -> TextueUsage -> Bool -> Int -> String -> IO t
+ let usage = TextureUsage HBU_STATIC True False
+ t <- createTexture rs texname (tusTextureType t) (imWidth img) (imHeight img) (imDepth img)
+ (tusTextureSrcMipmaps t) (tusDesiredFormat t) usage (tusHwGamma t) 0 "" $ Just [img]
+ -- TODO
+ --let t = undefined
+ let texmap = rlTextureMap rl0'
+ return (rl0' { rlTextureMap = Map.insert texname t texmap },t:tl')
+ ; Nothing -> do
+ debugM "Load texture" $ "No proper image codec was found: " ++ texname
+ return (rl0',tl')
+ }
+ }
+ let loadCubicTexture rl0' texname = case Map.lookup (concat texname) $ rlTextureMap rl0' of
+ { Just t -> return (rl0',[t]) -- texture is loaded
+ ; Nothing -> do -- we have to create it
+ -- TODO: create and load texture via render system
+ i <- mapM loadImage texname
+ case all isJust i of
+ { True -> do
+ let usage = TextureUsage HBU_STATIC True False
+ img = fromJust $ head i
+ t <- createTexture rs (concat texname) (tusTextureType t) (imWidth img) (imHeight img) (imDepth img)
+ (tusTextureSrcMipmaps t) (tusDesiredFormat t) usage (tusHwGamma t) 0 "" $ Just $ map fromJust i
+ let texmap = rlTextureMap rl0'
+ return (rl0' { rlTextureMap = Map.insert (concat texname) t texmap },[t])
+ ; False -> do
+ debugM "Load texture" $ "No proper image codec was found: " ++ concat texname
+ return (rl0',[])
+ }
+ }
+ -- load textures
+ -- TODO: load all frames
+ (rl1,tex) <- case tusTextureType t of
+ { TEX_TYPE_CUBE_MAP -> loadCubicTexture rl0 $ tusFrameNames t
+ ; _ -> foldM loadTexture (rl0,[]) $ tusFrameNames t
+ }
+ let frames = reverse tex -- TODO: wrong in cubemap case
+ return (rl1,(t { tusFrames = Just frames }):tl)
+ loadShader (rl0,sl) sn = case Map.lookup sn $ rlGpuProgramMap rl0 of
+ { Nothing -> do
+ errorM "loadShader" $ "Unknown GpuProgram: " ++ sn
+ return (rl0,sl)
+ ; Just gpd -> case gpdGpuProgram gpd of
+ { Just p -> return (rl0,p:sl)
+ ; Nothing -> do
+ -- GpuProgram is not loaded yet
+ let fname = gpdFilename gpd
+ msource <- loadFile (rlResourceGroups rl0) fname
+ case msource of
+ { Nothing -> do
+ errorM "loadShader" $ "GpuProgram source not found: " ++ sn ++ " - " ++ fname
+ return (rl0,sl)
+ ; Just src -> do
+ eprog <- createGpuProgram rs (gpdType gpd) $ map SB.w2c $ B.unpack src
+ case eprog of
+ { Right err -> do
+ errorM "loadShader" $ "Error compile " ++ sn ++ ": " ++ err
+ return (rl0,sl)
+ ; Left prog -> do
+ debugM "loadShader" $ "GpuProgram loaded: " ++ sn
+ let gpd' = gpd { gpdGpuProgram = Just prog }
+ gpmap = Map.insert sn gpd' $ rlGpuProgramMap rl0
+ return (rl0 { rlGpuProgramMap = gpmap }, prog:sl)
+ }
+ }
+ }
+ }
+ loadPass (rl0,pl) p = do
+ -- load GpuPrograms
+ (rl1,mlgp) <- case psLinkedGpuProgram p of
+ { Just lgp -> return (rl0,Just lgp)
+ ; Nothing -> do
+ let getName Nothing = ""
+ getName (Just u) = gpuProgramName u
+ progName = (getName $ psVertexProgramUsage p, getName $ psFragmentProgramUsage p, getName $ psGeometryProgramUsage p)
+ (vpn,fpn,gpn) = progName
+ gpuprogmap = rlGpuProgramMap rl0
+ collectNames cl [] = return cl
+ collectNames cl nl = do
+ -- check list nl
+ let a = filter (`notElem` cl) nl
+ getAttach m = case Map.lookup m gpuprogmap of
+ { Nothing -> do
+ errorM "loadShader" $ "Unknown attached GpuProgram: " ++ m
+ return []
+ ; Just gp -> return $ gpdAttach gp
+ }
+ b <- mapM getAttach a
+ collectNames (cl ++ a) $ concat b
+ -- collect required shaders name list
+ progNames <- collectNames [] $ filter (/="") [vpn,fpn,gpn]
+ case null progNames of
+ { True -> return (rl0,Nothing)
+ ; False -> do
+ -- load all shader
+ (rl1,progs) <- foldM loadShader (rl0,[]) progNames
+ case Map.lookup progName $ rlLinkedGpuProgramMap rl1 of
+ { Just lp -> return (rl1,Just lp)
+ ; Nothing -> do
+ -- create LinkedGpuProgram
+ elprog <- createLinkedGpuProgram rs progs
+ case elprog of
+ { Right err -> do
+ errorM "loadGpuProgram" $ "Error link " ++ (show progName) ++ ": " ++ err
+ return (rl1,Nothing)
+ ; Left lprog -> do
+ debugM "loadGpuProgram" $ "GpuProgram linked: " ++ (show progName)
+ let lprogmap = rlLinkedGpuProgramMap rl1
+ lprogmap' = Map.insert progName lprog lprogmap
+ return (rl1 { rlLinkedGpuProgramMap = lprogmap' },Just lprog)
+ }
+ }
+ }
+ }
+ -- load textureunitstates (Texture)
+ (rl2,texUnits) <- foldM loadTextureUnit (rl1,[]) $ psTextureUnitStates p
+ return (rl2,(p { psTextureUnitStates = reverse texUnits, psLinkedGpuProgram = mlgp }):pl)
+ loadTechnique (rl0,tl) t = do
+ -- load passes (GpuProgram)
+ (rl1,passes) <- foldM loadPass (rl0,[]) $ tchPasses t
+ return (rl1,(t { tchPasses = reverse passes }):tl)
+ -- select and load supported techniques
+ (reslib1,suppTech) <- foldM loadTechnique (reslib0,[]) $ filter isSupportedTech $ mtTechniques mat
+ -- Insert loaded material into MaterialMap
+ let matmap = rlMaterialMap reslib1
+ mat' = mat { mtSupportedTechniques = Just $ reverse suppTech }
+ reslib2 = reslib1 { rlMaterialMap = Map.insert (mtName mat') mat' matmap }
+ return (reslib2,mat')
+ }
+
+--getLoadedMaterial :: String -> World -> IO (World,Maybe Material)
+--NOTE: this should return with Nothing if there's no supported technique
+getLoadedMaterial matname world0 = case Map.lookup matname $ rlMaterialMap $ wrResource world0 of
+ { Nothing -> do
+ errorM "loadMaterial" $ "Material not found: " ++ matname
+ return (world0,Nothing)
+ ; Just mat0 -> case isJust $ mtSupportedTechniques mat0 of
+ { True -> return (world0,Just mat0)
+ ; False -> do
+ let rs = wrRenderSystem world0
+ loaders = wrImageLoaders world0
+ rl0 = wrResource world0
+ (rl1,mat1) <- loadMaterialResources rs loaders rl0 mat0
+ --TODO: this should return with Nothing if there's no supported technique
+ return (world0 { wrResource = rl1 },Just mat1)
+ }
+ }
+
+--setEntityMaterial :: World -> [String] -> Entity -> IO (World,Entity)
+setEntityMaterial world0 mats ent = do
+ let reslib1 = wrResource world0
+ rs = wrRenderSystem world0
+ loaders = wrImageLoaders world0
+ setSubEntMat (rl1,ses) (sent,matname) = do
+ let matmap = (rlMaterialMap rl1)
+ (rl2,mat) <- case Map.lookup matname matmap of
+ { Just m -> do
+ loadMaterialResources rs loaders rl1 m
+ ; Nothing -> do
+ error $ "Material not found: " ++ matname
+ }
+ return (rl2,sent { seMaterial = mat } : ses)
+
+ (reslib2,subents) <- foldM setSubEntMat (reslib1,[]) $ zip (enSubEntityList ent) mats
+ return (world0 { wrResource = reslib2 },ent { enSubEntityList = reverse subents })
+
+--createEntity :: World -> String -> String -> IO (World,Entity)
+createEntity world0 ename mname = do
+ -- lookup mesh, load if not exists
+ --debugM "ResourceLibrary" $ "creating entity: \"" ++ ename ++ "\" from mesh: \"" ++ mname ++ "\""
+ (mesh,world1) <- getMesh mname world0
+ --debugM "ResourceLibrary" " done"
+
+ let reslib1 = wrResource world1
+ rs = wrRenderSystem world1
+ loaders = wrImageLoaders world1
+ mkSubent (rl1,ses) smesh = do
+ let matname = (smMaterialName smesh)
+ matmap = (rlMaterialMap rl1)
+ (rl2,mat) <- case Map.lookup matname matmap of
+ { Just m -> do
+ loadMaterialResources rs loaders rl1 m
+ ; Nothing -> do
+ --debugM "createEntity" $ "Material not found: " ++ matname
+ -- TODO
+ error $ "Material not found: " ++ matname
+ --loadMaterialResources rs loaders rl1 (matmap ! "WarningMaterial")
+ }
+ return (rl2,SubEntity { seMaterial = mat, seSubMesh = smesh } : ses)
+
+ (reslib2,subents) <- foldM mkSubent (reslib1,[]) (msSubMeshList mesh)
+
+ let ent = Entity
+ { enName = ename
+ , enRenderQueue = constRenderQueueMain
+ , enMesh = mesh
+ , enSubEntityList = reverse subents
+ }
+
+ return (world1 { wrResource = reslib2 },ent)
+
+--loadFile :: [ResourceGroup] -> String -> Maybe ByteString
+loadFile respath fname = foldM (\s (_,l)->foldM load s l) Nothing respath
+ where
+ load s@(Just str) _ = return s
+ load s (PathZip,n) = do
+ -- TODO: this is a naive implementation with poor perfomance
+ f <- B.readFile n
+ let a = toArchive f
+ return $ fmap fromEntry $ findEntryByPath fname a
+ load Nothing (PathDir,n) = do
+ let ffname = (addTrailingPathSeparator n) ++ fname
+ e <- doesFileExist ffname
+ ret <- if e then B.readFile ffname else return B.empty
+ return $ if e then Just ret else Nothing
+
+renderWorld time name flatScene world = do
+ -- TODO
+ -- collect all render textures
+ -- render the world on all render textures
+ -- render the world last to the given named target
+
+ -- forall viewports:
+ -- setup viewport related matrices
+ -- render scene
+ case Map.lookup name targetMap of
+ { Nothing -> do
+ debugM "renderWold" $ "RenderTarget not found: " ++ name
+ return world
+ ; Just t -> do
+ let targets = Map.elems targetMap
+ (tg,tgs) = List.partition ((== name) . rtName) targets
+ (rtl,rwl) = List.partition (isNothing . rtTexture) tgs
+ mapM_ renderTarget $ rtl ++ rwl ++ tg
+ return world
+ }
+ where
+ targetMap = wrTargets world
+ rs = wrRenderSystem world
+
+ renderTarget rt = do
+ -- TODO: calc render statistics
+ let t = rtTexture rt
+ -- call setRenderTarget rs
+ mapM_ (renderViewport flatScene rt) $ rtViewport rt
+ --if isNothing t then return () else do
+ --let tex = txObject $ (rlTextureMap $ wrResource world) ! (fromMaybe (error "fromJust 0") t)
+ --GL.textureBinding GL.Texture2D $= Just tex
+ -- only hint code: glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_LUMINANCE, 0, 0, 128, 128, 0);
+ --GL.copyTexImage2D Nothing 0 GL.RGBA' (GL.Position 0 0) (GL.TextureSize2D w' h') 0
+ --return ()
+
+ renderViewport fs rtarget v = do
+ let (vx,vy,vw,vh) = getViewportSize rtarget v
+ setViewport rs vx vy vw vh
+
+ -- Clear the viewport if required
+ when (vpClearEveryFrame v) $
+ clearFrameBuffer rs (vpClearBuffers v) (vpBackColour v) 1 0
+
+ -- Begin the frame
+ --mDestRenderSystem->_beginFrame();
+
+ -- Set rasterisation mode
+ setPolygonMode rs $ cmPolygonMode cam
+
+ -- Set initial camera state
+ setProjectionMatrix rs $ cameraProjectionMatrix (fromIntegral vw / fromIntegral vh) cam
+
+ --mDestRenderSystem->_setTextureProjectionRelativeTo(mCameraRelativeRendering, camera->getDerivedPosition());
+ --setTextureProjectionRelativeTo
+
+ setViewMatrix rs cameraViewMatrix
+
+ -- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ -- TODO: activate compositor chain render target if necessary
+ -- (re)initialize compositor resources if necessary
+ -- foreach compositor
+ -- select technique
+ -- create render textures
+ -- initialize target passes
+ -- do render
+ -- foreach compositor and target pass
+ -- bind target pass
+ -- execute each composition pass in target pass
+ --HINT:
+ --
+
+ -- FIXME: TEMP CODE
+ unless (null $ vpCompositors v) $ do
+ -- bind render texture
+ return ()
+
+ -- render objects
+ rstat <- renderQueue time rs (wrRenderOptions world) emptyRenderStatistics $ fsRenderable fs
+-- print rstat
+
+ -- Compositor
+ -- TargetPass
+ -- Pass
+ forM_ (vpCompositors v) $ \c -> do
+ let ct = head $ fromMaybe (error "fromJust 112") $ cmpSupportedTechniques c
+ -- select first technique
+ forM (zip [0..] $ ctTargetPasses ct ++ [ctOutputTarget ct]) $ \(ctpidx,ctp) -> do
+ -- -- copy previous output to target's output when input is previous
+ when (ctpInputMode ctp == IM_PREVIOUS) $ do
+ -- FIXME
+ dirtyHackCopyTexImage rs (fromMaybe (error "fromJust 212") $ tdTexture $ fromJust $ ctpOutput ctp) vx vy vw vh
+ forM (ctpPasses ctp) $ \cp -> do
+ -- do composition pass action
+ case cpType cp of
+ { PT_RENDERQUAD -> do
+ -- TODO
+ -- setup quad material
+ -- render quad
+ let quadM = fromMaybe (error "fromJust 312") $ Map.lookup "Quad.mesh.xml" (rlMeshMap $ wrResource world)
+ quadSM = head $ msSubMeshList quadM
+ quadSE = SubEntity { seMaterial = fromMaybe (error "fromJust 412") $ cpMaterial cp, seSubMesh = quadSM }
+ quadE = Entity "" constRenderQueueMain quadM [quadSE]
+ quadRE = head $ prepare (transl 0 0 0) quadE
+ quadRP = [RenderablePass (reOperation quadRE) p (transl 0 0 0) [] | p <- rePassList quadRE]
+ setProjectionMatrix rs $ transl 0 0 0
+ setViewMatrix rs $ transl 0 0 0
+ setPolygonMode rs PM_SOLID
+ renderPassGroup time rs emptyRenderStatistics quadRP
+ return ()
+ ; _ -> return ()
+ }
+{-
+ unless (null $ vpCompositors v) $ do
+ -- FIXME: TEMP CODE
+ -- unbind render texture, and we'll have the rendered scene in a texture
+ -- create a custom temp pass with temp render texture input
+ -- create quad render operation
+ let quadSM = head $ msSubMeshList $ fromJust $ Map.lookup "Quad.mesh.xml" (rlMeshMap $ wrResource world)
+ quadRO = RenderOperation
+ { roVertexData = fromJust $ smVertexData quadSM
+ , roOperationType = smOperationType quadSM
+ , roIndexData = smIndexData quadSM
+ }
+ quadP = head $ tchPasses $ head $ fromJust $ mtSupportedTechniques $ fromJust $ Map.lookup "QuadMaterial" (rlMaterialMap $ wrResource world)
+ quadRP = RenderablePass
+ { rpOperation = quadRO
+ , rpPass = quadP'
+ , rpMatrix = transl 0 0 0
+ , rpLights = []
+ }
+ rtex = fromJust $ Map.lookup "RenderTex01" $ (rlTextureMap $ wrResource world)
+ tus = psTextureUnitStates quadP
+ tu = head tus
+ tut = tail tus
+ tu' = tu { tusFrames = Just [rtex] }
+ quadP' = quadP { psTextureUnitStates = (tu':tut) }
+ --setProjectionMatrix rs $ cameraProjectionMatrix (fromIntegral vw / fromIntegral vh) cam
+ setProjectionMatrix rs $ transl 0 0 0
+ setViewMatrix rs $ transl 0 0 0
+ dirtyHackCopyTexImage rs rtex vx vy vw vh
+ setPolygonMode rs PM_SOLID
+ renderPassGroup rs [quadRP]
+ -- invert back
+ --dirtyHackCopyTexImage rs rtex vx vy vw vh
+-} --renderPassGroup rs [quadRP]
+ return ()
+
+{-
+ = RenderOperation
+ { roVertexData :: VertexData vb -- ^ Vertex source data
+ , roOperationType :: OperationType -- ^ The type of operation to perform
+ , roIndexData :: Maybe (IndexData ib) -- ^ Index data - only valid if useIndexes is true
+ }
+ = RenderablePass
+ { rpOperation :: RenderOperation vb ib
+ , rpPass :: Pass t lp
+ , rpMatrix :: Matrix4
+ , rpLights :: [(Matrix4,Light)]
+ }
+--renderPassGroup :: RenderSystem -> RenderablePass -> IO ()
+-}
+ -- do a manual render for temp pass (we should reset world, view, projection and texture matrix)
+
+
+---------------------------------------------------------------------
+ -- push flatten scene into a render queue
+ -- collect lights which affect each renderable
+ -- fold addRenderable
+ -- call renderQueue
+ --let addRend (m,rend,grpID,prior) rq = addRenderable m rend (map snd $ fsLight fs) grpID prior rq
+ --renderQueue' rs $ foldr addRend emptyRenderQueue $ fsRenderable fs
+ -- old code below-------------------------------------------------------------------------------------------
+ --mapM_ (renderEntity (wrRenderSystem world)) $ optimize $ foldr (\(m,r) l -> (prepare m r) ++ l) [] [(a,b) | (a,b,_,_) <- fsRenderable fs]
+ where
+ (camMat,cam) = head $ Prelude.filter (\(_,a) -> camName == (cmName a)) cams
+ camName = vpCamera v
+ cams = fsCamera fs
+ (Matrix4
+ r11 r12 r13 _
+ r21 r22 r23 _
+ r31 r32 r33 _
+ tx ty tz _) = camMat
+ {-
+ cameraViewMatrix = (Matrix4
+ r11 r21 r31 0
+ r12 r22 r32 0
+ r13 r23 r33 0
+ (-tx) (-ty) (-tz) 1)
+ -}
+ cameraViewMatrix = camMat
+
+-- createTexture :: a -> String -> TextureType -> Int -> Int -> Int -> TextureMipmap -> PixelFormat -> TextureUsage -> Bool -> Int -> String -> Image -> IO t
+addRenderTexture n w h world = do
+ let rl = wrResource world
+ tm = rlTextureMap rl
+ rs = wrRenderSystem world
+ t <- createTexture rs n TEX_TYPE_2D w h 1 (MIP_NUMBER 1) PF_R8G8B8A8 (TextureUsage HBU_STATIC True False) False 0 "" Nothing
+ return world { wrResource = rl { rlTextureMap = Map.insert n t tm } }
+ --mapResource f w = w { wrResource = f (wrResource w) }
+
+--addRenderWindow :: String -> Int -> Int -> [Viewport] -> World -> IO World
+addRenderWindow n w h l world = do
+ vl <- mapM (\f -> f world) l
+ let rt = RenderTarget
+ { rtName = n
+ , rtWidth = w
+ , rtHeight = h
+ , rtViewport = vl
+ , rtTexture = Nothing
+ }
+ return $ mapTargets (Map.insert n rt) world
+
+ {-
+ = Compositor
+ { cmpName :: String
+ , cmpTechniques :: [CompositionTechnique t]
+ , cmpSupportedTechniques :: Maybe [CompositionTechnique t]
+ }
+
+ = CompositionTechnique
+ { ctTextureDefinitions :: [TextureDefinition t]
+ , ctTargetPasses :: [CompositionTargetPass] -- ^ Intermediate target passes
+ , ctOutputTarget :: CompositionTargetPass -- ^ Output target pass (can be only one)
+ , ctSchemeName :: String -- ^ Optional scheme name
+ }
+
+ = TextureDefinition
+ { tdName :: String
+ , tdWidth :: Maybe Int -- Nothing means adapt to target width
+ , tdHeight :: Maybe Int -- Nothing means adapt to target height
+ , tdWidthFactor :: FloatType -- multiple of target width to use (if width = Nothing)
+ , tdHeightFactor :: FloatType -- multiple of target height to use (if height = Nothing)
+ , tdFormatList :: [PixelFormat] -- more than one means MRT
+ , tdFsaa :: Bool -- FSAA enabled; true = determine from main target (if render_scene), false = disable
+ , tdHwGammaWrite :: Bool -- Do sRGB gamma correction on write (only 8-bit per channel formats)
+ , tdShared :: Bool -- whether to use shared textures for this one
+ , tdTexture :: Maybe t
+ }
+
+ = CompositionTargetPass
+ { ctpInputMode :: InputMode -- ^ Input name
+ , ctpOutputName :: String -- ^ (local) output texture
+ , ctpOutput :: Maybe (TextureDefinition t)
+ , ctpPasses :: [CompositionPass] -- ^ Passes
+ , ctpOnlyInitial :: Bool -- ^ This target pass is only executed initially after the effect has been enabled.
+ , ctpVisibilityMask :: Word32 -- ^ Visibility mask for this render
+ , ctpLodBias :: FloatType -- ^ LOD bias of this render
+ , ctpMaterialScheme :: String -- ^ Material scheme name
+ , ctpShadowsEnabled :: Bool -- ^ Shadows option
+ }
+
+ = InputTex
+ { itName :: String -- ^ Name (local) of the input texture
+ , itMrtIndex :: Int -- ^ MRT surface index if applicable
+ }
+
+ = CompositionPass
+ { cpType :: PassType -- ^ Type of composition pass
+ , cpIdentifier :: Word32 -- ^ Identifier for this pass
+ , cpMaterialName :: String -- ^ Material used for rendering
+ , cpMaterial :: Maybe (Material t lp)
+ , cpFirstRenderQueue :: Int -- ^ [first,last] render queue to render this pass (in case of PT_RENDERSCENE)
+ , cpLastRenderQueue :: Int
+ , cpClearBuffers :: (Bool,Bool,Bool) -- ^ Clear buffers (in case of PT_CLEAR), hint: [colour] [depth] [stencil]
+ , cpClearColour :: ColourValue -- ^ Clear colour (in case of PT_CLEAR)
+ , cpClearDepth :: FloatType -- ^ Clear depth (in case of PT_CLEAR)
+ , cpClearStencil :: Word32 -- ^ Clear stencil value (in case of PT_CLEAR)
+ , cpInputs :: IntMap InputTex -- ^ Inputs (for material used for rendering the quad)
+ , cpStencilCheck :: Bool -- ^ Stencil operation parameters
+ , cpStencilFunc :: CompareFunction
+ , cpStencilRefValue :: Word32
+ , cpStencilMask :: Word32
+ , cpStencilFailOp :: StencilOperation
+ , cpStencilDepthFailOp :: StencilOperation
+ , cpStencilPassOp :: StencilOperation
+ , cpStencilTwoSidedOperation :: Bool
+ , cpQuadCornerModified :: Bool -- ^ true if quad should not cover whole screen
+ , cpQuadLeft :: FloatType -- ^ quad positions in normalised coordinates [-1;1]x[-1;1] (in case of PT_RENDERQUAD)
+ , cpQuadTop :: FloatType
+ , cpQuadRight :: FloatType
+ , cpQuadBottom :: FloatType
+ , cpQuadFarCorners :: Bool
+ , cpQuadFarCornersViewSpace :: Bool
+ }
+
+data PassType
+ = PT_CLEAR -- ^ Clear target to one colour
+ | PT_STENCIL -- ^ Set stencil operation
+ | PT_RENDERSCENE -- ^ Render the scene or part of it
+ | PT_RENDERQUAD -- ^ Render a full screen quad
+ -}
+-- | Create render textures, and setup compositor chain.
+mkCompositorChain wr0 cl0 = do
+ -- do we really need this ???? -- HINT: add an implicit target to first compositor which renders the scene into a viewportsized texture,
+ -- iterate trough compositors and select first supported technique
+ let rs = wrRenderSystem wr0
+ initCompositor (world0,cl) c = do -- :: (World,[Maybe Compositor]) -> Compositor -> (World,[Maybe Compositor])
+ -- TODO: select first supported technique
+ let ct = head $ cmpTechniques c
+ tds <- forM (ctTextureDefinitions ct) $ \td -> do
+ -- create render textures
+ let w = fromMaybe 1 $ tdWidth td
+ h = fromMaybe 1 $ tdHeight td
+ txn = (cmpName c ++ "/" ++ tdName td)
+ t <- createTexture rs txn TEX_TYPE_2D w h 1 (MIP_NUMBER 1) (head $ tdFormatList td) (TextureUsage HBU_STATIC True False) False 0 "" Nothing
+ debugM "Initialize Compositor" $ "Created compositor texture: " ++ txn
+ return td { tdTexture = Just t }
+
+ let texmap = Map.fromList [(tdName td,td) | td <- tds]
+ onamel = map ctpOutputName $ ctTargetPasses ct
+ outtexl = [Map.lookup o texmap | o <- onamel]
+ checkTex b tn = case Map.member tn texmap of
+ { True -> return b
+ ; False -> do
+ errorM "Initialize Compositor" $ "Unknown compositor texture: " ++ tn
+ return False
+ }
+ oktex <- foldM checkTex True onamel
+ case oktex of
+ { False -> return (world0,Nothing:cl)
+ ; True -> do
+ -- setup compositor target pass output
+ let tps0 = [tp { ctpOutput = o } | (o,tp) <- zip outtexl $ ctTargetPasses ct]
+ initPasses (w0,tpl,okPasses) tp = do
+ let initPass (w0,pl,okPass) cp = case cpType cp of
+ { PT_RENDERQUAD -> do
+ -- setup composition pass input
+ -- load material
+ (w1,mmat) <- getLoadedMaterial (cpMaterialName cp) w0
+ case mmat of
+ { Nothing -> return (w1,cp:pl,False)
+ ; Just mat -> do
+ -- check pass input texture names
+ okInput <- foldM checkTex True [itName it | it <- IntMap.elems $ cpInputs cp]
+ case okInput of
+ { False -> return (w1,cp:pl,False)
+ ; True -> do
+ -- foreach material pass and for each textureunitstate
+ -- setup texture when it's a RT
+ let fp p = p { psTextureUnitStates = tul' }
+ where
+ tul' = [tu { tusFrames = fromMaybe (tusFrames tu) $ ft i } | (i,tu) <- tusl]
+ ft i = case IntMap.lookup i $ cpInputs cp of
+ { Nothing -> Nothing
+ ; Just it -> Just $ Just [fromJust $ tdTexture $ texmap Map.! (itName it)]
+ }
+ tusl = zip [0..] $ psTextureUnitStates p
+ mat' = mat { mtSupportedTechniques = Just [tch { tchPasses = [fp p | p <- tchPasses tch] } | tch <- fromJust $ mtSupportedTechniques mat] }
+ --return with modified pass attached to the list
+ return (w1,(cp { cpMaterial = Just mat' }):pl,okPass)
+ }
+ }
+ ; _ -> return (w0,cp:pl,okPass)
+ }
+
+ (w1,pl,okPasses') <- foldM initPass (w0,[],okPasses) $ ctpPasses tp
+ return (w1,(tp { ctpPasses = reverse pl }):tpl, okPasses')
+
+ (world1,tps1,okInit1) <- foldM initPasses (world0,[],True) tps0
+ (world2,motp,okInit2) <- initPasses (world1,[],okInit1) $ ctOutputTarget ct
+ case okInit2 of
+ { False -> return (world2,Nothing:cl)
+ ; True -> do
+ let otp = head motp
+ tps2 = reverse tps1 -- [tp | Just tp <- tps1]
+ return (world2,(Just c { cmpSupportedTechniques = Just [ct { ctTextureDefinitions = tds, ctTargetPasses = tps2, ctOutputTarget = otp }] }):cl)
+ }
+ }
+ -- setup compositor target pass input
+ (wr1,cl1) <- foldM initCompositor (wr0,[]) cl0
+ let cl2 = reverse [c | Just c <- cl1]
+ -- TODO: setup compositor chain connection
+ return (wr1,cl2)
+
+-- | Create a viewport and attach given compositors.
+mkViewport x y w h cam cnl world0 = do
+ -- collect compositors
+ let compMap = rlCompositorMap $ wrResource world0
+ getCompositor l cn = case Map.lookup cn compMap of
+ { Nothing -> do
+ errorM "ApplyCompositor" $ "Unknown compositor: " ++ cn
+ return l
+ ; Just c -> return $ c:l
+ }
+
+ -- setup compositor chain
+ cl0 <- foldM getCompositor [] cnl
+ (world1,cl1) <- mkCompositorChain world0 $ reverse cl0
+ return Viewport
+ { vpLeft = x
+ , vpTop = y
+ , vpWidth = w
+ , vpHeight = h
+ , vpCamera = cam
+ , vpCompositors = cl1
+ , vpBackColour = (0,0,0,0)
+ , vpClearEveryFrame = True
+ , vpClearBuffers = FrameBufferType True True False
+ }
+
+--updateTargetSize :: String -> Int -> Int -> World -> IO World
+updateTargetSize n w h = return . mapTargets (Map.adjust f n)
+ where
+ f t = t { rtWidth = w, rtHeight = h }
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,28 @@
+Copyright (c) 2009, Csaba Hruska
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,18 @@
+This is all highly experimental. Check out the examples package and
+the website for further details.
+
+There is one important feature that none of the examples can use due
+to the way cabal deals with data files. You can specify the paths to
+your resources in an ini-style config file, which looks something like
+this:
+
+# Comment
+[Section]
+Zip=path/to/resources-1.zip
+Zip=path/to/resources-2.zip
+FileSystem=path/to/more/resources/1
+FileSystem=path/to/more/resources/2
+...
+
+You can use the addConfig function (found in comments in all the
+examples) to load this file.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/lambdacube-engine.cabal b/lambdacube-engine.cabal
new file mode 100644
--- /dev/null
+++ b/lambdacube-engine.cabal
@@ -0,0 +1,113 @@
+name: lambdacube-engine
+version: 0.1.1
+cabal-version: >= 1.6 && < 2
+build-type: Simple
+license: BSD3
+license-file: LICENSE
+author: Csaba Hruska
+maintainer: csaba (dot) hruska (at) gmail (dot) com
+stability: experimental
+homepage: http://www.haskell.org/haskellwiki/LambdaCubeEngine
+category: Graphics
+tested-with: GHC == 6.10.1, GHC == 6.10.4
+synopsis: 3D rendering engine entirely written in Haskell
+description:
+ LambdaCube is a 3D rendering engine written entirely in Haskell.
+ It targets newer graphics hardware. The engine uses Ogre3D's mesh
+ and material file format. The main goal of this project is to
+ provide a modern and feature rich graphical backend for various
+ haskell projects (e.g. FRP libraries).
+extra-source-files:
+ README
+ Graphics/LambdaCube/Loader/Makefile
+ Graphics/LambdaCube/Loader/CompositorScriptScanner.x
+ Graphics/LambdaCube/Loader/FontDefinitionScriptScanner.x
+ Graphics/LambdaCube/Loader/MaterialScriptScanner.x
+ Graphics/LambdaCube/Loader/OverlayScriptScanner.x
+ Graphics/LambdaCube/Loader/ResourceScriptScanner.x
+
+library
+ build-depends:
+ base >= 4.0.0.0 && < 5,
+ zip-archive >= 0.1.1.3 && < 1,
+ binary >= 0.5.0.1 && < 1,
+ uulib >= 0.9.10 && < 1,
+ OpenGL >= 2.2.3 && < 3,
+ bytestring >= 0.9.1.4 && < 1,
+ xml >= 1.3 && < 2,
+ stb-image >= 0.1.3 && < 1,
+ filepath >= 1.1.0.1 && < 2,
+ directory >= 1.0.0.2 && < 2,
+ array,
+ containers >= 0.2 && < 1,
+ fgl,
+ hslogger
+ exposed-modules:
+ Graphics.LambdaCube
+ Graphics.LambdaCube.Compositor
+-- Graphics.LambdaCube.HardwareBufferManager
+ Graphics.LambdaCube.World
+ Graphics.LambdaCube.Light
+ Graphics.LambdaCube.GpuProgram
+-- Graphics.LambdaCube.MovableObject
+ Graphics.LambdaCube.TextureUnitState
+ Graphics.LambdaCube.VertexIndexData
+ Graphics.LambdaCube.GpuProgramParams
+ Graphics.LambdaCube.Types
+ Graphics.LambdaCube.Image
+-- Graphics.LambdaCube.HardwarePixelBuffer
+ Graphics.LambdaCube.Common
+ Graphics.LambdaCube.HardwareIndexBuffer
+ Graphics.LambdaCube.Texture
+-- Graphics.LambdaCube.ParticleSystem
+ Graphics.LambdaCube.Technique
+ Graphics.LambdaCube.GpuProgramUsage
+ Graphics.LambdaCube.PixelFormat
+ Graphics.LambdaCube.AnimationState
+ Graphics.LambdaCube.Pass
+ Graphics.LambdaCube.Material
+ Graphics.LambdaCube.RenderSystemCapabilities
+-- Graphics.LambdaCube.Overlay
+-- Graphics.LambdaCube.Loader.ParticleSystemScript
+ Graphics.LambdaCube.Loader.Generated.CompositorScriptScanner
+ Graphics.LambdaCube.Loader.Generated.ResourceScriptScanner
+-- Graphics.LambdaCube.Loader.Generated.FontDefinitionScriptScanner
+ Graphics.LambdaCube.Loader.Generated.MaterialScriptScanner
+-- Graphics.LambdaCube.Loader.Generated.OverlayScriptScanner
+ Graphics.LambdaCube.Loader.MeshXML
+ Graphics.LambdaCube.Loader.MaterialScript
+-- Graphics.LambdaCube.Loader.LMeshBinary
+ Graphics.LambdaCube.Loader.ParserUtil
+-- Graphics.LambdaCube.Loader.OverlayScript
+ Graphics.LambdaCube.Loader.CompositorScript
+ Graphics.LambdaCube.Loader.StbImage
+ Graphics.LambdaCube.Loader.ResourceScript
+ Graphics.LambdaCube.Math
+ Graphics.LambdaCube.SceneGraph
+ Graphics.LambdaCube.HardwareBuffer
+ Graphics.LambdaCube.Resource
+ Graphics.LambdaCube.Mesh
+ Graphics.LambdaCube.RenderSystem
+ Graphics.LambdaCube.RenderQueue
+ Graphics.LambdaCube.Frustum
+ Graphics.LambdaCube.RenderSystem.GL
+ Graphics.LambdaCube.RenderSystem.GL.GLGpuProgram
+ Graphics.LambdaCube.RenderSystem.GL.GLCapabilities
+ Graphics.LambdaCube.RenderSystem.GL.GLTexture
+ Graphics.LambdaCube.RenderSystem.GL.GLUtils
+ Graphics.LambdaCube.RenderSystem.GL.GLOcclusionQuery
+ Graphics.LambdaCube.RenderSystem.GL.GLRenderSystem
+ Graphics.LambdaCube.RenderSystem.GL.GLVertexBuffer
+ Graphics.LambdaCube.RenderSystem.GL.GLIndexBuffer
+ Graphics.LambdaCube.Entity
+ Graphics.LambdaCube.HardwareVertexBuffer
+ Graphics.LambdaCube.BlendMode
+ Graphics.LambdaCube.RenderOperation
+ Graphics.LambdaCube.Utility
+ Graphics.LambdaCube.HardwareOcclusionQuery
+
+-- Graphics.LambdaCube
+-- Graphics.LambdaCube.Loader.StbImage
+-- Graphics.LambdaCube.RenderSystem.GL
+
+ ghc-options: -O2 -Wall