GRUFF.hs

{- |
Module      :  Fractal.GRUFF
Copyright   :  (c) Claude Heiland-Allen 2011
License     :  GPL-2

Maintainer  :  claude@mathr.co.uk
Stability   :  unstable
Portability :  portable

Support library for rendering animations of the Mandelbrot Set fractal
using the gruff executable.

An example program might have a structure similar to:

  > import Fractal.GRUFF
  >
  > animation :: Animation
  > animation = ...
  >
  > main :: IO ()
  > main = defaultMain animation

with its output fed to the gruff executable.

See also:

  * the @ruff@ package for feature location algorithms; and
    
  * the @gruff-examples@ package for concrete examples.

-}
module Fractal.GRUFF where

import System.IO (hFlush, stdout)

import Fractal.RUFF.Types.Complex (Complex((:+)))

-- | Animation specification
type Animation = [(Image, FilePath)]

-- | Image specification.
data Image = Image
  { imageWindow   :: !Window
  , imageViewport :: !Viewport
  , imageLocation :: !Location
  , imageColours  :: !Colours
  , imageLabels   :: [Label]
  , imageLines    :: [Line]
  }
  deriving (Read, Show, Eq)

-- | Window specification.
data Window = Window
  { width  :: !Int
  , height :: !Int
  , supersamples :: !Double
  }
  deriving (Read, Show, Eq)

-- | Viewport specification
data Viewport = Viewport
  { aspect :: !Double -- width / height
  , orient :: !Double -- in radians
  }
  deriving (Read, Show, Eq)

-- | Location specification (center of view).
data Location = Location
  { center :: !(Complex Rational)
  , radius :: !Double -- accurate enough for 1000 2x zoom levels
  }
  deriving (Read, Show, Eq)

-- | Colour specification.
data Colours = Colours
  { colourInterior :: !Colour
  , colourBoundary :: !Colour
  , colourExterior :: !Colour
  }
  deriving (Read, Show, Eq)

-- | RGB colour data (each channel between 0 and 1).
data Colour = Colour !Double !Double !Double
  deriving (Read, Show, Eq)

-- | Labels can be added to points in the complex plane.
data Label = Label
  { labelCoords :: !(Complex Rational)
  , labelColour :: !Colour
  , labelText   :: String
  }
  deriving (Read, Show, Eq)

-- | Append a label to an image.
labelAppend :: Complex Rational -> Colour -> String -> Image -> Image
labelAppend c v t i = i{ imageLabels = imageLabels i ++ [Label{ labelCoords = c, labelColour = v, labelText = t }] }

-- | Prepend a label to an image.
labelPrepend :: Complex Rational -> Colour -> String -> Image -> Image
labelPrepend c v t i = i{ imageLabels = [Label{ labelCoords = c, labelColour = v, labelText = t }] ++ imageLabels i }

-- ! Line segments.
data Line = Line
  { lineSegments :: [(Complex Rational, Complex Rational)]
  , lineColour :: !Colour
  }
  deriving (Read, Show, Eq)

-- | Transform a point from screen coordinates.
fromScreenCoords :: (Fractional r, Real r) => Window -> Viewport -> Location -> Complex Double -> Complex r
fromScreenCoords w v l = \(x :+ y) ->
  let x1 = (2 * x - w') / w' * p
      y1 = (h' - 2 * y) / h' / p
      x2 =  co * x1 + si * y1
      y2 = -si * x1 + co * y1
      x3 = r * toRational x2
      y3 = r * toRational y2
      x4 :+ y4 = (x3 :+ y3) + c
  in  fromRational x4 :+ fromRational y4
  where
    p = sqrt (aspect v)
    w' = fromIntegral (width  w)
    h' = fromIntegral (height w)
    a = - orient v
    co = cos a
    si = sin a
    r = toRational $ radius l
    c = center l

-- | Transform a point to screen coordinates.
toScreenCoords :: Real r => Window -> Viewport -> Location -> Complex r -> Complex Double
toScreenCoords w v l = \(x' :+ y') ->
  let x = (x1 / p * w' + w') /   2
      y = (y1 * p * h' - h') / (-2)
      x1 =  co * x2 + si * y2
      y1 = -si * x2 + co * y2
      x2 = fromRational (x3 / r)
      y2 = fromRational (y3 / r)
      x3 :+ y3 = (toRational x' :+ toRational y') - c
  in  x :+ y
  where
    p = sqrt (aspect v)
    w' = fromIntegral (width  w)
    h' = fromIntegral (height w)
    a = orient v
    co = cos a
    si = sin a
    r = toRational (radius l)
    c = center l

-- | Serialize an animation to stdout.
defaultMain :: Animation -> IO ()
defaultMain a = do
  mapM_ (\f -> print f >> hFlush stdout) a