Params.hs

{-# LANGUAGE DeriveDataTypeable   #-}
{-|
    Module      :  Data.Number.ER.RnToRm.Plot.Params
    Description :  parameters for function plotting
    Copyright   :  (c) 2007-2008 Michal Konecny
    License     :  BSD3

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

    Data defining in detail how to plot a function and
    low-level methods related to plotting.
-}
module Data.Number.ER.RnToRm.Plot.Params 
(
    PlotParams(..),
    defaultPlotParams,
    CoordSystem(..),
    Rectangle(..),
    translateToCoordSystem,
    getVisibleDomExtents
)
where

import Data.Typeable
import Data.Generics.Basics
import Data.Binary

data PlotParams =
    PlotParams
    {
        pltprmCoordSystem :: CoordSystem, 
--        pltprmPlotColours :: [GL.Color4 GL.GLfloat],
        pltprmPlotDimensions :: [Bool],
        pltprmSegsPerUnit :: Int
    }
    deriving (Eq, Show, Typeable, Data)
  
{- the following has been generated by BinaryDerive -}     
instance Binary PlotParams where
  put (PlotParams a b c) = put a >> put b >> put c
  get = get >>= \a -> get >>= \b -> get >>= \c -> return (PlotParams a b c)
{- the above has been generated by BinaryDerive -}
  

data CoordSystem 
    = CoordSystemLinear Rectangle
    | CoordSystemLog Rectangle
    | CoordSystemSqueeze
    | CoordSystemLogSqueeze
    deriving (Eq, Ord, Show, Typeable, Data)

data Rectangle =
    Rectangle 
    {
        rectTop :: Rational,
        rectBottom :: Rational,
        rectLeft :: Rational,
        rectRight :: Rational
    }
    deriving (Eq, Ord, Show, Typeable, Data)
    
    
{- the following has been generated by BinaryDerive -}
instance Binary CoordSystem where
  put (CoordSystemLinear a) = putWord8 0 >> put a
  put (CoordSystemLog a) = putWord8 1 >> put a
  put CoordSystemSqueeze = putWord8 2
  put CoordSystemLogSqueeze = putWord8 3
  get = do
    tag_ <- getWord8
    case tag_ of
      0 -> get >>= \a -> return (CoordSystemLinear a)
      1 -> get >>= \a -> return (CoordSystemLog a)
      2 -> return CoordSystemSqueeze
      3 -> return CoordSystemLogSqueeze
      _ -> fail "no parse"
instance Binary Rectangle where
  put (Rectangle a b c d) = put a >> put b >> put c >> put d
  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> return (Rectangle a b c d)
{- the above has been generated by BinaryDerive -}

    
defaultPlotParams =
    PlotParams
    {
        pltprmCoordSystem = CoordSystemLogSqueeze,
--        pltprmPlotColours = [GL.Color4 1 0.2 (0.4 :: GL.GLfloat) 1],
        pltprmPlotDimensions = replicate 4 True,
        pltprmSegsPerUnit = 100
    }
    
{-|
    Translate a point given by a number of coordinates to
    a 2D point assuming that only result points in the rectangle
    (0,0) --- (10,10) are visible, the origin being at the top left.
-}
translateToCoordSystem ::
    (Floating ra, Ord ra) =>
    CoordSystem ->
    [ra] ->
    (ra, ra)
translateToCoordSystem csys pt =
    case (csys, pt) of
        (CoordSystemLogSqueeze, [x,y]) ->
            ((logSqueeze 0.5 x) * scale, (logSqueeze 0.5 y) * scale)
        (CoordSystemLinear (Rectangle t b l r), [x,y]) ->
            ((linTransViaRat l r x) * scale, 
             (linTransViaRat b t y) * scale)
    where
    scale = 1
    linTransViaRat r0 r1 x =
        linTransform (fromRational r0) (fromRational r1) x 
    
    linTransform x0 x1 x =
        (x - x0) / (x1 - x0)
    
    logSqueeze v1 =
        (\x -> (x + 1) /2) . (normalise v1) . logScale
    
getVisibleDomExtents :: CoordSystem -> (Double,Double,Double,Double)
getVisibleDomExtents csys =
    case csys of
        CoordSystemLogSqueeze -> 
            (infinity, -infinity, - infinity, infinity)
        CoordSystemLinear (Rectangle t b l r) ->
            (fromRational t, fromRational b, fromRational l, fromRational r)
    where
    infinity = 1/0 
    
{-|
    Convert a number from range [-oo,+oo] to
    range (-1,1), mapping 1 to v1.
-}
normalise :: 
    (Fractional a, Ord a) => 
    a {-^ v1 -} -> 
    a {-^ x -} -> 
    a
normalise v1 x 
    | v1ok && x < 0 = - 1 + a/(a - x)
    | v1ok = 1 - a/(a + x)
    where
    v1ok = 0 < v1 && v1 < 1
    a = (1 - v1) / v1
    
{-|
    Map the range [-oo,oo] to itself with a logarithmic scale.
-}
logScale :: (Floating a, Ord a) => a -> a
logScale x
    | x < 0 = - (logScale (-x))
    | otherwise = log (x + 1)