unmed2-0.0: src/MEDTempo.hs

module MEDTempo (
  MEDTempo(..),
  Mode(..),
  song0Tempo,
  song2Tempo,

  update,
  toTime,
  ) where

import MEDBlock (Cmd, Val)

import qualified MMD0Song
import qualified MMD2Song

import Amiga

import Data.Bits (testBit, (.&.))

data MEDTempo = MEDTempo
  { mode :: Mode,
    primary, secondary :: Int
  }

data Mode = Speed | BPM {linesPerBeat :: Int}

tempoMode :: UBYTE -> Mode
tempoMode flags =
  if testBit flags 5
    then BPM $ fromIntegral (flags .&. 0x1F) + 1
    else Speed

song0Tempo :: MMD0Song.MMD0Song -> MEDTempo
song0Tempo song =
  MEDTempo
    { mode = tempoMode $ MMD0Song.flags2 song
    , primary = fromIntegral $ MMD0Song.deftempo song
    , secondary = fromIntegral $ MMD0Song.tempo2 song
    }

song2Tempo :: MMD2Song.MMD2Song -> MEDTempo
song2Tempo song =
  MEDTempo
    { mode = tempoMode $ MMD2Song.flags2 song
    , primary = fromIntegral $ MMD2Song.deftempo song
    , secondary = fromIntegral $ MMD2Song.tempo2 song
    }


{- |
Interpret tempo related commands.
-}
update :: MEDTempo -> (Cmd, Val) -> MEDTempo
update tempo (cmd,val) =
  case cmd of
    0x09 -> tempo{secondary = max 1 $ fromIntegral val}
    0x0F ->
      if 0 < val && val < 0xF0
        then tempo{primary = fromIntegral val}
        else tempo
    _ -> tempo


toTime :: Fractional a => MEDTempo -> a
toTime (MEDTempo mode_ tempo1 tempo2) =
  timeFromPrimary mode_ tempo1 * fromIntegral tempo2

-- numbers taken from uade/amigasrc/players/med/common/proplayer.a
ciabFreq :: Fractional a => a
ciabFreq = 715909

timerDiv :: Fractional a => a
timerDiv = 474326

sttempo :: Fractional a => a
sttempo = 2416.3

timeFromPrimary :: Fractional a => Mode -> Int -> a
timeFromPrimary mode_ tempo =
  case mode_ of
    BPM lpb -> 60 / (fromIntegral tempo * 6 * fromIntegral lpb)
    Speed ->
      if tempo<=10
        then fromIntegral tempo * sttempo / ciabFreq
        else timerDiv / (ciabFreq * fromIntegral tempo)