{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.Vector
  ( Vector(..)
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.CompressedWord

data Vector = Vector
  { Vector -> CompressedWord
vectorSize :: CompressedWord
  , Vector -> Word
vectorBias :: Word
  -- ^ This field is guaranteed to be small. In other words, it won't overflow.
  -- It's stored as a regular 'Word' rather than something more precise like a
  -- 'Word8' because it just gets passed to a functions that expect 'Word's.
  -- There's no reason to do a bunch of conversions.
  , Vector -> Int
vectorX :: Int
  -- ^ See 'vectorBias'.
  , Vector -> Int
vectorY :: Int
  -- ^ See 'vectorBias'.
  , Vector -> Int
vectorZ :: Int
  -- ^ See 'vectorBias'.
  } deriving (Vector -> Vector -> Bool
(Vector -> Vector -> Bool)
-> (Vector -> Vector -> Bool) -> Eq Vector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vector -> Vector -> Bool
$c/= :: Vector -> Vector -> Bool
== :: Vector -> Vector -> Bool
$c== :: Vector -> Vector -> Bool
Eq, Eq Vector
Eq Vector
-> (Vector -> Vector -> Ordering)
-> (Vector -> Vector -> Bool)
-> (Vector -> Vector -> Bool)
-> (Vector -> Vector -> Bool)
-> (Vector -> Vector -> Bool)
-> (Vector -> Vector -> Vector)
-> (Vector -> Vector -> Vector)
-> Ord Vector
Vector -> Vector -> Bool
Vector -> Vector -> Ordering
Vector -> Vector -> Vector
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Vector -> Vector -> Vector
$cmin :: Vector -> Vector -> Vector
max :: Vector -> Vector -> Vector
$cmax :: Vector -> Vector -> Vector
>= :: Vector -> Vector -> Bool
$c>= :: Vector -> Vector -> Bool
> :: Vector -> Vector -> Bool
$c> :: Vector -> Vector -> Bool
<= :: Vector -> Vector -> Bool
$c<= :: Vector -> Vector -> Bool
< :: Vector -> Vector -> Bool
$c< :: Vector -> Vector -> Bool
compare :: Vector -> Vector -> Ordering
$ccompare :: Vector -> Vector -> Ordering
$cp1Ord :: Eq Vector
Ord, Int -> Vector -> ShowS
[Vector] -> ShowS
Vector -> String
(Int -> Vector -> ShowS)
-> (Vector -> String) -> ([Vector] -> ShowS) -> Show Vector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector] -> ShowS
$cshowList :: [Vector] -> ShowS
show :: Vector -> String
$cshow :: Vector -> String
showsPrec :: Int -> Vector -> ShowS
$cshowsPrec :: Int -> Vector -> ShowS
Show)

$(deriveJson ''Vector)