tracer/src/Init.hs
2018-06-08 00:29:46 +02:00

173 lines
5.8 KiB
Haskell

{-# 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 NanoVG.Internal.Image (ImageFlags(..))
import Linear hiding (E(..))
import Codec.Picture as CP
import Codec.Picture.Extra
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 Data.ByteString.Lazy (toStrict)
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
subs <- Subsystems
<$> (Window <$> newTVarIO [])
<*> (Mouse <$> newTVarIO [])
_ <- glewInit
nvg <- createGL3 (S.fromList [Antialias, StencilStrokes])
_ <- createFont nvg "bedstead"
(FileName "assets/font/Bedstead-Semicondensed.ttf")
(ws, _) <- yieldSystemT (0, defStorage) (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
mmisctable1 <- createImage nvg (FileName "assets/misc/table1.png") 0
mmisctable2 <- createImage nvg (FileName "assets/misc/table2.png") 0
mmisctable3 <- createImage nvg (FileName "assets/misc/table3.png") 0
mmisctable4 <- createImage nvg (FileName "assets/misc/table4.png") 0
mmisctableC <- createImage nvg (FileName "assets/misc/tableCorner.png") 0
let mimgs = [ mwallasc, mwalldesc,
mwallcornern, mwallcornere, mwallcorners, mwallcornerw,
mwalltne, mwalltse, mwalltsw, mwalltnw, mwallcross,
mmiscbox1,
mmisctable1, mmisctable2, mmisctable3, mmisctable4, mmisctableC
]
when (any isNothing mimgs) $ do
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)
playerWalking <- loadAnimationSprites "assets/intruder.png" nvg
(zip walkIds walkConfigs)
return UserData
{ state = Menu
, subsystems = subs
, assetImages = M.fromList imgs
, assetAnimations = M.fromList
(playerStanding ++ playerWalking)
, assetFonts = M.fromList
[ (FontBedstead, "bedstead")
]
, nano = nvg
, uuid = []
, worldState = ws
, stateData = None
}
loadAnimationSprites
:: FilePath -- Path to Sprite map
-> Context -- NanoVG context
-> [(AnimId, AnimationConfig)]
-> IO [(AnimId, Animation)]
loadAnimationSprites fp nvg idconfs = do
eimg <- readImage fp
case eimg of
Left err -> do
logIO Error err
exitFailure
Right dimg -> do
let img = convertRGBA8 dimg
mapM
(\(id, (AnimationConfig (xoffs, yoffs) (w, h) count dur pb)) -> do
let crs = map
(\i -> crop (xoffs + (i * w)) yoffs w h img)
[0 .. (count - 1)]
mresimgs <- mapM
(\cr ->
createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr))
crs
imgs <- if any isNothing mresimgs
then do
logIO Error ("failed to load: " ++ fp ++ " " ++ show id)
exitFailure
else
return $ catMaybes mresimgs
return $
( id
, Animation dur imgs pb
)
) idconfs
loadPlayerSprite
:: FilePath -- Path to spritemap
-> Int -- width of single sprite
-> Int -- height of single sprite
-> Context -- Nanovg context
-> [(Int, [ImgId])] -- [(picture row, Image IDs)]
-> IO [(ImgId, NanoVG.Image)]
loadPlayerSprite fp w h nvg rids = do
eimg <- readImage fp
case eimg of
Left err -> do
logIO Error err
exitFailure
Right dimg -> do
let img = convertRGBA8 dimg
ret <- mapM (\(row, ids) -> do
mapM (\(num, id) -> do
let cr = crop (num * w) (row * h) w h img
mresimg <-
createImageMem nvg (ImagePremultiplied) (toStrict $ encodePng cr)
case mresimg of
Nothing -> do
logIO Error ("Failed to load: " ++ fp ++ " " ++ show id)
exitFailure
Just resimg -> return (id, resimg)
) (zip [0..] ids)
) rids
return $ concat ret