--------------------------------------------------------------------------------
--
-- Module      : Data.Geometry.LegacyVTK
-- Description : Legacy VTK Utilities
-- Copyright   : (c) 2014 Brian W Bush
-- License     : MIT
-- Maintainer  : code@bwbush.io
-- Stability   : experimental
-- Portability : portable
-- 
-- | Rudimentary support for Visualization Toolkit (VTK) 4.2 < <http://www.vtk.org/VTK/img/file-formats.pdf>> legacy data formats.
--
--------------------------------------------------------------------------------


{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}


{-# LANGUAGE RecordWildCards #-}


module Data.Geometry.LegacyVTK (
  Geometry(..)
, Point(..)
, Points
, Attribute(..)
, makeVTK
) where


import Data.List (nub, sort)
import Data.Maybe (fromJust)
import Data.Scientific (Scientific)

import Prelude hiding (lines)

import qualified Data.Map.Strict as M (Map, fromList, keys, lookup)


-- | Legacy VTK geometry/topology data.
{-# WARNING Geometry "This interface is provisional and subject to substantial revision." #-}
data Geometry =
    StructuredPoints
    {
      xDimension, yDimension, zDimension :: Int
    , xOrigin, yOrigin, zOrigin          :: Scientific
    , xSpacing, ySpacing, zSpacing       :: Scientific
    }
  | StructuredGrid
    {
      xDimension, yDimension, zDimension :: Int
    , points                             :: Points
    }
  | UnstructuredGrid
    {
      points    :: Points
    , cells     :: [Points]
    , cellTypes :: [Int]
    }
  | PolyData
    {
      points         :: Points
    , vertices       :: [Points]
    , lines          :: [Points]
    , polygons       :: [Points]
    , triangleStrips :: [Points]
    }
  | RectilinearGrid
    {
      xDimension, yDimension, zDimension :: Int
    , xCoordinates, yCoordinates, zCoordinates :: [Scientific]
    }
  | Field
    deriving (Eq, Read, Show)


-- | A VTK point.
{-# WARNING Point "This interface is provisional and subject to substantial revision." #-}
data Point = Point {x, y, z :: Scientific}
  deriving (Eq, Ord, Read, Show)


-- | A list of VTK points.
{-# WARNING Points "This interface is provisional and subject to substantial revision." #-}
type Points = [Point]


-- | VTK dataset attributes.
{-# WARNING Attribute "This interface is provisional and subject to substantial revision." #-}
data Attribute =
    Scalar
  | ColorScalar
  | LookupTable
  | Vector
  | Normal
  | TextureCoordinate
  | Tensor
  | FieldData
    deriving (Eq, Read, Show)


-- | Create lines of a formatted legacy VTK data file.
{-# WARNING makeVTK "This interface is provisional and subject to substantial revision." #-}
makeVTK
  :: String          -- ^ The title.
  -> Geometry        -- ^ The geometry/topology.
  -> Maybe Attribute -- ^ The point data attribute.
  -> Maybe Attribute -- ^ The cell data attribute.
  -> [String]        -- ^ Lines of formatted legacy VTK data.
makeVTK title geometry _ _ =
  [
    "# vtk DataFile Version 2.0"
  , title
  , "ASCII"
  ]
  ++
  makeVTK' geometry


makeVTK' :: Geometry -> [String]
makeVTK' PolyData{..} =
  let
    pointMap :: M.Map Point Int
    pointMap =
      M.fromList
       $ zip
         (sort $ nub $ points ++ concat vertices ++ concat lines ++ concat polygons ++ concat triangleStrips)
         [0..]
    points' :: [Point]
    points' = M.keys pointMap
  in
    [
      "DATASET POLYDATA"
    , "POINTS " ++ show (length points') ++ " double"
    ]
    ++
    map (\Point{..} -> unwords $ map show [x, y, z]) points'
    ++
    ["POLYGONS " ++ show (length polygons) ++ " " ++ show (length polygons + length (concat polygons))]
    ++
    map (\ps -> unwords $ map show $ length ps : map (fromJust . (`M.lookup` pointMap)) ps) polygons
makeVTK' _ = undefined