{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BinaryLiterals #-}

module Utmyen.Model.Type where

import           Data.Bits
import           Data.ByteString
import           Data.Serialize hiding (encode)
import           Data.Vector (Vector)
import qualified Data.Vector as V
import           Data.Word

data Model = Model
  { modelPoints :: Vector Point
  , modelTris   :: Vector Word64
  } deriving (Eq, Show)

data Point = Point
  { ptX, ptY, ptZ, ptA, ptB, ptC, ptU, ptV :: Float
  } deriving (Eq, Show)

match :: Bits t => t -> t -> Bool
match mask el = mask .&. el == mask

encode :: Model -> ByteString
encode m = runPut (rModel m)

rInt :: Word64 -> Put
rInt n
  | n <= 0x7f = putWord8 (fromIntegral n)
  | n <= 0x3fff = do
      putWord8 (fromIntegral (n `shift` (-8)) .|. 0x80)
      putWord8 (fromIntegral n)
  | n <= 0x1fffff = do
      putWord8 (fromIntegral (n `shift` (-16)) .|. 0xc0)
      putWord8 (fromIntegral (n `shift` (-8)))
      putWord8 (fromIntegral n)
  | otherwise = error "XXX finish me"

pInt :: Get Word64
pInt = do
  n <- getWord8
  if | match 0b11111111 n -> go 8 0
     | match 0b11111110 n -> go 7 0
     | match 0b11111100 n -> go 6 (fromIntegral (n .&. 0b00000001))
     | match 0b11111000 n -> go 5 (fromIntegral (n .&. 0b00000011))
     | match 0b11110000 n -> go 4 (fromIntegral (n .&. 0b00000111))
     | match 0b11100000 n -> go 3 (fromIntegral (n .&. 0b00001111))
     | match 0b11000000 n -> go 2 (fromIntegral (n .&. 0b00011111))
     | match 0b10000000 n -> go 1 (fromIntegral (n .&. 0b00111111))
     | otherwise          -> go 0 (fromIntegral n)
  where go :: Int -> Word64 -> Get Word64
        go 0 r = return r
        go n r = do
          w <- getWord8
          go (n-1) (r `shift` 8 .|. fromIntegral w)

getSeveral :: Get a -> Get (Vector a)
getSeveral getter = do
  size <- fromIntegral <$> pInt
  V.generateM size (const getter)

rSeveral :: (t -> Put) -> Vector t -> Put
rSeveral putter vec = do
  rInt (fromIntegral (V.length vec))
  sequence_ (fmap putter vec)

getModel :: Get Model
getModel = do
  tris <- getSeveral pInt
  pts  <- getSeveral pPt
  return (Model pts tris)

rModel :: Model -> Put
rModel (Model pts tris) = do
  rSeveral rInt tris
  rSeveral rPt pts

pPt :: Get Point
pPt = Point <$> pF <*> pF <*> pF <*> pF <*> pF <*> pF <*> pU <*> pU

rPt :: Point -> Put
rPt (Point x y z a b c u v) = do
  mapM_ rF [x, y, z, a, b, c]
  mapM_ rU [u, v]

pF :: Get Float
pF = do
  b1 <- getWord8
  if testBit b1 7 then do
    b2 <- getWord8
    let cVal :: Word16 = (clearBit (fromIntegral b1) 7 `shift` 8) .|. fromIntegral b2
    return (fromIntegral cVal / 102.0 - 128.0)
  else
    return (fromIntegral b1 - 32.0)

rF :: Float -> Put
rF f
  | truncate (f * 100) == (truncate f :: Int) * 100
    && f >= -32.0 && f <= 95.0 =
      putWord8 (truncate (f + 32.0))
  | otherwise = do
      let ws :: Word16 = truncate ((f + 128.0) * 102.0)
          l1 = fromIntegral (ws `shift` (-8)) .|. 0x80
          l2 = fromIntegral ws
      putWord8 l1
      putWord8 l2

pU :: Get Float
pU = do
  b <- getWord8
  return (fromIntegral b / 255.0)

rU :: Float -> Put
rU f
  | f < 0.0 || f > 255.0 = error "float out of range"
  | otherwise = putWord8 $ floor (f * 255.0)
