tracer/src/Load.hs

module Load where

import Affection as A

import qualified SDL
import Graphics.Rendering.OpenGL.GL.FlushFinish (finish)

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

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

import System.Exit (exitFailure)

import NanoVG hiding (V2(..))

-- internal imports

import Menu.Connect
import Types
import Util

loadLoad :: Affection UserData ()
loadLoad = do
  ad <- A.get
  ud <- getAffection
  progress <- liftIO $ newMVar (0, "Starting up")
  future <- liftIO newEmptyMVar
  _ <- liftIO $ createFont (nano ud) "bedstead"
    (FileName "assets/font/Bedstead-Semicondensed.ttf")
  _ <- liftIO $ forkIO $
    loadFork
      (worldState ud)
      (fromJust $ window ud)
      (fromJust $ threadContext ud)
      (nano ud)
      future
      progress
  SDL.glMakeCurrent (fromJust $ window ud) (glContext ad)
  putAffection ud
    { stateMVar = future
    , stateProgress = progress
    , state = Load
    , assetFonts  = M.fromList
      [ (FontBedstead, "bedstead")
      ]
    }

loadFork
  :: SystemState Entity (AffectionState (AffectionData UserData) IO)
  -> SDL.Window
  -> SDL.GLContext
  -> Context
  -> MVar
    ( SystemState Entity (AffectionState (AffectionData UserData) IO)
    , StateData
    )
  -> MVar (Float, T.Text)
  -> IO ()
