{-# LANGUAGE TemplateHaskell #-}

module Rattletrap.Type.Rotation
  ( Rotation(..)
  )
where

import Rattletrap.Type.Common
import Rattletrap.Type.Quaternion
import Rattletrap.Type.CompressedWordVector

data Rotation
  = RotationCompressedWordVector CompressedWordVector
  | RotationQuaternion Quaternion
  deriving (Rotation -> Rotation -> Bool
(Rotation -> Rotation -> Bool)
-> (Rotation -> Rotation -> Bool) -> Eq Rotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rotation -> Rotation -> Bool
$c/= :: Rotation -> Rotation -> Bool
== :: Rotation -> Rotation -> Bool
$c== :: Rotation -> Rotation -> Bool
Eq, Eq Rotation
Eq Rotation
-> (Rotation -> Rotation -> Ordering)
-> (Rotation -> Rotation -> Bool)
-> (Rotation -> Rotation -> Bool)
-> (Rotation -> Rotation -> Bool)
-> (Rotation -> Rotation -> Bool)
-> (Rotation -> Rotation -> Rotation)
-> (Rotation -> Rotation -> Rotation)
-> Ord Rotation
Rotation -> Rotation -> Bool
Rotation -> Rotation -> Ordering
Rotation -> Rotation -> Rotation
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 :: Rotation -> Rotation -> Rotation
$cmin :: Rotation -> Rotation -> Rotation
max :: Rotation -> Rotation -> Rotation
$cmax :: Rotation -> Rotation -> Rotation
>= :: Rotation -> Rotation -> Bool
$c>= :: Rotation -> Rotation -> Bool
> :: Rotation -> Rotation -> Bool
$c> :: Rotation -> Rotation -> Bool
<= :: Rotation -> Rotation -> Bool
$c<= :: Rotation -> Rotation -> Bool
< :: Rotation -> Rotation -> Bool
$c< :: Rotation -> Rotation -> Bool
compare :: Rotation -> Rotation -> Ordering
$ccompare :: Rotation -> Rotation -> Ordering
$cp1Ord :: Eq Rotation
Ord, Int -> Rotation -> ShowS
[Rotation] -> ShowS
Rotation -> String
(Int -> Rotation -> ShowS)
-> (Rotation -> String) -> ([Rotation] -> ShowS) -> Show Rotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rotation] -> ShowS
$cshowList :: [Rotation] -> ShowS
show :: Rotation -> String
$cshow :: Rotation -> String
showsPrec :: Int -> Rotation -> ShowS
$cshowsPrec :: Int -> Rotation -> ShowS
Show)

$(deriveJson ''Rotation)