pituicat/src/Types/Player.hs

{-# LANGUAGE OverloadedStrings #-}
module Types.Player where

import Affection as A

import Linear

import qualified Data.Vector as V

import Data.String (fromString)

-- internal imports

import Util

import Classes.Graphics.Drawable
import Classes.Graphics.Bindable
import Classes.Prop
import Classes.Actor
import Classes.Physics

import Types.Graphics.VertexBuffer
import Types.Texture

data Pituicat = Pituicat
  { pcPos  :: V2 Double
  , pcVel :: V2 Double
  , pcAcc :: V2 Double
  , pcHealth :: Int
  , pcTexture :: Texture
  , pcGrounded :: Bool
  }
  deriving (Eq, Show)

instance Drawable Pituicat where

  toVertices (Pituicat (V2 x y) _ _ _ _ _) =
    ( V.fromList [0, 1, 2, 2, 3, 0]
    , V.fromList
      [ newVertex
        (V3 (realToFrac x - 25) (realToFrac y - 25) 0)
        (V4 1 1 1 1)
        (V2 0 (1 - 50 / 1024))
        1
      , newVertex
        (V3 (realToFrac x + 25) (realToFrac y - 25) 0)
        (V4 1 1 1 1)
        (V2 (50 / 1024) (1 - 50 / 1024))
        1
      , newVertex
        (V3 (realToFrac x + 25) (realToFrac y + 25) 0)
        (V4 1 1 1 1)
        (V2 (50 / 1024) 1)
        1
      , newVertex
        (V3 (realToFrac x - 25) (realToFrac y + 25) 0)
        (V4 1 1 1 1)
        (V2 0 1)
        1
      ]
    )

instance Prop Pituicat where

  residentLayer _ = 0

  bindPropTexture = bind . pcTexture

instance Actor Pituicat where

  perform dt p =
    let physCat = (accelerate dt . gravitate constG)
          (p {pcAcc = 0})
        (V2 _ dy) = pcVel physCat
        finalCat = physCat
          { pcGrounded = pcGrounded physCat || (dy < 0 && abs dy < 2)
          }
    in
      (A.log Debug ("moving with " <> fromString (show $ pcVel finalCat))) finalCat

instance Mass Pituicat where

  mass _ = 1

  acceleration = pcAcc

  accelerationUpdater cat =
    (\accel -> cat
      { pcAcc = accel
      }
      )

  velocity = pcVel

  velocityUpdater cat =
    (\vel -> cat
      { pcVel = vel
      }
      )

  position = pcPos

  positionUpdater cat =
    (\pos -> cat
      { pcPos = pos
      }
      )

instance Collidible Pituicat where

  boundary _ =
    ( V2 (-25) (-25)
    , V2 25 25
    )

  collide cat other =
    A.log
      Debug
      ("*boing* meow! other: " <>
        fromString (show other))
      (let ncat = (elasticCollision 0.3 cat other)
           (V2 _ dy) = pcVel ncat
      in
        ncat
          { pcGrounded = dy > 0 && abs dy < 2
          }
        )