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-27 23:36:54 +00:00
|
|
|
nvg <- createGL3 (S.fromList [Antialias, 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
|
2018-03-03 16:03:17 +00:00
|
|
|
mmiscbox1 <- createImage nvg (FileName "assets/misc/box1.png") 0
|
2018-03-31 21:22:10 +00:00
|
|
|
mmisctable1 <- createImage nvg (FileName "assets/misc/table1.png") 0
|
|
|
|
mmisctable2 <- createImage nvg (FileName "assets/misc/table2.png") 0
|
2018-04-11 18:01:41 +00:00
|
|
|
mmisctable3 <- createImage nvg (FileName "assets/misc/table3.png") 0
|
|
|
|
mmisctable4 <- createImage nvg (FileName "assets/misc/table4.png") 0
|
2018-03-31 21:22:10 +00:00
|
|
|
mmisctableC <- createImage nvg (FileName "assets/misc/tableCorner.png") 0
|
2018-03-01 22:33:08 +00:00
|
|
|
_ <- createFont nvg "bedstead"
|
|
|
|
(FileName "assets/font/Bedstead-Semicondensed.ttf")
|
2018-03-03 16:03:17 +00:00
|
|
|
let mimgs = [ mwallasc, mwalldesc,
|
2018-02-27 19:35:08 +00:00
|
|
|
mwallcornern, mwallcornere, mwallcorners, mwallcornerw,
|
2018-03-03 16:03:17 +00:00
|
|
|
mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross,
|
2018-03-31 21:22:10 +00:00
|
|
|
mmiscbox1,
|
2018-04-11 18:01:41 +00:00
|
|
|
mmisctable1, mmisctable2, mmisctable3, mmisctable4, mmisctableC
|
2018-03-03 16:03:17 +00:00
|
|
|
]
|
|
|
|
when (any isNothing mimgs) $ do
|
2018-03-31 21:22:10 +00:00
|
|
|
logIO Error "Failed to load image assets"
|
2018-02-25 09:30:13 +00:00
|
|
|
exitFailure
|
2018-03-03 16:03:17 +00:00
|
|
|
let imgs = zipWith (\a b -> (a, fromJust b)) [ImgWallAsc ..] mimgs
|
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-03-03 16:03:17 +00:00
|
|
|
imgs
|
2018-03-01 22:33:08 +00:00
|
|
|
, assetFonts = M.fromList
|
|
|
|
[ (FontBedstead, "bedstead")
|
|
|
|
]
|
2018-02-07 00:18:16 +00:00
|
|
|
, nano = nvg
|
|
|
|
, uuid = []
|
2018-02-24 14:33:46 +00:00
|
|
|
, worldState = ws
|
2018-02-17 01:36:06 +00:00
|
|
|
, stateData = None
|
2018-02-07 00:18:16 +00:00
|
|
|
}
|