AERN-RnToRm-Plot-0.2: src/Data/Number/ER/RnToRm/Plot/GLDrawable.hs

{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# LANGUAGE FlexibleInstances   #-}
{-|
    Module      :  Data.Number.ER.RnToRm.Plot.GLDrawable
    Description :  plot function enclosures on GL canvas
    Copyright   :  (c) 2007-2008 Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable

    Type class for GL plottable function enclosures,
    its default implementation, and instance declarations
    for enclosure types in package AERN-RnToRm. 
-}
module Data.Number.ER.RnToRm.Plot.GLDrawable 
(
    ERFnGLDrawable(..)
)
where

import qualified Data.Number.ER.RnToRm.Approx as FA
import qualified Data.Number.ER.RnToRm.UnitDom.Approx as UFA
import qualified Data.Number.ER.Real.Approx as RA

import Data.Number.ER.RnToRm.Approx.DomTransl
import Data.Number.ER.RnToRm.Approx.DomEdges
import Data.Number.ER.RnToRm.Approx.Tuple
import Data.Number.ER.RnToRm.Approx.PieceWise

import qualified Data.Number.ER.RnToRm.BisectionTree as BISTR
import qualified Data.Number.ER.BasicTypes.DomainBox as DBox
import Data.Number.ER.BasicTypes.DomainBox (VariableID(..), DomainBoxMappable, DomainIntBox)
import Data.Number.ER.RnToRm.Plot.Params

import Data.Number.ER.Misc

import qualified Graphics.Rendering.OpenGL as GL

import qualified Data.Map as Map
import qualified Data.List as List

class
    (FA.ERFnDomApprox box varid domra ranra fa) =>
    ERFnGLDrawable box varid domra ranra fa
    | fa -> box varid domra ranra 
    where
    {-|
        Plot the function as follows:
        
         * @R -> R^n@: draw @n@ 2D graphs in viewport and colours specified by plot params
          
         * @R^2 -> R^n@: draw @n@ 3D graphs in viewport and colours specified by plot params
     -}
    glDraw :: 
        PlotParams ->
        fa -> 
        IO ()
    glDraw plotParams f =
        do
--        putStrLn $ show partition
        mapM_ plotEnclosure enclosures
        return ()
        where
        enclosures =
            map (zip partition) $
            List.transpose $
            map pickActiveVals $
            map (\pt -> FA.eval pt f) $
            map (DBox.unary) partition
        partition =
            case RA.isAnticonsistent visibleDom of
                True -> []
                False ->
                    [domLO] ++ (map iL [1..(segCnt -1)]) ++ [domHI]
            where
            (domLO, domHI) = RA.bounds visibleDom
            visibleDom = dom RA./\ visibleExtents
            dom = 
                case DBox.elems $ FA.dom f of
                    [dom] -> dom
                    [] -> RA.bottomApprox
            segCnt = getSegmentCount segPerUnit coordSystem dom
            segCntRA = fromInteger segCnt
            iL i =
                ((segCntRA - iRA) * domLO + iRA * domHI) / segCntRA
                where
                iRA = fromInteger i
        coordSystem = pltprmCoordSystem plotParams
        segPerUnit = pltprmSegsPerUnit plotParams
        activeDimensions = pltprmPlotDimensions plotParams
        pickActiveVals vals =
            fst $ unzip $ filter snd $ zip vals activeDimensions
        plotEnclosure :: 
            (RA.ERIntApprox domra, RA.ERIntApprox ranra) => 
            [(domra,ranra)] -> 
            IO ()
        plotEnclosure interpCoords =
            do
            GL.renderPrimitive GL.LineLoop $
                do
--                putStrLn $ show interpCoords
--                putStrLn $ show $ interpCoordsDoubleUpper ++ interpCoordsDoubleLowerReversed
                mapM_ mkVertexNorm $
                    interpCoordsDoubleUpper ++ interpCoordsDoubleLowerReversed
            where
            interpCoordsDoubleLowerReversed = reverse interpCoordsDoubleLower
            (interpCoordsDoubleLower, interpCoordsDoubleUpper) = 
                unzip $ map convertCoords interpCoords
            convertCoords (d,v) 
--                | not $ RA.isConsistent d =
--                    ((0,0),(0,0))
--                | not $ RA.isConsistent v =
--                    ((dD,0),(dD,0))
                | otherwise =
                    ((dD,vD1),(dD,vD2))
                where
                (vD1,vD2) = RA.doubleBounds v
                dD = snd $ RA.doubleBounds d
        mkVertexNorm (d,v) =
            do
            GL.vertex $ GL.Vertex3 dNorm vNorm 0
            where
            (dNorm, vNorm) =
                translateToCoordSystem coordSystem [d, v]
        visibleExtents =
            (RA.double2ra vdomLO) RA.\/ (RA.double2ra vdomHI)
            where
            (_,_,vdomLO, vdomHI) = getVisibleDomExtents coordSystem

                
getSegmentCount segPerUnit coordSystem dom 
    | RA.isAnticonsistent dom = 0
    | otherwise = 
--        unsafePrint ("GLDrawable: getSegmentCount: dom = " ++ show dom ++ " domWidthScreen = " ++ show domWidthScreen) $
        ceiling (segPerUnitRA * domWidthScreen)
    where
    segPerUnitRA = fromInteger $ toInteger $ segPerUnit
    domWidthScreen = min 1 $ domHIScreen - domLOScreen
    (domLOScreen, _) = 
        translateToCoordSystem coordSystem [domLO, 0]
    (domHIScreen, _) = 
        translateToCoordSystem coordSystem [domHI, 0]
    (domLO, domHI) = RA.doubleBounds dom

instance 
    (UFA.ERUnitFnApprox box varid domra ranra ufa,
     DomainIntBox box varid domra,
     Show varid, Show box,
     DomainBoxMappable dtrbox box varid (DomTransl domra) domra, 
     DomainBoxMappable box dtrbox varid domra (DomTransl domra), 
     Eq dtrbox, Ord dtrbox) =>
    ERFnGLDrawable box varid domra ranra (ERFnDomTranslApprox dtrbox varid ufa domra)
    
instance
    (FA.ERFnDomApprox box varid domra ranra fa, 
     VariableID varid, Show box) =>
    ERFnGLDrawable box varid domra ranra (ERFnDomEdgesApprox varid fa)

instance
    (FA.ERFnDomApprox box varid domra ranra fa) =>
    ERFnGLDrawable box varid domra ranra (ERFnTuple fa)
    
instance
    (ERFnGLDrawable box varid domra ranra fa, RA.ERIntApprox fa, 
     Show box, DomainBoxMappable box box varid domra domra) =>
    ERFnGLDrawable box varid domra ranra (ERFnPiecewise box varid domra fa)
    where
    glDraw plotParams (ERFnPiecewise bistr) =
        BISTR.doBistr (\dom -> glDraw plotParams) (Just 15) bistr