module Sound.MED.Raw.SampleInstr where

import Sound.MED.Basic.Amiga
import Sound.MED.Basic.Utility

data SampleInstr = SampleInstr
  { SampleInstr -> WORD
octaves :: WORD
  , SampleInstr -> Either [[BYTE]] [[WORD]]
chans :: Either [[BYTE]] [[WORD]]
  }
  deriving Int -> SampleInstr -> ShowS
[SampleInstr] -> ShowS
SampleInstr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SampleInstr] -> ShowS
$cshowList :: [SampleInstr] -> ShowS
show :: SampleInstr -> String
$cshow :: SampleInstr -> String
showsPrec :: Int -> SampleInstr -> ShowS
$cshowsPrec :: Int -> SampleInstr -> ShowS
Show

{-# SPECIALISE peek :: ULONG -> WORD -> Bool -> Bool -> PTR -> StorableReader SampleInstr #-}
{-# SPECIALISE peek :: ULONG -> WORD -> Bool -> Bool -> PTR -> ByteStringReader SampleInstr #-}
peek :: (Reader m) => ULONG -> WORD -> Bool -> Bool -> PTR -> m SampleInstr
peek :: forall (m :: * -> *).
Reader m =>
ULONG -> WORD -> Bool -> Bool -> ULONG -> m SampleInstr
peek ULONG
len' WORD
stype' Bool
s16' Bool
stereo' ULONG
p = do
  let octaves' :: WORD
octaves' = [WORD
1,WORD
5,WORD
3,WORD
2,WORD
4,WORD
6,WORD
7,WORD
9]forall a. [a] -> Int -> a
!!forall a b. (Integral a, Num b) => a -> b
fromIntegral WORD
stype'
  case (Bool
s16',Bool
stereo') of
    (Bool
False, Bool
False) -> do { [BYTE]
dat'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). Reader m => Peek m BYTE
peekBYTE forall a b. (a -> b) -> a -> b
$ forall i. Integral i => ULONG -> ULONG -> i -> [ULONG]
pointerRangeGen (ULONG
pforall a. Num a => a -> a -> a
+ULONG
6) ULONG
1 ULONG
len'             ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WORD -> Either [[BYTE]] [[WORD]] -> SampleInstr
SampleInstr WORD
octaves' forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [[BYTE]
dat''] }
    (Bool
True,  Bool
False) -> do { [WORD]
dat'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). Reader m => Peek m WORD
peekWORD forall a b. (a -> b) -> a -> b
$ forall i. Integral i => ULONG -> ULONG -> i -> [ULONG]
pointerRangeGen (ULONG
pforall a. Num a => a -> a -> a
+ULONG
6) ULONG
2 (ULONG
len'forall a. Integral a => a -> a -> a
`div`ULONG
2)     ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WORD -> Either [[BYTE]] [[WORD]] -> SampleInstr
SampleInstr WORD
octaves' forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right [[WORD]
dat''] }
    (Bool
False, Bool
True ) -> do { [BYTE]
dat'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). Reader m => Peek m BYTE
peekBYTE forall a b. (a -> b) -> a -> b
$ forall i. Integral i => ULONG -> ULONG -> i -> [ULONG]
pointerRangeGen (ULONG
pforall a. Num a => a -> a -> a
+ULONG
6) ULONG
1 (ULONG
2forall a. Num a => a -> a -> a
*ULONG
len')         ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WORD -> Either [[BYTE]] [[WORD]] -> SampleInstr
SampleInstr WORD
octaves' forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall i a. Integral i => i -> [a] -> [[a]]
chunk ULONG
len' [BYTE]
dat'') }
    (Bool
True,  Bool
True ) -> do { [WORD]
dat'' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). Reader m => Peek m WORD
peekWORD forall a b. (a -> b) -> a -> b
$ forall i. Integral i => ULONG -> ULONG -> i -> [ULONG]
pointerRangeGen (ULONG
pforall a. Num a => a -> a -> a
+ULONG
6) ULONG
2 (ULONG
2forall a. Num a => a -> a -> a
*(ULONG
len'forall a. Integral a => a -> a -> a
`div`ULONG
2)) ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WORD -> Either [[BYTE]] [[WORD]] -> SampleInstr
SampleInstr WORD
octaves' forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall i a. Integral i => i -> [a] -> [[a]]
chunk (ULONG
len'forall a. Integral a => a -> a -> a
`div`ULONG
2) [WORD]
dat'') }