tracer/src/Load.hs

module Load where

import Affection as A

import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Monad (when)

import qualified Data.Map as M
import Data.Ecstasy
import Data.Maybe

import System.Exit (exitFailure)

import NanoVG hiding (V2(..))

-- internal imports

import Types
import Test
import Util

loadLoad :: Affection UserData ()
loadLoad = do
  ud <- getAffection
  progress <- liftIO $ newMVar 0
  future <- liftIO $ newEmptyMVar
  _ <- liftIO $ forkIO $ loadFork (worldState ud) (nano ud) future progress
  putAffection ud
    { stateMVar = future
    , stateProgress = progress
    , state = Load
    }

loadFork
  :: (SystemState Entity IO)
  -> Context
  -> MVar (SystemState Entity IO, StateData)
  -> MVar Float
  -> IO ()
loadFork ws nvg future progress = do
  let stateSteps = 20
      increment = 1 / stateSteps
  _ <- createFont nvg "bedstead"
    (FileName "assets/font/Bedstead-Semicondensed.ttf")
  modifyMVar_ progress (return . (+ increment))
  mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0
  modifyMVar_ progress (return . (+ increment))
  mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0
  modifyMVar_ progress (return . (+ increment))
  mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0
  modifyMVar_ progress (return . (+ increment))
  mmisctable1 <- createImage nvg (FileName "assets/misc/table1.png") 0
  modifyMVar_ progress (return . (+ increment))
  mmisctable2 <- createImage nvg (FileName "assets/misc/table2.png") 0
  modifyMVar_ progress (return . (+ increment))
  mmisctable3 <- createImage nvg (FileName "assets/misc/table3.png") 0
  modifyMVar_ progress (return . (+ increment))
  mmisctable4 <- createImage nvg (FileName "assets/misc/table4.png") 0
  modifyMVar_ progress (return . (+ increment))
  mmisctableC <- createImage nvg (FileName "assets/misc/tableCorner.png") 0
  modifyMVar_ progress (return . (+ increment))
  let mimgs = [ mwallasc, mwalldesc,
       mwallcornern, mwallcornere, mwallcorners, mwallcornerw,
        mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross,
        mmiscbox1,
        mmisctable1, mmisctable2, mmisctable3, mmisctable4, mmisctableC
        ]
  when (any isNothing mimgs) $ do
    liftIO $logIO Error "Failed to load image assets"
    exitFailure
  -- playerImgs <- loadPlayerSprite "assets/intruder.png" 64 74 nvg
  --   (zipWith (\a b -> (a, [b])) [0..] $ [ImgIntrE .. ImgIntrN] ++ [ImgIntrNE])
  let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs
      directions = [E .. N] ++ [NE]
      standIds = map (AnimId 0 "standing") directions
      walkIds = map (AnimId 0 "walking") directions
      standConfigs = map
        (\i -> AnimationConfig (0, i * 74) (64, 74) 1 0 APLoop)
        [0 .. length standIds - 1]
      walkConfigs = map
        (\i -> AnimationConfig (64, i * 74) (64, 74) 6 1.5 APLoop)
        [0 .. length walkIds - 1]
  playerStanding <- loadAnimationSprites "assets/intruder.png" nvg
    (zip standIds standConfigs)
  liftIO $modifyMVar_ progress (return . (+ increment))
  playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
    (zip walkIds walkConfigs)
  modifyMVar_ progress (return . (+ increment))
  putMVar future
    ( ws
    , LoadData
      { loadAssetImages = M.fromList imgs
      , loadAssetAnims  = M.fromList
        (playerStanding ++ playerWalking)
      , loadAssetFonts  = M.fromList
        [ (FontBedstead, "bedstead")
        ]
      }
    )

drawLoad :: Affection UserData ()
drawLoad = do
  ud <- getAffection
  let ctx = nano ud
  progress <- liftIO $ readMVar (stateProgress ud)
  liftIO $ drawLoadScreen ud progress

updateLoad :: Double -> Affection UserData ()
updateLoad _ = do
  ud <- getAffection
  mwsld <- liftIO $ tryTakeMVar (stateMVar ud)
  case mwsld of
    Just (_, ld) -> do
      liftIO $ logIO A.Debug "loaded assets, entering menu"
      putAffection ud
        { assetImages     = loadAssetImages ld
        , assetAnimations = loadAssetAnims ld
        , assetFonts      = loadAssetFonts ld
        , state           = Menu
        , stateData       = None
        }
      loadMap
    Nothing -> do
      return ()