module MEDBlock where

import qualified MMD0Block
import qualified MMD0NoteData
import qualified MMD1Block
import qualified MMD1NoteData
import qualified BlockInfo
import qualified BlockCmdPageTable
import qualified CmdPageData

import Human
import Amiga (stringFromBytes)

import Text.Printf(printf)
import Control.Monad(liftM2)
import Data.Bits(shiftR, (.&.))
import Data.Maybe(catMaybes)

type Note      = Int
type Inst      = Int
type Cmd       = Int
type Val       = Int
type Highlight = Bool
type Line      = ( Maybe Highlight, [ ( Note, Inst, [ ( Cmd, Val ) ] ) ])

data MEDBlock = MEDBlock
  { name    :: Maybe String
  , tracks  :: Int
  , lines   :: Int
  , pages   :: Int
  , seqdata :: [ Line ]
  }

medblock0 :: MMD0Block.MMD0Block -> MEDBlock
medblock0 b =
  let name'       = Nothing
      tracks'     = fromIntegral $ MMD0Block.numtracks b
      lines'      = fromIntegral $ MMD0Block.lines     b + 1
      pages'      = 1
      highlights' = repeat Nothing
      f           = fromIntegral
      g (MMD0NoteData.MMD0NoteData n i c v) = (f n, f i, [(f c, f v)])
      notedata'   = map (map g) (MMD0Block.notedata b)
      seqdata'    = zip highlights' notedata'
  in MEDBlock name' tracks' lines' pages' seqdata'


medblock1 :: MMD1Block.MMD1Block -> MEDBlock
medblock1 b =
  let i           = MMD1Block.info b
      name'       = fmap stringFromBytes $ BlockInfo.blockname =<< i
      tracks'     = fromIntegral $ MMD1Block.numtracks b
      lines'      = fromIntegral $ MMD1Block.lines     b + 1
      pages'      = case BlockInfo.pagetable =<< i of
        Nothing -> 1
        Just pt -> 1 + (length . catMaybes $ BlockCmdPageTable.pages pt)
      hlbit h bpos = ((h `shiftR` bpos) .&. 1) == 1
      hlbits h    = map (hlbit h) [0..31]
      highlights' = case BlockInfo.hlmask =<< i of
        Nothing -> repeat Nothing
        Just hl -> map Just $ concatMap hlbits $ hl
      fI          = fromIntegral
      nd (MMD1NoteData.MMD1NoteData n j c v) = (fI n, fI j, [(fI c, fI v)])
      notedata'   = map (map nd) (MMD1Block.notedata b)
      cv (CmdPageData.CmdPageData c v) = (fI c, fI v)
      cmddata'    = case BlockInfo.pagetable =<< i of
        Nothing -> []
        Just pt -> map (map (map cv)) (catMaybes (BlockCmdPageTable.pages pt))
      p (c,v) (n,j,cvs) = (n, j, cvs ++ [(c,v)])
      ncdata'     = foldr (zipWith (zipWith p)) notedata' cmddata'
      seqdata'    = zip highlights' ncdata'
  in MEDBlock name' tracks' lines' pages' seqdata'


instance Human MEDBlock where
  human b =
    let name' = maybe "" (' ':) $ name b
        dim'  = printf "%d*%d*%d" (MEDBlock.lines b) (tracks b) (pages b)
        seq'  = unlines (zipWith highlightLine [0..] (seqdata b))
    in dim' ++ name' ++ "\n" ++ seq'

highlightLine :: Int -> Line -> String
highlightLine i (highlight, ds) =
  let bLine = humanLine i ds
  in if highlight == Just True then bold bLine else bLine

humanLine :: Int -> [ ( Note, Inst, [ ( Cmd, Val ) ] ) ] -> String
humanLine i ds =
  let mapWords fmt = concatMap (' ':) . map fmt
      hCV (c, v) = printf "%02X%02X" c v
      hTrack (n, j, cvs) = printf "%s %02X%s" (notes!!n) j (mapWords hCV cvs)
  in  printf "%04X:%s" i (mapWords hTrack ds)

notes :: [String]
notes =
  "---" :
  liftM2 (flip (printf "%s%1X"))
    [(1::Int) ..]
    ["C-","C#","D-","D#","E-","F-","F#","G-","G#","A-","A#","B-"]