{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ViewPatterns #-}
module Numeric.Quaternion.Internal
( Quaternion (..), Quater(Quater)
) where
import Numeric.DataFrame.Type (KnownBackend)
import Numeric.Matrix.Internal (Matrix)
import Numeric.PrimBytes (PrimBytes)
import Numeric.Vector.Internal (Vector)
import Text.Read
pattern Quater :: Quaternion t => t -> t -> t -> t -> Quater t
pattern $bQuater :: t -> t -> t -> t -> Quater t
$mQuater :: forall r t.
Quaternion t =>
Quater t -> (t -> t -> t -> t -> r) -> (Void# -> r) -> r
Quater a b c d <- (unpackQ# -> (# a, b, c, d #))
where
Quater = t -> t -> t -> t -> Quater t
forall t. Quaternion t => t -> t -> t -> t -> Quater t
packQ
{-# COMPLETE Quater #-}
class ( Floating (Quater t), Floating t, Ord t, PrimBytes t
, KnownBackend t '[3], KnownBackend t '[4]
, KnownBackend t '[3,3], KnownBackend t '[4, 4]
) => Quaternion t where
data Quater t
packQ :: t -> t -> t -> t -> Quater t
unpackQ# :: Quater t -> (# t, t, t, t #)
fromVecNum :: Vector t 3 -> t -> Quater t
fromVec4 :: Vector t 4 -> Quater t
toVec4 :: Quater t -> Vector t 4
square :: Quater t -> t
im :: Quater t -> Quater t
re :: Quater t -> Quater t
imVec :: Quater t -> Vector t 3
taker :: Quater t -> t
takei :: Quater t -> t
takej :: Quater t -> t
takek :: Quater t -> t
conjugate :: Quater t -> Quater t
rotScale :: Quater t -> Vector t 3 -> Vector t 3
getRotScale :: Vector t 3 -> Vector t 3 -> Quater t
axisRotation :: Vector t 3 -> t -> Quater t
qArg :: Quater t -> t
fromMatrix33 :: Matrix t 3 3 -> Quater t
fromMatrix44 :: Matrix t 4 4 -> Quater t
toMatrix33 :: Quater t -> Matrix t 3 3
toMatrix44 :: Quater t -> Matrix t 4 4
instance (Show t, Quaternion t, Ord t, Num t) => Show (Quater t) where
showsPrec :: Int -> Quater t -> ShowS
showsPrec Int
p (Quater t
x t
y t
z t
w)
= case ShowState
finS of
ShowState
SEmpty -> Char -> ShowS
showChar Char
'0'
ShowState
Simple -> ShowS
finF
ShowState
SParen -> Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
6) ShowS
finF
where
(ShowState
finS, ShowS
finF) = ShowState -> [(t, Maybe Char)] -> (ShowState, ShowS)
go ShowState
SEmpty
[(t
w, Maybe Char
forall a. Maybe a
Nothing), (t
x, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'i'), (t
y, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'j'), (t
z, Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'k')]
go :: ShowState -> [(t, Maybe Char)] -> (ShowState, ShowS)
go :: ShowState -> [(t, Maybe Char)] -> (ShowState, ShowS)
go ShowState
s ((t
v,Maybe Char
l):[(t, Maybe Char)]
xs)
| (ShowState
s0, ShowS
f0) <- ShowState -> t -> Maybe Char -> (ShowState, ShowS)
showComponent ShowState
s t
v Maybe Char
l
, (ShowState
s', ShowS
f') <- ShowState -> [(t, Maybe Char)] -> (ShowState, ShowS)
go ShowState
s0 [(t, Maybe Char)]
xs
= (ShowState
s', ShowS
f0 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
f')
go ShowState
s [] = (ShowState
s, ShowS
forall a. a -> a
id)
showLabel :: Maybe Char -> ShowS
showLabel Maybe Char
Nothing = ShowS
forall a. a -> a
id
showLabel (Just Char
c) = Char -> ShowS
showChar Char
c
showComponent :: ShowState -> t -> Maybe Char -> (ShowState, ShowS)
showComponent :: ShowState -> t -> Maybe Char -> (ShowState, ShowS)
showComponent ShowState
sState t
val Maybe Char
mLabel = case (ShowState
sState, t -> t -> Ordering
forall a. Ord a => a -> a -> Ordering
compare t
val t
0) of
(ShowState
_ , Ordering
EQ) -> ( ShowState
sState, ShowS
forall a. a -> a
id )
(ShowState
SEmpty, Ordering
GT) -> ( ShowState
Simple, t -> ShowS
forall a. Show a => a -> ShowS
shows t
val ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> ShowS
showLabel Maybe Char
mLabel )
(ShowState
SEmpty, Ordering
LT) -> ( ShowState
SParen, t -> ShowS
forall a. Show a => a -> ShowS
shows t
val ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> ShowS
showLabel Maybe Char
mLabel )
(ShowState
_ , Ordering
GT) -> ( ShowState
SParen
, String -> ShowS
showString String
" + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ShowS
forall a. Show a => a -> ShowS
shows t
val ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> ShowS
showLabel Maybe Char
mLabel )
(ShowState
_ , Ordering
LT) -> ( ShowState
SParen
, String -> ShowS
showString String
" - " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ShowS
forall a. Show a => a -> ShowS
shows (t -> t
forall a. Num a => a -> a
negate t
val) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> ShowS
showLabel Maybe Char
mLabel )
data ShowState = SEmpty | Simple | SParen
deriving ShowState -> ShowState -> Bool
(ShowState -> ShowState -> Bool)
-> (ShowState -> ShowState -> Bool) -> Eq ShowState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowState -> ShowState -> Bool
$c/= :: ShowState -> ShowState -> Bool
== :: ShowState -> ShowState -> Bool
$c== :: ShowState -> ShowState -> Bool
Eq
instance (Read t, Quaternion t, Num t) => Read (Quater t) where
readPrec :: ReadPrec (Quater t)
readPrec = ReadPrec (Quater t) -> ReadPrec (Quater t)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Quater t) -> ReadPrec (Quater t))
-> ReadPrec (Quater t) -> ReadPrec (Quater t)
forall a b. (a -> b) -> a -> b
$ ReadPrec t
forall a. Read a => ReadPrec a
readPrec ReadPrec t -> (t -> ReadPrec (Quater t)) -> ReadPrec (Quater t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (t -> t) -> t -> t -> t -> t -> t -> ReadPrec (Quater t)
go t -> t
forall a. a -> a
id t
0 t
0 t
0 t
0
where
go :: (t -> t) -> t -> t -> t -> t -> t -> ReadPrec (Quater t)
go :: (t -> t) -> t -> t -> t -> t -> t -> ReadPrec (Quater t)
go t -> t
f t
x t
y t
z t
w t
new =
let def :: ReadPrec (Quater t)
def = Quater t -> ReadPrec (Quater t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> t -> t -> t -> Quater t
forall t. Quaternion t => t -> t -> t -> t -> Quater t
Quater t
x t
y t
z (t -> t
f t
new))
withLabel :: Lexeme -> ReadPrec (Quater t)
withLabel Lexeme
EOF = ReadPrec (Quater t)
def
withLabel (Ident String
"i")
= (ReadPrec Lexeme
lexP ReadPrec Lexeme
-> (Lexeme -> ReadPrec (Quater t)) -> ReadPrec (Quater t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> t -> t -> t -> Lexeme -> ReadPrec (Quater t)
proceed (t -> t
f t
new) t
y t
z t
w) ReadPrec (Quater t) -> ReadPrec (Quater t) -> ReadPrec (Quater t)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
<++ Quater t -> ReadPrec (Quater t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> t -> t -> t -> Quater t
forall t. Quaternion t => t -> t -> t -> t -> Quater t
Quater (t -> t
f t
new) t
y t
z t
w)
withLabel (Ident String
"j")
= (ReadPrec Lexeme
lexP ReadPrec Lexeme
-> (Lexeme -> ReadPrec (Quater t)) -> ReadPrec (Quater t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> t -> t -> t -> Lexeme -> ReadPrec (Quater t)
proceed t
x (t -> t
f t
new) t
z t
w) ReadPrec (Quater t) -> ReadPrec (Quater t) -> ReadPrec (Quater t)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
<++ Quater t -> ReadPrec (Quater t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> t -> t -> t -> Quater t
forall t. Quaternion t => t -> t -> t -> t -> Quater t
Quater t
x (t -> t
f t
new) t
z t
w)
withLabel (Ident String
"k")
= (ReadPrec Lexeme
lexP ReadPrec Lexeme
-> (Lexeme -> ReadPrec (Quater t)) -> ReadPrec (Quater t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> t -> t -> t -> Lexeme -> ReadPrec (Quater t)
proceed t
x t
y (t -> t
f t
new) t
w) ReadPrec (Quater t) -> ReadPrec (Quater t) -> ReadPrec (Quater t)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
<++ Quater t -> ReadPrec (Quater t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> t -> t -> t -> Quater t
forall t. Quaternion t => t -> t -> t -> t -> Quater t
Quater t
x t
y (t -> t
f t
new) t
w)
withLabel Lexeme
l = t -> t -> t -> t -> Lexeme -> ReadPrec (Quater t)
proceed t
x t
y t
z (t -> t
f t
new) Lexeme
l
in (ReadPrec Lexeme
lexP ReadPrec Lexeme
-> (Lexeme -> ReadPrec (Quater t)) -> ReadPrec (Quater t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Lexeme -> ReadPrec (Quater t)
withLabel) ReadPrec (Quater t) -> ReadPrec (Quater t) -> ReadPrec (Quater t)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
<++ ReadPrec (Quater t)
def
proceed :: t -> t -> t -> t -> Lexeme -> ReadPrec (Quater t)
proceed :: t -> t -> t -> t -> Lexeme -> ReadPrec (Quater t)
proceed t
x t
y t
z t
w (Symbol String
"+") = ReadPrec t
forall a. Read a => ReadPrec a
readPrec ReadPrec t -> (t -> ReadPrec (Quater t)) -> ReadPrec (Quater t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (t -> t) -> t -> t -> t -> t -> t -> ReadPrec (Quater t)
go t -> t
forall a. a -> a
id t
x t
y t
z t
w
proceed t
x t
y t
z t
w (Symbol String
"-") = ReadPrec t
forall a. Read a => ReadPrec a
readPrec ReadPrec t -> (t -> ReadPrec (Quater t)) -> ReadPrec (Quater t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (t -> t) -> t -> t -> t -> t -> t -> ReadPrec (Quater t)
go t -> t
forall a. Num a => a -> a
negate t
x t
y t
z t
w
proceed t
x t
y t
z t
w Lexeme
EOF = Quater t -> ReadPrec (Quater t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> t -> t -> t -> Quater t
forall t. Quaternion t => t -> t -> t -> t -> Quater t
Quater t
x t
y t
z t
w)
proceed t
_ t
_ t
_ t
_ Lexeme
_ = ReadPrec (Quater t)
forall a. ReadPrec a
pfail
readListPrec :: ReadPrec [Quater t]
readListPrec = ReadPrec [Quater t]
forall a. Read a => ReadPrec [a]
readListPrecDefault
readList :: ReadS [Quater t]
readList = ReadS [Quater t]
forall a. Read a => ReadS [a]
readListDefault