loadFork ws win glc nvg future progress = do
  let stateSteps = 57
      increment = 1 / stateSteps
  SDL.glMakeCurrent win glc
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading icon \"conntroller_blue\""
    )))
  mcontrblue <- createImage nvg (FileName "assets/icons/controller_blue.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading icon \"controller_blue\""
    )))
  mcontrgreen <- createImage nvg (FileName "assets/icons/controller_green.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading icon \"controller_green\""
    )))
  mkbdblue <- createImage nvg (FileName "assets/icons/keyboard_blue.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading icon \"keyboard_blue\""
    )))
  mkbdgreen <- createImage nvg (FileName "assets/icons/keyboard_green.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading icon \"keyboard_green\""
    )))
  marrow <- createImage nvg (FileName "assets/icons/arrow.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_asc\""
    )))
  mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_desc\""
    )))
  mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_corner_n\""
    )))
  mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_corner_e\""
    )))
  mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_corner_s\""
    )))
  mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_corner_w\""
    )))
  mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_t_ne\""
    )))
  mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_t_se\""
    )))
  mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_t_sw\""
    )))
  mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_t_nw\""
    )))
  mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"wall_cross\""
    )))
  mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"box1\""
    )))
  mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableSW\""
    )))
  mtableSW <- createImage nvg (FileName "assets/table/tableSW.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableSE\""
    )))
  mtableSE <- createImage nvg (FileName "assets/table/tableSE.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableNE\""
    )))
  mtableNE <- createImage nvg (FileName "assets/table/tableNE.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableNW\""
    )))
  mtableNW <- createImage nvg (FileName "assets/table/tableNW.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableC1\""
    )))
  mtablec1 <- createImage nvg (FileName "assets/table/tablec1.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableC2\""
    )))
  mtablec2 <- createImage nvg (FileName "assets/table/tablec2.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableC3\""
    )))
  mtablec3 <- createImage nvg (FileName "assets/table/tablec3.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableC4\""
    )))
  mtablec4 <- createImage nvg (FileName "assets/table/tablec4.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"tableCorner\""
    )))
  mtableC <- createImage nvg (FileName "assets/table/tableCorner.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"flipchart\""
    )))
  mmiscFlipchart <- createImage nvg (FileName "assets/misc/flipchart.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"plant1\""
    )))
  mmiscPlant1 <- createImage nvg (FileName "assets/misc/plant1.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"plant2\""
    )))
  mmiscPlant2 <- createImage nvg (FileName "assets/misc/plant2.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"watercooler\""
    )))
  mmiscWatercooler <- createImage nvg (FileName "assets/misc/watercooler.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"vending machine\""
    )))
  mmiscVending <- createImage nvg (FileName "assets/misc/vending.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"Cabinet with Coffee machine SW\""
    )))
  mcabCoffeeSW <- createImage nvg (FileName "assets/cabinet/cabCoffeeSW.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"Cabinet with Coffee machine SE\""
    )))
  mcabCoffeeSE <- createImage nvg (FileName "assets/cabinet/cabCoffeeSE.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"Cabinet with sink SW\""
    )))
  mcabSinkSW <- createImage nvg (FileName "assets/cabinet/cabSinkSW.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"Cabinet with sink SE\""
    )))
  mcabSinkSE <- createImage nvg (FileName "assets/cabinet/cabSinkSE.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"Cabinet with stove SW\""
    )))
  mcabStoveSW <- createImage nvg (FileName "assets/cabinet/cabStoveSW.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"Cabinet with stove SE\""
    )))
  mcabStoveSE <- createImage nvg (FileName "assets/cabinet/cabStoveSE.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"cabinet SW\""
    )))
  mcabinetSW <- createImage nvg (FileName "assets/cabinet/cabinetSW.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"cabinet SE\""
    )))
  mcabinetSE <- createImage nvg (FileName "assets/cabinet/cabinetSE.png") 0
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading asset \"cabinet corner\""
    )))
  mcabinetCorner <- createImage nvg (FileName "assets/cabinet/cabinetCorner.png") 0
  let micons =
        [ mcontrblue, mcontrgreen, mkbdblue, mkbdgreen, marrow
        ]
  when (any isNothing micons) $ do
    liftIO $logIO Error "Failed to load icon assets"
    exitFailure
  let mimgs =
        [ mwallasc, mwalldesc
        , mwallcornern, mwallcornere, mwallcorners, mwallcornerw
        , mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross
        , mmiscbox1
        , mtableSW, mtableNW, mtableNE, mtableSE, mtableC
        , mtablec1, mtablec2, mtablec3, mtablec4
        , mmiscFlipchart
        , mmiscPlant1, mmiscPlant2
        , mmiscWatercooler, mmiscVending
        , mcabCoffeeSW, mcabCoffeeSE
        , mcabSinkSW, mcabSinkSE
        , mcabStoveSW, mcabStoveSE
        , mcabinetSW, mcabinetSE, mcabinetCorner
        ]
  when (any isNothing mimgs) $ do
    liftIO $logIO Error "Failed to load image assets"
    exitFailure
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"intruder: standing\""
    )))
  -- 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
        .. ImgCabinetCorner
        ]
        mimgs
      icons = zipWith (\a b -> (a, fromJust b))
        [ IconContrBlue
        .. IconArrow
        ]
        micons
      directions = [E .. N] ++ [NE]
      standIds var = map (AnimId var "standing") directions
      walkIds var = map (AnimId var "walking") directions
      standConfigs = map
        (\i -> AnimationConfig (0, i * 74) (64, 74) (64, 0) 1 0 APLoop)
        [0 .. length (standIds AnimIntruder) - 1]
      walkConfigs = map
        (\i -> AnimationConfig (64, i * 74) (64, 74) (64, 0) 6 1.5 APLoop)
        [0 .. length (walkIds AnimIntruder) - 1]
  playerStanding <- loadAnimationSprites "assets/intruder.png" nvg
    (zip (standIds AnimIntruder) standConfigs)
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"intruder: walking\""
    )))
  playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
    (zip (walkIds AnimIntruder) walkConfigs)
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"jdoem: standing\""
    )))
  jdoemStanding <- loadAnimationSprites "assets/jdoem.png" nvg
    (zip (standIds AnimJDoeM) standConfigs)
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"jdoem: walking\""
    )))
  jdoemWalking <- loadAnimationSprites "assets/jdoem.png" nvg
    (zip (walkIds AnimJDoeM) walkConfigs)
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"copier: stand\""
    )))
  copierStand <- loadAnimationSprites "assets/misc/copier.png" nvg $ zip
    (map (\name -> AnimId AnimCopier name N) ["closed", "open"])
    (map
      (\i -> AnimationConfig (0, i * 74) (64, 74) (0, 0) 1 0 APLoop)
      [0, 1]
    )
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"copier: copy\""
    )))
  copierCopy <- loadAnimationSprites "assets/misc/copier.png" nvg
    [ ( AnimId AnimCopier "copy" N
      , AnimationConfig (64, 0) (64, 74) (64, 0) 4 1 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"cornerComputer: off\""
    )))
  cornerComputerOff <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
    [ ( AnimId AnimComputer "off" N
      , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"cornerComputer: on\""
    )))
  cornerComputerOn <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
    [ ( AnimId AnimComputer "on" N
      , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"cornerComputer: hack\""
    )))
  cornerComputerHack <- loadAnimationSprites "assets/misc/tableCornerComputer.png" nvg
    [ ( AnimId AnimComputer "hack" N
      , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"neComputer: off\""
    )))
  neComputerOff <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg
    [ ( AnimId AnimComputer "off" NE
      , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"neComputer: on\""
    )))
  neComputerOn <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg
    [ ( AnimId AnimComputer "on" NE
      , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"neComputer: hack\""
    )))
  neComputerHack <- loadAnimationSprites "assets/misc/tableSWComputer.png" nvg
    [ ( AnimId AnimComputer "hack" NE
      , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"nwComputer: off\""
    )))
  nwComputerOff <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg
    [ ( AnimId AnimComputer "off" NW
      , AnimationConfig (0, 0) (64, 74) (64, 0) 2 2 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"nwComputer: on\""
    )))
  nwComputerOn <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg
    [ ( AnimId AnimComputer "on" NW
      , AnimationConfig (128, 0) (64, 74) (0, 0) 1 0 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"nwComputer: hack\""
    )))
  nwComputerHack <- loadAnimationSprites "assets/misc/tableSEComputer.png" nvg
    [ ( AnimId AnimComputer "hack" NW
      , AnimationConfig (0, 74) (64, 74) (64, 0) 4 2 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"toilet: free\""
    )))
  toiletFree <- loadAnimationSprites "assets/misc/toilet.png" nvg
    [ ( AnimId AnimToilet "free" N
      , AnimationConfig (0, 0) (64, 74) (0, 0) 1 0 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"toilet: occupied\""
    )))
  toiletOccupied <- loadAnimationSprites "assets/misc/toilet.png" nvg
    [ ( AnimId AnimToilet "occupied" N
      , AnimationConfig (64, 0) (64, 74) (0, 0) 1 0 APLoop
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"neDoor0: open\""
    )))
  neDoor0open <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg
    [ ( AnimId AnimDoor0 "open" NE
      , AnimationConfig (0, 0) (64, 74) (0, 74) 5 0.25 APOnce
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"neDoor0: shut\""
    )))
  neDoor0shut <- loadAnimationSprites "assets/doors/door_desc_0.png" nvg
    [ ( AnimId AnimDoor0 "shut" NE
      , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 0.25 APOnce
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"nwDoor0: open\""
    )))
  nwDoor0open <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg
    [ ( AnimId AnimDoor0 "open" NW
      , AnimationConfig (0, 0) (64, 74) (0, 74) 5 0.25 APOnce
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Loading Animation \"nwDoor0: shut\""
    )))
  nwDoor0shut <- loadAnimationSprites "assets/doors/door_asc_0.png" nvg
    [ ( AnimId AnimDoor0 "shut" NW
      , AnimationConfig (0, 4*74) (64, 74) (0, -74) 5 0.25 APOnce
      )
    ]
  modifyMVar_ progress (return . (\(p, _) ->
    ( p + increment
    , "Handing over"
    )))
  finish
  putMVar future
    ( ws
    , LoadData
      { loadAssetImages = M.fromList imgs
      , loadAssetAnims  = M.fromList
        ( playerStanding ++
          playerWalking ++
          jdoemStanding ++
          jdoemWalking ++
          copierStand ++
          copierCopy ++
          cornerComputerOff ++
          cornerComputerOn ++
          cornerComputerHack ++
          neComputerOff ++
          neComputerOn ++
          neComputerHack ++
          nwComputerOff ++
          nwComputerOn ++
          nwComputerHack ++
          toiletFree ++
          toiletOccupied ++
          neDoor0shut ++
          neDoor0open ++
          nwDoor0shut ++
          nwDoor0open
        )
      , loadAssetIcons  = M.fromList icons
      }
    )

drawLoad :: Affection UserData ()
drawLoad = do
  ud <- getAffection
  progress <- liftIO $ readMVar (stateProgress ud)
  liftIO $ do
    logIO A.Verbose ("LoadProgress: " ++ show progress)
    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
        , assetIcons      = loadAssetIcons ld
        -- , state           = Main WorldMap
        -- , state           = Menu Connect
        , stateData       = None
        }
      -- loadMap
      loadMenu
    Nothing ->
      return ()