module Lambency.Loaders.MTLLoader (
  MTL(..),
  mkMaterial,
  loadMTL,
) where

--------------------------------------------------------------------------------
#if __GLASGOW_HASKELL__ <= 708
import Control.Applicative hiding ((<|>), many)
#endif

import Data.Char (toLower)
import Data.List (find)
import Data.Text (pack)

import qualified Lambency.Texture as L
import qualified Lambency.Material as L
import qualified Lambency.Types as L

import Lambency.Loaders.Utils

import Linear hiding (trace)

import System.FilePath

import Text.Parsec
import Text.Parsec.Text (Parser)
--------------------------------------------------------------------------------

{--
  Ft Fresnel reflectance
  Ft Fresnel transmittance
  Ia ambient light
  I  light intensity
  Ir intensity from reflected direction (reflection map and/or ray tracing)
  It intensity from transmitted direction
  Ka ambient reflectance
  Kd diffuse reflectance
  Ks specular reflectance
  Tf transmission filter 

  H unit vector bisector between L and V
  L unit light vector
  N unit surface normal
  V unit view vector 
--}

data IlluminationMode
  -- This is a constant color illumination model. The color is the specified Kd
  -- for the material.
  = IlluminationMode'ColorOnAmbientOff

  -- This is a diffuse illumination model using Lambertian shading. The color
  -- includes an ambient constant term and a diffuse shading term for each light
  -- source:
  -- color = Ka Ia + Kd { SUM j=1..ls, (N * Lj)Ij } 
  | IlluminationMode'ColorOnAmbientOn

  -- This is a diffuse and specular illumination model using Lambertian shading
  -- and Blinn's interpretation of Phong's specular illumination model (BLIN77).
  -- The color includes an ambient constant term, and a diffuse and specular
  -- shading term for each light source:
  -- color = KaIa + Kd { SUM j=1..ls, (N*Lj)Ij } + Ks { SUM j=1..ls, ((N*Hj)^Ns)Ij } 
  | IlluminationMode'HighlightOn

  -- This is a diffuse and specular illumination model using Lambertian shading
  -- and Blinn's interpretation of Phong's specular illumination model (BLIN77).
  -- The color includes an ambient constant term, and a diffuse and specular shading
  -- term for each light source:
  -- color = Ka Ia + Kd { SUM j=1..ls, (N*Lj)Ij } + Ks ({ SUM j=1..ls, ((N*Hj)^Ns)Ij } + Ir) 
  | IlluminationMode'ReflectionRayTrace

  -- According to the MTL spec, this is identical to IlluminationMode'ReflectionRayTrace
  | IlluminationMode'GlassRayTrace

  -- The rest aren't supported yet...
  | IlluminationMode'FresnelRayTrace
  | IlluminationMode'RefractionRayTrace
  | IlluminationMode'RefractionFresnelRayTrace
  | IlluminationMode'Reflection
  | IlluminationMode'Glass
  | IlluminationMode'ShadowCaster
  deriving (Read, Show, Eq, Ord, Enum, Bounded)

data ColorChannel
  = ColorChannel'Red
  | ColorChannel'Green
  | ColorChannel'Blue
  | ColorChannel'Matte
  | ColorChannel'Luma
  | ColorChannel'Depth
  deriving (Read, Show, Eq, Ord, Enum, Bounded)

data TextureInfo = TextureInfo {
  horizBlend :: Bool,     -- Default: True
  vertBlend :: Bool,      -- Default: True
  clampUV :: Bool,        -- Default: False
  channelRestriction :: Maybe ColorChannel,
  valueRange :: (Float, Float),  -- Default: (0, 1)
  texTranslate :: V3 Float, -- Default: (0, 0, 0)
  texScale :: V3 Float,     -- Default: (1, 1, 1)
  texTurbulence :: V3 Float -- Default: (0, 0, 0)
}
 deriving (Show, Eq, Ord)

data ReflectionType
  = ReflectionType'Sphere
  | ReflectionType'CubeTop
  | ReflectionType'CubeBottom
  | ReflectionType'CubeFront
  | ReflectionType'CubeBack
  | ReflectionType'CubeLeft
  | ReflectionType'CubeRight
  deriving (Read, Show, Eq, Ord, Enum, Bounded)

