100 lines
2.4 KiB
Haskell
100 lines
2.4 KiB
Haskell
|
module Scenes.Test.Util where
|
||
|
|
||
|
import qualified Graphics.Rendering.OpenGL as GL
|
||
|
|
||
|
import Linear
|
||
|
|
||
|
import qualified Data.Vector as V
|
||
|
import qualified Data.Vector.Storable as VS
|
||
|
|
||
|
import Control.Arrow ((***))
|
||
|
|
||
|
-- internal imports
|
||
|
|
||
|
import Classes
|
||
|
import Types
|
||
|
|
||
|
testLevelDesc :: LevelDescriptor
|
||
|
testLevelDesc = LevelDescriptor
|
||
|
[ (0, "res/maps/00_test/00_test.bmp")
|
||
|
]
|
||
|
0
|
||
|
"res/tiles/00_test/00_test.png"
|
||
|
(3, 3)
|
||
|
|
||
|
createQuad :: V2 GL.GLfloat -> Int -> [Vertex]
|
||
|
createQuad (V2 x y) index =
|
||
|
[ newVertex
|
||
|
(V3 x y 0)
|
||
|
(V4 0 0 0 1)
|
||
|
(V2 0 (1 - (50 / 1024)))
|
||
|
(fromIntegral index)
|
||
|
, newVertex
|
||
|
(V3 (x + 32) y 0)
|
||
|
(V4 0 0 0 1)
|
||
|
(V2 (50 / 1024) (1 - (50/1024)))
|
||
|
(fromIntegral index)
|
||
|
, newVertex
|
||
|
(V3 (x + 32) (y + 32) 0)
|
||
|
(V4 0 0 0 1)
|
||
|
(V2 (50 / 1024) 1)
|
||
|
(fromIntegral index)
|
||
|
, newVertex
|
||
|
(V3 x (y + 32) 0)
|
||
|
(V4 0 0 0 1)
|
||
|
(V2 0 1)
|
||
|
(fromIntegral index)
|
||
|
]
|
||
|
|
||
|
populate
|
||
|
:: V.Vector Layer
|
||
|
-> V.Vector StageSet
|
||
|
-> V.Vector Cast
|
||
|
-> (VS.Vector Word, VS.Vector Vertex)
|
||
|
populate layers props actors =
|
||
|
(VS.convert *** VS.convert) $ foldl
|
||
|
(\(is, vs) (num, l) ->
|
||
|
let propsHere = V.filter (\(StageSet s) -> residentLayer s == num) props
|
||
|
actorsHere = V.filter (\(Cast c) -> residentLayer c == num) actors
|
||
|
(pisRaw, pvs) = V.foldl
|
||
|
(\(ais, avs) (StageSet s) ->
|
||
|
let (nis, nvs) = toVertices s
|
||
|
in
|
||
|
( ais V.++ nis
|
||
|
, avs V.++ nvs)
|
||
|
)
|
||
|
(V.empty, V.empty)
|
||
|
propsHere
|
||
|
(cisRaw, cvs) = V.foldl
|
||
|
(\(ais, avs) (Cast c) ->
|
||
|
let (nis, nvs) = toVertices c
|
||
|
in
|
||
|
( ais V.++ nis
|
||
|
, avs V.++ nvs)
|
||
|
)
|
||
|
(V.empty, V.empty)
|
||
|
actorsHere
|
||
|
(lisRaw, lvs) = toVertices l
|
||
|
lis = V.map
|
||
|
(+ if null is then 0 else V.maximum is + 1)
|
||
|
lisRaw
|
||
|
pis = V.map
|
||
|
(+
|
||
|
if null (is V.++ lis)
|
||
|
then 0
|
||
|
else V.maximum (is V.++ lis) + 1)
|
||
|
pisRaw
|
||
|
cis = V.map
|
||
|
(+
|
||
|
if null (is V.++ lis V.++ pis)
|
||
|
then 0
|
||
|
else V.maximum (is V.++ lis V.++ pis) + 1)
|
||
|
cisRaw
|
||
|
in
|
||
|
( is V.++ lis V.++ pis V.++ cis
|
||
|
, vs V.++ lvs V.++ pvs V.++ cvs
|
||
|
)
|
||
|
)
|
||
|
(V.empty, V.empty)
|
||
|
(V.zip (V.fromList [0 ..]) layers)
|