Monadius-0.99: src/Recorder.hs

-- | a replay recording system.
module Recorder (
  Recorder(..),
  initialRecorder,
  RecorderMode(..),
  encode2,
  decode,
  ) where

import           Game
import           Graphics.UI.GLUT
import           Monadius
import           Util

data Recorder = Recorder{
      keybuf           :: [[Key]],
      preEncodedKeyBuf :: [Int],
      mode             :: RecorderMode,
      gameBody         :: Monadius,
      age              :: Int,
      isQuitRequested  :: Bool}

data RecorderMode = Play | Playback | Record
                    deriving (Eq,Show)

instance Game Recorder where
  update = updateRecorder
  render = renderRecorder
  isGameover = recorderIsGameover

encode2 :: [Int] -> String
encode2 = show . reverse

encodeKeySet :: [Key] -> Int
encodeKeySet keys = sum $ map (\i->if (importantKeys!!i) `elem` keys then 2^i else 0) [0..(length importantKeys-1)]

decode :: String -> [[Key]]
decode str = map decodeKeySet (read str :: [Int])

decodeKeySet :: Int -> [Key]
decodeKeySet num = extract num importantKeys where
  extract 0 _     = []
  extract _ []    = []
  extract i (c:cs) = (if i `mod` 2 == 1 then [c] else []) ++ extract (i `div` 2) cs

importantKeys :: [Key]
importantKeys = [shotButton,missileButton,powerUpButton,upButton,downButton,leftButton,rightButton,selfDestructButton]

initialRecorder :: RecorderMode -> [[Key]] -> Monadius -> Recorder
initialRecorder initialMode keyss initialGame = Recorder{
  keybuf = if initialMode == Playback then keyss ++ repeat [] else [],
  preEncodedKeyBuf = [],
  mode = initialMode,
  gameBody = initialGame,
  age=0,
  isQuitRequested = False }

updateRecorder::[Key]->Recorder->Recorder
updateRecorder keys me = me{
  --keybuf = (if mode me == Record then (++ [keys]) else id) $ keybuf me,
  preEncodedKeyBuf = (if mode me == Record then (encodeKeySet keys:) else id) $ preEncodedKeyBuf me,
  gameBody = (if mode me /= Playback then update keys else update (keybuf me!!age me)) $ gameBody me,
  age = age me + 1,
  isQuitRequested = (mode me == Playback && (selfDestructButton `elem` keys || Char ' ' `elem` keys)) || isQuitRequested me
}

renderRecorder :: Recorder -> IO ()
renderRecorder me = do
  (putDebugStrLn.show.mode) me
  if age me==0 || mode me /= Record then return () else preservingMatrix $ do
    translate (Vector3 300 (-230) (0::GLdouble))
    scale 0.1 0.1 (0.1 :: GLdouble)
    color (Color3 0.4  0.4 (0.4 :: GLdouble))
    renderString Roman $ show $ (head.preEncodedKeyBuf) me

  render $ gameBody me

recorderIsGameover :: Recorder -> Bool
recorderIsGameover me = (isGameover . gameBody) me || isQuitRequested me