data TextureMap
  = ColorMap {
    _colorTexInfo :: TextureInfo,
    _colorCorrection :: Bool
  }
  | BumpMap {
    _bumpTexInfo :: TextureInfo,
    _multiplier :: Float
  }
  | DecalMap {
    _decalMapInfo :: TextureInfo
  }
  | DisplacementMap {
    _dispMapInfo :: TextureInfo
  }
  | ReflectionMap {
    _reflMapInfo :: TextureInfo,
    _colorCorrection :: Bool,
    _reflTy :: ReflectionType
  }
 deriving (Show, Eq, Ord)

data ReflectivityInfo = ReflectivityInfo {
  reflColor :: Maybe (V3 Float),
  reflMap :: Maybe (FilePath, TextureMap)
}
 deriving (Show, Eq, Ord)

data DissolveInfo = DissolveInfo {
  _dissolveHalo :: Bool,
  _dissolveFactor :: Float
}
 deriving (Show, Eq, Ord)

data MTL = MTL {
  mtlName :: String,
  ambientInfo :: ReflectivityInfo,
  diffuseInfo :: ReflectivityInfo,
  specularInfo :: ReflectivityInfo,

  emissiveColor :: Maybe (V3 Float),

  -- The Tf statement specifies the transmission filter using RGB values. 

  -- "r g b" are the values for the red, green, and blue components of the atmosphere.
  -- The g and b arguments are optional. If only r is specified, then g, and b are
  -- assumed to be equal to r. The r g b values are normally in the range of 0.0 to 1.0.
  -- Values outside this range increase or decrease the relectivity accordingly. 
  transferrence :: V3 Float,

  illuminationMode :: IlluminationMode,

  dissolve :: DissolveInfo,

  specularExponent :: Float,
  sharpness :: Float,
  indexOfRefraction :: Float,

  textureMaps :: [(FilePath, TextureMap)]
}
 deriving (Show, Eq, Ord)

----------------------------------------------------------------------
-- Interface with Lambency

type LReflectivity = (L.MaterialVar (V3 Float), L.MaterialVar L.Texture)

updateReflectivity :: FilePath -> ReflectivityInfo -> LReflectivity
                   -> L.ResourceLoader LReflectivity
updateReflectivity baseDir reflInfo (v1, v2) = do
  let v1n = L.getMatVarName v1
      v2n = L.getMatVarName v2

      v1' = case reflColor reflInfo of
        Nothing -> Nothing
        Just v -> Just $ L.Vector3Val v

  v2' <- case reflMap reflInfo of
    Nothing -> return Nothing
    Just (fp, _) -> do
      tex <- L.loadTexture (baseDir </> fp)
      case tex of
        Nothing -> return Nothing
        Just t -> return . Just $ L.TextureVal undefined t

  return (L.MaterialVar (v1n, v1'), L.MaterialVar (v2n, v2'))

mkMaterial :: FilePath -> MTL -> L.ResourceLoader L.Material
mkMaterial baseDir mtl = do
  let initialMat = L.defaultBlinnPhong

  (dRefl, dMap) <- updateReflectivity baseDir (diffuseInfo mtl)
                   (L.diffuseReflectivity initialMat, L.diffuseMap initialMat)

  (sRefl, sMap) <- updateReflectivity baseDir (specularInfo mtl)
                   (L.specularReflectivity initialMat, L.specularMap initialMat)

  let aRefl = case ambientInfo mtl of
        ReflectivityInfo Nothing _ -> L.ambientReflectivity initialMat
        -- !HACK! -- If the reflectivity is zero but there's a texture map,
        -- then just assume that the texture map is the same as the diffuse map
        -- and set the ambient reflectivity to full...
        ReflectivityInfo (Just c) (Just _)
          | c == (V3 0 0 0) ->
            let (L.MaterialVar (n, _)) = L.ambientReflectivity initialMat
            in L.MaterialVar (n, Just $ L.Vector3Val $ V3 1 1 1)
          | otherwise ->
            let (L.MaterialVar (n, _)) = L.ambientReflectivity initialMat
            in L.MaterialVar (n, Just $ L.Vector3Val c)
        ReflectivityInfo (Just c) _ ->
            let (L.MaterialVar (n, _)) = L.ambientReflectivity initialMat
            in L.MaterialVar (n, Just $ L.Vector3Val c)

      sExp = let (L.MaterialVar (n, _)) = L.specularExponent initialMat
              in (L.MaterialVar (n, Just $ L.FloatVal $ specularExponent mtl))

  return $
    initialMat {
      L.diffuseReflectivity = dRefl,
      L.diffuseMap = dMap,

      L.specularExponent = sExp,
      L.specularReflectivity = sRefl,
      L.specularMap = sMap,

      L.ambientReflectivity = aRefl
      }

