nyx-game-0.1.0.0: app/VN.hs

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE DuplicateRecordFields  #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module VN where

import SDL.Vect (V4(..))
import qualified SDL
import qualified SDL.Mixer as Mix
import qualified SDL.Font as SDLF
import qualified Play.Engine.MySDL.MySDL as MySDL

import Data.Maybe
import Control.Monad.Except
import Control.Lens
import System.Random
import Play.Engine
import qualified Play.Engine.Load as Load
import qualified Control.Monad.State as SM
import qualified Data.Map as M

import qualified Script
import qualified Play.Engine.Sprite as Spr


data State
  = State
  { _bg :: Spr.Sprite
  , _resources :: MySDL.Resources
  , _script :: Script.Script
  , _camera :: Int
  , _isPause :: !Bool
  , _pauseChanged :: !Bool
  , _isMute :: !Bool
  , _hudFont :: SDLF.Font
  , _exit :: !Bool
  }

makeFieldsNoPrefix ''State

wantedAssets :: [(String, MySDL.ResourceType FilePath)]
wantedAssets =
  [ ("bg", MySDL.Texture "VNBG.png")
  , ("unispace", MySDL.Font "unispace/unispace.ttf")
  ]

make :: Int -> Script.ScriptData -> Scene
make t sd = Load.mkState t (wantedAssets ++ Script.assets sd) (mkState $ Script.script sd)

mkState
  :: (MySDL.Resources -> Script.Script)
  -> MySDL.Resources -> Result Scene
mkState scrpt rs = do
  state <- initState (scrpt rs) rs
  pure $ mkScene
    state
    update
    render

initState :: Script.Script -> MySDL.Resources -> Result State
initState scrpt rs = do
  case (,) <$> M.lookup "bg" (MySDL.textures rs) <*> M.lookup "unispace" (MySDL.fonts rs) of
    Nothing ->
      throwError ["Texture not found: bg ot unispace"]
    Just (bgt, font) -> do
      pure $ State
        { _bg =
          fromJust
            $ Spr.make
            $ Spr.MakeArgs
            { mkActionmap = ["normal"]
            , mkAction = "normal"
            , mkTexture = bgt
            , mkSize = Point 800 1000
            , mkMaxPos = 8
            , mkSpeed = 8
            }
        , _resources = rs
        , _script = scrpt
        , _camera = 0
        , _isPause = False
        , _pauseChanged = False
        , _isMute = False
        , _hudFont = font
        , _exit = False
        }

update :: Input -> State -> Result (StackCommand, State)
update input st = do
  _wSize <- _windowSize <$> SM.get
  ismute <- _muteMusic <$> SM.get
  let
    state = set isMute ismute st

  (acts, script') <- Script.update input Nothing mempty (state ^. script)

  let
    newState =
      state'
        & set script script'
        & over camera
          (\c ->
             if
               | c <= 0 && Script.shake acts -> 60
               | c <= 0 -> 0
               | otherwise -> c - 1
          )
      where
        state' =
          if Script.stopTheWorld acts
            then
              state
            else
              state
                & over bg
                ( case Script.changeSprite acts of
                    Nothing -> Spr.update Nothing False
                    Just sp -> const sp
                )

  if
    | keyReleased KeyP input && state ^. isPause -> do
      pure (None, set pauseChanged True $ set isPause False state)
    | keyReleased KeyP input && not (state ^. isPause) -> do
      pure (None, set pauseChanged True $ set isPause True state)
    | state ^. isPause -> do
      pure (None, state)
    | keyReleased KeyQuit input -> do
      pure (None, set exit True state)
    | state ^. exit -> do
      pure (Done, state)
    | otherwise ->
      pure (Script.command acts, newState)

render :: SDL.Renderer -> State -> IO ()
render renderer state = do
  cam' <- Point <$> randomRIO (-1, 1) <*> randomRIO (-1, 1) :: IO FPoint
  let cam = addPoint $ fmap (floor . (*) (fromIntegral $ state ^. camera `div` 3)) cam'
  Spr.render renderer cam (Point 0 0) (state ^. bg . size) 255 (state ^. bg)

  when (state ^. isMute) $
    renderText renderer (state ^. hudFont) (Point 40 30) "MUTED"

  Script.render renderer cam (state ^. script)
  renderText renderer (state ^. hudFont) (Point 900 30) "MUTED"

  when (state ^. isPause) $ do
    let rect = toRect (cam $ Point 342 375) (Point 85 35)
    SDL.rendererDrawColor renderer SDL.$= V4 40 0 30 180
    SDL.fillRect renderer (Just rect)
    renderText renderer (state ^. hudFont) (Point 352 380) "PAUSE"

  when (state ^. pauseChanged) $
    if (state ^. isPause)
      then
        Mix.pauseMusic
      else
        Mix.resumeMusic

  when (state ^. exit) $
    Mix.haltMusic