--------------------------------------------------------------------------------
--
-- Module      : Data.Geometry.LegacyVTK.Util
-- Description : Legacy VTK Utilities
-- Copyright   : (c) 2014 Brian W Bush
-- License     : MIT
-- Maintainer  : code@bwbush.io
-- Stability   : experimental
-- Portability : portable
-- 
-- |  Utility functions for manipulating Legacy VTK.
--
--------------------------------------------------------------------------------


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


module Data.Geometry.LegacyVTK.Util (
  vtkFromGeojson
) where


import Data.Scientific (Scientific)

import qualified Data.Geography.GeoJSON as J (FeatureCollection, Geometry(..), MultiPolygonGeometry(..), PolygonGeometry(..), coordinates, features, geometry)
import qualified Data.Geometry.LegacyVTK as V (Geometry(..), Point(..))


-- | Convert GeoJSON to VTK.
vtkFromGeojson
  :: J.FeatureCollection -- ^ A GeoJSON feature collection.
  -> V.Geometry          -- ^ The corresponding VTK geometry.
vtkFromGeojson geojson =
  V.PolyData
  {
    V.points         = []
  , V.vertices       = []
  , V.lines          = []
  , V.polygons       = concatMap (map (map pointFromScientific) . outerBoundaries . J.geometry)
                         $ J.features geojson
  , V.triangleStrips = []
  }


pointFromScientific :: [Scientific] -> V.Point
pointFromScientific (x : y : z : _) =
  V.Point
  {
    V.x = x
  , V.y = y
  , V.z = z
  }
pointFromScientific (x : y : _) =
  V.Point
  {
    V.x = x
  , V.y = y
  , V.z = 0
  }
pointFromScientific _ = undefined


outerBoundaries :: J.Geometry -> [[[Scientific]]]
outerBoundaries (J.Polygon g) = [map J.coordinates $ J.exterior g]
outerBoundaries (J.MultiPolygon g) = map (map J.coordinates . J.exterior) $ J.polygons g
outerBoundaries _ = []