----------------------------------------------------------------------
-- Parser

data IllumCommand
  = IllumCommand'AmbientReflectivity (V3 Float)
  | IllumCommand'DiffuseReflectivity (V3 Float)
  | IllumCommand'SpecularReflectivity (V3 Float)
  | IllumCommand'Emissive (V3 Float)
  | IllumCommand'Transferrence (V3 Float)
  | IllumCommand'Mode IlluminationMode
  | IllumCommand'Dissolve DissolveInfo
  | IllumCommand'SpecularExponent Float
  | IllumCommand'Sharpness Float
  | IllumCommand'IndexOfRefraction Float
    deriving (Show, Eq, Ord)

data TextureMapCommand
  = TextureMapCommand'Ambient (FilePath, TextureMap)
  | TextureMapCommand'Diffuse (FilePath, TextureMap)
  | TextureMapCommand'Specular (FilePath, TextureMap)
  | TextureMapCommand'SpecularExponent (FilePath, TextureMap)
  | TextureMapCommand'Dissolve (FilePath, TextureMap)
  | TextureMapCommand'Reflection (FilePath, TextureMap)
  | TextureMapCommand'Decal (FilePath, TextureMap)
  | TextureMapCommand'Disp (FilePath, TextureMap)
  | TextureMapCommand'Bump (FilePath, TextureMap)
    deriving (Show, Eq, Ord)

data TextureInfoCommand
  = TextureInfoCommand'HorizBlend Bool
  | TextureInfoCommand'VertBlend Bool
  | TextureInfoCommand'ClampUV Bool
  | TextureInfoCommand'ChannelRestriction ColorChannel
  | TextureInfoCommand'ValueRange (Float, Float)
  | TextureInfoCommand'Translate (V3 Float)
  | TextureInfoCommand'Scale (V3 Float)
  | TextureInfoCommand'Turbulence (V3 Float)

  | TextureInfoCommand'ColorCorrection Bool
  | TextureInfoCommand'BumpMultiplier Float

  | TextureInfoCommand'ReflectionType ReflectionType
    deriving (Show, Eq, Ord)

whitespace :: Parser Char
whitespace = tab <|> char ' '

whitespaces :: Parser [Char]
whitespaces = many whitespace

finishLine :: Parser ()
finishLine = many (whitespace <|> comment) >> endMarker >> return ()
  where
    endMarker = endOfLine
    
    comment :: Parser Char
    comment = char '#' >> manyTill anyChar (try $ lookAhead endMarker) >> return '_'

