hw/examples/example03/Util.hs

module Util where

import Codec.Wavefront

import Control.Monad (sequence)

import SDL (($=))

import qualified Graphics.Rendering.OpenGL as GL
import qualified Graphics.GLUtil as GLU

import qualified Data.Vector as V

import Debug.Trace

data LoadedObject = LoadedObject
  { loTriangles :: [Float]
  , loLines     :: [Float]
  , loPoints    :: [Float]
  , loLocations :: [Float]
  , loTexTri    :: Maybe [Float]
  } deriving (Show)

loadObj :: WavefrontOBJ -> LoadedObject
loadObj obj =
  LoadedObject ts ls ps locs tritex
  where
    inter = objLocations obj
    interTex = objTexCoords obj
    faces = map elValue (V.toList $ objFaces obj)
    lns = map elValue (V.toList $ objLines obj)
    points = map elValue (V.toList $ objPoints obj)
    deface (Face a b c []) =
      map (\i -> inter V.! (faceLocIndex i -1)) [a, b, c]
    deface _ =
      error "loadObj: obj with quads encountered"
    deline (Line a b) =
      map (\i -> inter V.! (lineLocIndex i -1)) [a, b]
    depoint (Point i) = inter V.! (i - 1)
    tsLocs = concatMap deface faces
    lsLocs = concatMap deline lns
    psLocs = map depoint points
    deLoc (Location x y z w) = [x, y, z, w]
    deTex (TexCoord r s _) = [r, s]
    ts = concatMap deLoc tsLocs
    ls = concatMap deLoc lsLocs
    ps = concatMap deLoc psLocs
    locs = concatMap deLoc (V.toList inter)
    defaceTex :: Face -> Maybe [TexCoord]
    defaceTex (Face a b c []) =
      mapM
      (fmap (\x -> interTex V.! (x - 1)) . faceTexCoordIndex)
      [a, b, c]
    defaceTex _ =
      error "loadObj: obj with quads encountered"
    tritex :: Maybe [Float]
    tritex = concatMap deTex <$> mftxs
    mftxs :: Maybe [TexCoord]
    mftxs = fmap concat (mapM defaceTex faces)

-- objLocsToPtr :: WavefrontOBJ -> IO (Ptr Float, Int)
-- objLocsToPtr obj = do
--   let ivs = objLocations obj
--       faces = map elValue $ V.toList $ objFaces obj
--       vs = concatMap
--         (\(Face a b c []) ->
--           map (\i -> ivs V.! ((faceLocIndex i) - 1)) [a, b, c])
--         faces
--   ptr <- newArray $ concatMap (\(Location x y z w) -> [x, y, z, w]) vs
--   return (ptr, length vs)
-- 
-- objUVsToPtr :: WavefrontOBJ -> IO (Ptr Float, Int)
-- objUVsToPtr obj = do
--   let uvs= V.toList $ objTexCoords obj
--   ptr <- newArray $ concatMap (\(TexCoord r s t) -> [r, s, t]) uvs
--   return (ptr, length uvs)

loadTex :: FilePath -> IO GL.TextureObject
loadTex f = do
  t <- either error id <$> GLU.readTexture f
  GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
  GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge)
  return t