module Sound.MED.Generic.PlaySeq where

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

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

import Sound.MED.Basic.Human(Human(human))
import Sound.MED.Basic.Utility(stringFromBytes)

import qualified Data.List as List

data MEDPlaySeq = MEDPlaySeq
  { MEDPlaySeq -> String
name :: String
  , MEDPlaySeq -> [Int]
indices :: [Int] -- ^ block indices
  }

playSeq0 :: MMD0Song -> MEDPlaySeq
playSeq0 :: MMD0Song -> MEDPlaySeq
playSeq0 MMD0Song
song =
  String -> [Int] -> MEDPlaySeq
MEDPlaySeq String
"" ([Int] -> MEDPlaySeq) -> [Int] -> MEDPlaySeq
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (UWORD -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UWORD -> Int) -> UWORD -> Int
forall a b. (a -> b) -> a -> b
$ MMD0Song -> UWORD
MMD0Song.songlen MMD0Song
song) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
  (UBYTE -> Int) -> [UBYTE] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([UBYTE] -> [Int]) -> [UBYTE] -> [Int]
forall a b. (a -> b) -> a -> b
$ MMD0Song -> [UBYTE]
MMD0Song.playseq MMD0Song
song

playSeq2 :: PlaySeq -> MEDPlaySeq
playSeq2 :: PlaySeq -> MEDPlaySeq
playSeq2 PlaySeq
pseq =
  MEDPlaySeq :: String -> [Int] -> MEDPlaySeq
MEDPlaySeq
    { name :: String
name = [UBYTE] -> String
stringFromBytes (PlaySeq -> [UBYTE]
PlaySeq.name PlaySeq
pseq)
    , indices :: [Int]
indices = (UWORD -> Int) -> [UWORD] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map UWORD -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PlaySeq -> [UWORD]
PlaySeq.seq PlaySeq
pseq)
    }

instance Human MEDPlaySeq where
  human :: MEDPlaySeq -> String
human (MEDPlaySeq String
name' [Int]
indices') =
    (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
name' then String
"playseq" else String
name') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int]
indices')