parseTexOpts :: Parser [TextureInfoCommand]
parseTexOpts = many $ try texOpt
  where

    parseBoolOpt :: String -> Parser Bool
    parseBoolOpt s = try $ whitespaces >> char '-' >> string s >> whitespaces >>
                     ((string "on" >> return True) <|> (string "off" >> return False))

    parsePartialV3Opt :: Char -> Parser Vec3f
    parsePartialV3Opt c = try $ whitespaces >> char '-' >> char c >> (do
      x <- float
      y <- option x float
      z <- option x float
      return $ V3 x y z)

    parseFloatOpt :: String -> Parser Float
    parseFloatOpt s = try $ whitespaces >> char '-' >> string s >> float

    parseValueRange :: Parser (Float, Float)
    parseValueRange = try $ whitespaces >> string "-mm" >> (do
      base <- float
      gain <- float
      return (base, gain))

    parseBumpChannel :: Parser ColorChannel
    parseBumpChannel = try $ whitespaces >> string "-imfchan" >>
      ((char 'r' >> return ColorChannel'Red) <|>
       (char 'g' >> return ColorChannel'Green) <|>
       (char 'b' >> return ColorChannel'Blue) <|>
       (char 'm' >> return ColorChannel'Matte) <|>
       (char 'l' >> return ColorChannel'Luma) <|>
       (char 'z' >> return ColorChannel'Depth))

    parseReflectionType :: Parser ReflectionType
    parseReflectionType = try $ whitespaces >> string "-type" >> whitespaces >>
      ((string "sphere" >> return ReflectionType'Sphere) <|>
       (string "cube_top" >> return ReflectionType'CubeTop) <|>
       (string "cube_bottom" >> return ReflectionType'CubeBottom) <|>
       (string "cube_front" >> return ReflectionType'CubeFront) <|>
       (string "cube_back" >> return ReflectionType'CubeBack) <|>
       (string "cube_left" >> return ReflectionType'CubeLeft) <|>
       (string "cube_right" >> return ReflectionType'CubeRight))

    texOpt :: Parser TextureInfoCommand
    texOpt =
      (TextureInfoCommand'HorizBlend <$> parseBoolOpt "blendu")
      <|> (TextureInfoCommand'VertBlend <$> parseBoolOpt "blendv")
      <|> (TextureInfoCommand'ClampUV <$> parseBoolOpt "clamp")
      <|> (TextureInfoCommand'ColorCorrection <$> parseBoolOpt "cc")

      <|> (TextureInfoCommand'Translate <$> parsePartialV3Opt 'o')
      <|> (TextureInfoCommand'Scale <$> parsePartialV3Opt 's')
      <|> (TextureInfoCommand'Turbulence <$> parsePartialV3Opt 't')

      <|> (TextureInfoCommand'BumpMultiplier <$> parseFloatOpt "bm")

      <|> (TextureInfoCommand'ValueRange <$> parseValueRange)

      <|> (TextureInfoCommand'ReflectionType <$> parseReflectionType)

      <|> (TextureInfoCommand'ChannelRestriction <$> parseBumpChannel)

      <|> (try $ string "-texres" >> float >>=
           (\x -> error $ "Lambency.Loaders.MTLLoader (parseTexOpts): Unsupported token (texres)" ++ show x))

handleTexInfo :: [TextureInfoCommand] -> TextureInfo
handleTexInfo =
  let defaultInfo = TextureInfo {
        horizBlend = True,
        vertBlend = True,
        clampUV = False,
        channelRestriction = Nothing,
        valueRange = (0, 1),
        texTranslate = V3 0 0 0,
        texScale = V3 1 1 1,
        texTurbulence = V3 0 0 0
        }

      handleCommand :: TextureInfoCommand -> TextureInfo -> TextureInfo
      handleCommand (TextureInfoCommand'HorizBlend b) i = i { horizBlend = b }
      handleCommand (TextureInfoCommand'VertBlend b) i = i { vertBlend = b }
      handleCommand (TextureInfoCommand'ClampUV b) i = i { clampUV = b }
      handleCommand (TextureInfoCommand'ChannelRestriction x) i = i { channelRestriction = Just x }
      handleCommand (TextureInfoCommand'ValueRange x) i = i { valueRange = x }
      handleCommand (TextureInfoCommand'Translate x) i = i { texTranslate = x}
      handleCommand (TextureInfoCommand'Scale x) i = i { texScale = x }
      handleCommand (TextureInfoCommand'Turbulence x) i = i { texTurbulence = x }

      handleCommand x _ = error $ "Lambency.Loaders.MTLLoader (handleTexInfo): Unexpected info command: " ++ show x

  in foldr handleCommand defaultInfo 

constructMaterial :: String -> [IllumCommand] -> [TextureMapCommand] -> MTL
constructMaterial name illumCmds = foldr handleTexMapCmd illumMtl
  where
    illumMtl = foldr handleIllumCmd defaultMTL illumCmds

    defaultMTL = MTL {
      mtlName = map toLower name,

      ambientInfo = ReflectivityInfo Nothing Nothing,
      diffuseInfo = ReflectivityInfo Nothing Nothing,
      specularInfo = ReflectivityInfo Nothing Nothing,

      emissiveColor = Nothing,

      transferrence = V3 1 1 1,

      illuminationMode = IlluminationMode'HighlightOn,

      dissolve = DissolveInfo False 1.0,

      specularExponent = 10.0,
      sharpness = 1.0,
    
      indexOfRefraction = 1.5,

      textureMaps = []
      }

    handleIllumCmd :: IllumCommand -> MTL -> MTL
    handleIllumCmd (IllumCommand'AmbientReflectivity x) mtl =
      mtl { ambientInfo = (ambientInfo mtl) { reflColor = Just x }}
    handleIllumCmd (IllumCommand'DiffuseReflectivity x) mtl =
      mtl { diffuseInfo = (diffuseInfo mtl) { reflColor = Just x }}
    handleIllumCmd (IllumCommand'SpecularReflectivity x) mtl =
      mtl { specularInfo = (specularInfo mtl) { reflColor = Just x }}
    handleIllumCmd (IllumCommand'Emissive x) mtl = mtl { emissiveColor = Just x }
    handleIllumCmd (IllumCommand'Transferrence x) mtl = mtl { transferrence = x }
    handleIllumCmd (IllumCommand'Mode mode) mtl = mtl { illuminationMode = mode }
    handleIllumCmd (IllumCommand'Dissolve info) mtl = mtl { dissolve = info }
    handleIllumCmd (IllumCommand'SpecularExponent x) mtl = mtl { specularExponent = x }
    handleIllumCmd (IllumCommand'Sharpness x) mtl = mtl { sharpness = x }
    handleIllumCmd (IllumCommand'IndexOfRefraction x) mtl = mtl { indexOfRefraction = x }

    handleTexMapCmd :: TextureMapCommand -> MTL -> MTL
    handleTexMapCmd (TextureMapCommand'Ambient x) mtl =
      mtl { ambientInfo = (ambientInfo mtl) { reflMap = Just x }}
    handleTexMapCmd (TextureMapCommand'Diffuse x) mtl =
      mtl { diffuseInfo = (diffuseInfo mtl) { reflMap = Just x }}
    handleTexMapCmd (TextureMapCommand'Specular x) mtl =
      mtl { specularInfo = (specularInfo mtl) { reflMap = Just x }}
    handleTexMapCmd (TextureMapCommand'SpecularExponent x) mtl = mtl { textureMaps = x : (textureMaps mtl) }
    handleTexMapCmd (TextureMapCommand'Dissolve x) mtl = mtl { textureMaps = x : (textureMaps mtl) }
    handleTexMapCmd (TextureMapCommand'Reflection x) mtl = mtl { textureMaps = x : (textureMaps mtl) }
    handleTexMapCmd (TextureMapCommand'Decal x) mtl = mtl { textureMaps = x : (textureMaps mtl) }
    handleTexMapCmd (TextureMapCommand'Disp x) mtl = mtl { textureMaps = x : (textureMaps mtl) }
    handleTexMapCmd (TextureMapCommand'Bump x) mtl = mtl { textureMaps = x : (textureMaps mtl) }

parseFile :: Parser [MTL]
parseFile = many material >>= (\x -> many finishLine >> eof >> return x)
  where
    readReflectance :: String -> Parser (V3 Float)
    readReflectance s = try $ whitespaces >> string s >> vector3

    parseFloatCmd :: String -> Parser Float
    parseFloatCmd s = try $ whitespaces >> string s >> float

    parseDissolve :: Parser DissolveInfo
    parseDissolve = try $ do
      _ <- whitespaces >> char 'd'
      isHalo <- whitespaces >> ((string "-halo" >> return True) <|> return False)
      val <- float
      return $ DissolveInfo isHalo val

    illum :: Parser IllumCommand
    illum =
      (IllumCommand'AmbientReflectivity <$> (readReflectance "Ka")) <|>
      (IllumCommand'DiffuseReflectivity <$> (readReflectance "Kd")) <|>
      (IllumCommand'SpecularReflectivity <$> (readReflectance "Ks")) <|>
      (IllumCommand'Emissive <$> (readReflectance "Ke")) <|>
      (IllumCommand'Transferrence <$> (readReflectance "Tf")) <|>
      (IllumCommand'Dissolve <$> parseDissolve) <|>
      (IllumCommand'Dissolve . DissolveInfo False . (1.0 -) <$> parseFloatCmd "Tr") <|>
      (IllumCommand'Mode . toEnum . round <$> parseFloatCmd "illum") <|>
      (IllumCommand'SpecularExponent <$> parseFloatCmd "Ns") <|>
      (IllumCommand'Sharpness <$> parseFloatCmd "sharpness") <|>
      (IllumCommand'IndexOfRefraction <$> parseFloatCmd "Ni")

    parseIllum :: Parser [IllumCommand]
    parseIllum = many $ illum >>= (\x -> finishLine >> return x)

    colorMap :: String -> Parser (FilePath, TextureMap)
    colorMap n = try $ do
      infoCmds <- whitespaces >> string n >> parseTexOpts
      let isColorCorrection (TextureInfoCommand'ColorCorrection _) = True
          isColorCorrection _ = False

          correction =
            case find isColorCorrection infoCmds of
              Just (TextureInfoCommand'ColorCorrection b) -> b
              _ -> False

          revisedInfoCmds = filter (not . isColorCorrection) infoCmds

      filename <- whitespaces >> manyTill anyChar (try $ lookAhead space)
      return $ (filename, ColorMap (handleTexInfo revisedInfoCmds) correction)

    reflectionMap :: Parser (FilePath, TextureMap)
    reflectionMap = try $ do
      infoCmds <- whitespaces >> string "refl" >> parseTexOpts
      let isReflectionType (TextureInfoCommand'ReflectionType _) = True
          isReflectionType _ = False

          refl =
            case find isReflectionType infoCmds of
              Just (TextureInfoCommand'ReflectionType rty) -> rty
              _ -> error "Lambency.Loaders.MTLLoader (parseFile): Reflection map must contain reflection type"

          isColorCorrection (TextureInfoCommand'ColorCorrection _) = True
          isColorCorrection _ = False

          correction =
            case find isColorCorrection infoCmds of
              Just (TextureInfoCommand'ColorCorrection b) -> b
              _ -> False

          revisedInfoCmds = filter (not . isReflectionType) $
                            filter (not . isColorCorrection) infoCmds

      filename <- whitespaces >> manyTill anyChar (try $ lookAhead space)
      return (filename, ReflectionMap (handleTexInfo revisedInfoCmds) correction refl)

    bumpMap :: Parser (FilePath, TextureMap)
    bumpMap = try $ do
      infoCmds <- whitespaces >> (string "bump" <|> string "map_bump") >> parseTexOpts
      let isBumpMultiplier (TextureInfoCommand'BumpMultiplier _) = True
          isBumpMultiplier _ = False

          bumpMultiplier =
            case find isBumpMultiplier infoCmds of
              Just (TextureInfoCommand'BumpMultiplier m) -> m
              _ -> 1.0

          revisedInfoCmds = filter (not . isBumpMultiplier) infoCmds
      filename <- whitespaces >> manyTill anyChar (try $ lookAhead space)
      return (filename, BumpMap (handleTexInfo revisedInfoCmds) bumpMultiplier)

    decalMap :: Parser (FilePath, TextureMap)
    decalMap = try $ do
      texture <- DecalMap . handleTexInfo <$> (whitespaces >> string "decal" >> parseTexOpts)
      filename <- whitespaces >> manyTill anyChar (try $ lookAhead space)
      return (filename, texture)

    dispMap :: Parser (FilePath, TextureMap)
    dispMap = try $ do
      texture <- DisplacementMap . handleTexInfo <$> (whitespaces >> string "disp" >> parseTexOpts)
      filename <- whitespaces >> manyTill anyChar (try $ lookAhead space)
      return (filename, texture)

    texMap :: Parser TextureMapCommand
    texMap =
      (TextureMapCommand'Ambient <$> colorMap "map_Ka") <|>
      (TextureMapCommand'Diffuse <$> colorMap "map_Kd") <|>
      (TextureMapCommand'Specular <$> colorMap "map_Ks") <|>
      (TextureMapCommand'SpecularExponent <$> colorMap "map_Ns") <|>
      (TextureMapCommand'Dissolve <$> colorMap "map_d") <|>
      (TextureMapCommand'Reflection  <$> reflectionMap) <|>
      (TextureMapCommand'Decal <$> decalMap) <|>
      (TextureMapCommand'Disp <$> dispMap) <|>
      (TextureMapCommand'Bump <$> bumpMap)

    parseTexMaps :: Parser [TextureMapCommand]
    parseTexMaps = many $ texMap >>= (\x -> finishLine >> return x)

    material :: Parser MTL
    material = try $ do
      name <- many finishLine >> string "newmtl" >> whitespaces >> manyTill anyChar (try finishLine)
      illumCmds <- parseIllum
      texMapCmds <- parseTexMaps
      return $ constructMaterial name illumCmds texMapCmds

parseMTL :: FilePath -> IO [MTL]
parseMTL filepath = do
  s <- readFile filepath
  case parse parseFile filepath (pack s) of
    Left x -> error $ show x
    Right x -> return $ x

loadMTL :: FilePath -> IO [MTL]
loadMTL = parseMTL
