module Graphics.Glyph.ObjLoader where

import Control.Monad
import Data.Array
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Either
import Data.List.Split
import qualified Data.Map as M
import Debug.Trace
import Graphics.Glyph.BufferBuilder
import Graphics.Glyph.Util
import System.IO

data ObjectFile a = ObjectFile [ObjectStatement a]

data ObjectStatement a
  = Nop
  | VertexStatement (a, a, a)
  | TextureStatement (a, a)
  | VertexNormalStatement (a, a, a)
  | UseMaterialStatement (String)
  | MaterialLibraryStatement String
  | FaceStatement [(Int, Int, Int)]
  deriving (Show)

foldl2 :: a -> [b] -> (a -> b -> a) -> a
foldl2 a b c = foldl c a b

isNop :: ObjectStatement a -> Bool
isNop x = case x of
  Nop -> True
  _ -> False

isVertex :: ObjectStatement a -> Bool
isVertex (VertexStatement _) = True
isVertex _ = False

isNormal :: ObjectStatement a -> Bool
isNormal (VertexNormalStatement _) = True
isNormal _ = False

isTexture :: ObjectStatement a -> Bool
isTexture (TextureStatement _) = True
isTexture _ = False

basicBuildObject :: (Floating b, IsModelBuilder b a) => ObjectFile b -> a ()
basicBuildObject (ObjectFile list) =
  let fromList lst = listArray (0, length lst -1) lst
   in -- Set up the lists as arrays for fast access
      let vertexList =
            fromList $
              map
                ( \stmt ->
                    case stmt of
                      (VertexStatement v) -> v
                      _ -> (0, 0, 0)
                )
                (filter isVertex list)
       in let normalList =
                fromList $
                  map
                    ( \stmt ->
                        case stmt of
                          (VertexNormalStatement v) -> v
                          _ -> (0, 0, 0)
                    )
                    (filter isNormal list)
           in let textureList =
                    fromList $
                      map
                        ( \stmt ->
                            case stmt of
                              (TextureStatement v) -> v
                              _ -> (0, 0)
                        )
                        (filter isTexture list)
               in forM_ list $ \stmt ->
                    case stmt of
                      (FaceStatement arr) ->
                        forM_ arr $ \(a, b, c) -> do
                          when (c >= 0) (uncurry3 plotNormal $ normalList ! (c -1))
                          when (b >= 0) (uncurry plotTexture $ textureList ! (b -1))
                          when (a >= 0) (uncurry3 plotVertex3 $ vertexList ! (a -1))
                      _ -> return ()

loadObjFromBytestring :: (Read b) => L.ByteString -> ([String], ObjectFile b)
loadObjFromBytestring _contents =
  let contents :: [L.ByteString]; contents = C.split '\n' _contents
   in let mys2n str = case str of
            "" -> -1
            _ -> read str
       in let s2t s = case splitOn "/" s of
                [a, b, c] -> Just (mapT3 mys2n (a, b, c))
                [a, b] -> Just (mapT3 mys2n (a, b, ""))
                [a] -> Just (mapT3 mys2n (a, "", ""))
                _ -> Nothing
           in let compiled =
                    map
                      ( \(num, line) -> case words $ C.unpack line of
                          [] -> Right Nop -- This is an empty line
                          (('#' : _) : _) -> Right Nop -- This is a comment, so use a 'nop'
                          ("o" : _) -> Right Nop -- Not really of use
                          ["v", x, y, z] -> Right $ VertexStatement ((read x), (read y), (read z))
                          ["vt", x, y] -> Right $ TextureStatement ((read x), (read y))
                          ["vn", x, y, z] -> Right $ VertexNormalStatement ((read x), (read y), (read z))
                          ["usemtl", mtl] -> Right $ UseMaterialStatement mtl
                          ["mtllib", lib] -> Right $ MaterialLibraryStatement lib
                          ("f" : _tail) -> case mapM s2t _tail of
                            Just lst -> Right $ FaceStatement lst
                            _ -> Left $ foldl (++) "" ["Syntax error in face value on line ", show num, " `", C.unpack line, "'"]
                          _ -> Left $ foldl (++) "" ["Unrecognized Sequence on line ", show num, " `", C.unpack line, "'"]
                      )
                      (zip [(1 :: Int) ..] contents)
               in (lefts compiled, ObjectFile (filter (not . isNop) $ rights compiled))

loadObjFromHandle :: (Read b) => Handle -> IO ([String], ObjectFile b)
loadObjFromHandle = loadObjFromHandleWithFilter id

loadObjFromHandleWithFilter :: (Read b) => (L.ByteString -> L.ByteString) -> Handle -> IO ([String], ObjectFile b)
loadObjFromHandleWithFilter _filter handle =
  liftM (loadObjFromBytestring . _filter) (L.hGetContents handle)

loadObjFile :: (Read b) => FilePath -> IO ([String], ObjectFile b)
loadObjFile = loadObjFileWithFilter id

loadObjFileWithFilter :: (Read b) => (L.ByteString -> L.ByteString) -> FilePath -> IO ([String], ObjectFile b)
loadObjFileWithFilter filt path = loadObjFromHandleWithFilter filt =<< openFile path ReadMode