tracer/src/Init.hs

{-# LANGUAGE ForeignFunctionInterface #-}

module Init where

import Affection as A

import SDL (($=))
import qualified SDL

import qualified Graphics.Rendering.OpenGL as GL

import NanoVG hiding (V2(..), V3(..))

import Linear

import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)

import Control.Concurrent.STM

import qualified Data.Set as S
import qualified Data.Map.Strict as M
import Data.Ecstasy
import Data.Maybe

import System.Exit (exitFailure)

import Foreign.C.Types (CInt(..))

import Types

import Floorplan

import Debug.Trace

foreign import ccall unsafe "glewInit"
  glewInit :: IO CInt

load :: IO UserData
load = do
  _ <- glewInit
  nvg <- createGL3 (S.fromList [Antialias, StencilStrokes])
  subs <- Subsystems
    <$> (Window <$> newTVarIO [])
    <*> (Mouse <$> newTVarIO [])
  (ws, _) <- yieldSystemT (0, defWorld) (return ())
  mwallasc <- createImage nvg (FileName "assets/walls/wall_asc.png") 0
  mwalldesc <- createImage nvg (FileName "assets/walls/wall_desc.png") 0
  mwallcornern <- createImage nvg (FileName "assets/walls/wall_corner_n.png") 0
  mwallcornere <- createImage nvg (FileName "assets/walls/wall_corner_e.png") 0
  mwallcorners <- createImage nvg (FileName "assets/walls/wall_corner_s.png") 0
  mwallcornerw <- createImage nvg (FileName "assets/walls/wall_corner_w.png") 0
  mwalltne <- createImage nvg (FileName "assets/walls/wall_t_ne.png") 0
  mwalltse <- createImage nvg (FileName "assets/walls/wall_t_se.png") 0
  mwalltsw <- createImage nvg (FileName "assets/walls/wall_t_sw.png") 0
  mwalltnw <- createImage nvg (FileName "assets/walls/wall_t_nw.png") 0
  mwallcross <- createImage nvg (FileName "assets/walls/wall_cross.png") 0
  mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0
  _ <- createFont nvg "bedstead"
    (FileName "assets/font/Bedstead-Semicondensed.ttf")
  let mimgs = [ mwallasc, mwalldesc,
        mwallcornern, mwallcornere, mwallcorners, mwallcornerw,
        mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross,
        mmiscbox1
        ]
  when (any isNothing mimgs) $ do
    logIO Error "Failed to load walls"
    exitFailure
  let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs
  return UserData
    { state       = Menu
    , subsystems  = subs
    , assetImages = M.fromList
      imgs
    , assetFonts  = M.fromList
      [ (FontBedstead, "bedstead")
      ]
    , nano        = nvg
    , uuid        = []
    , worldState  = ws
    , stateData   = None
    }