module Sound.MED.Raw.MMDARexx where

import qualified Sound.MED.Raw.MMDARexxTrigCmd as MMDARexxTrigCmd
import Sound.MED.Raw.MMDARexxTrigCmd(MMDARexxTrigCmd)

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

data MMDARexx = MMDARexx
  { MMDARexx -> UWORD
reserved   :: UWORD
  , MMDARexx -> UWORD
trigcmdlen :: UWORD
  , MMDARexx -> Maybe MMDARexxTrigCmd
trigcmd    :: Maybe MMDARexxTrigCmd
  }
  deriving (Int -> MMDARexx -> ShowS
[MMDARexx] -> ShowS
MMDARexx -> String
(Int -> MMDARexx -> ShowS)
-> (MMDARexx -> String) -> ([MMDARexx] -> ShowS) -> Show MMDARexx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MMDARexx] -> ShowS
$cshowList :: [MMDARexx] -> ShowS
show :: MMDARexx -> String
$cshow :: MMDARexx -> String
showsPrec :: Int -> MMDARexx -> ShowS
$cshowsPrec :: Int -> MMDARexx -> ShowS
Show)

{-# SPECIALISE peek :: PTR -> StorableReader MMDARexx #-}
{-# SPECIALISE peek :: PTR -> ByteStringReader MMDARexx #-}
peek :: (Reader m) => PTR -> m MMDARexx
peek :: PTR -> m MMDARexx
peek PTR
p = do
  UWORD
reserved'   <- Peek m UWORD
forall (m :: * -> *). Reader m => Peek m UWORD
peekUWORD (PTR
pPTR -> PTR -> PTR
forall a. Num a => a -> a -> a
+PTR
0)
  UWORD
trigcmdlen' <- Peek m UWORD
forall (m :: * -> *). Reader m => Peek m UWORD
peekUWORD (PTR
pPTR -> PTR -> PTR
forall a. Num a => a -> a -> a
+PTR
2)
  PTR
trigcmd'''  <- Peek m PTR
forall (m :: * -> *). Reader m => Peek m PTR
peekPTR   (PTR
pPTR -> PTR -> PTR
forall a. Num a => a -> a -> a
+PTR
4)
  Maybe MMDARexxTrigCmd
trigcmd'    <- PTR -> m MMDARexxTrigCmd
forall (m :: * -> *). Reader m => PTR -> m MMDARexxTrigCmd
MMDARexxTrigCmd.peek (PTR -> m MMDARexxTrigCmd) -> PTR -> m (Maybe MMDARexxTrigCmd)
forall (m :: * -> *) a.
Monad m =>
(PTR -> m a) -> PTR -> m (Maybe a)
$? PTR
trigcmd'''
  MMDARexx -> m MMDARexx
forall (m :: * -> *) a. Monad m => a -> m a
return (MMDARexx -> m MMDARexx) -> MMDARexx -> m MMDARexx
forall a b. (a -> b) -> a -> b
$ UWORD -> UWORD -> Maybe MMDARexxTrigCmd -> MMDARexx
MMDARexx
    UWORD
reserved' UWORD
trigcmdlen' Maybe MMDARexxTrigCmd
trigcmd'