tracer/src/Init.hs

76 lines
2.2 KiB
Haskell
Raw Normal View History

2018-02-07 00:18:16 +00:00
{-# 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
2018-02-25 09:30:13 +00:00
import Control.Monad (when)
2018-02-07 00:18:16 +00:00
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
2018-02-25 09:30:13 +00:00
import Data.Maybe
import System.Exit (exitFailure)
2018-02-07 00:18:16 +00:00
import Foreign.C.Types (CInt(..))
import Types
2018-02-15 18:42:07 +00:00
import Floorplan
import Debug.Trace
2018-02-07 00:18:16 +00:00
foreign import ccall unsafe "glewInit"
glewInit :: IO CInt
load :: IO UserData
load = do
_ <- glewInit
2018-02-18 03:11:12 +00:00
nvg <- createGL3 (S.fromList [StencilStrokes])
2018-02-07 00:18:16 +00:00
subs <- Subsystems
<$> (Window <$> newTVarIO [])
<*> (Mouse <$> newTVarIO [])
2018-02-25 01:03:25 +00:00
(ws, _) <- yieldSystemT (0, defWorld) (return ())
2018-02-27 19:35:08 +00:00
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
let mwalls = [ mwallasc, mwalldesc,
mwallcornern, mwallcornere, mwallcorners, mwallcornerw,
mwalltne, mwalltse, mwalltsw, mwalltnw,
mwallcross ]
when (any isNothing mwalls) $ do
logIO Error "Failed to load walls"
2018-02-25 09:30:13 +00:00
exitFailure
2018-02-27 19:35:08 +00:00
let walls = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mwalls
2018-02-07 00:18:16 +00:00
return UserData
{ state = Menu
, subsystems = subs
2018-02-25 09:30:13 +00:00
, assetImages = M.fromList
2018-02-27 19:35:08 +00:00
walls
2018-02-07 00:18:16 +00:00
, nano = nvg
, uuid = []
, worldState = ws
, stateData = None
2018-02-07 00:18:16 +00:00
}