119 lines
3.1 KiB
Haskell
119 lines
3.1 KiB
Haskell
{-#LANGUAGE OverloadedStrings #-}
|
|
module Scenes.Test.Util where
|
|
|
|
import Affection as A
|
|
|
|
import qualified Graphics.Rendering.OpenGL as GL
|
|
|
|
import Linear
|
|
|
|
import qualified Data.Vector as V
|
|
import qualified Data.Vector.Storable as VS
|
|
|
|
import Data.String (fromString)
|
|
|
|
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.++
|
|
(V.map
|
|
(+ (if null ais then 0 else V.maximum ais + 1))
|
|
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.++
|
|
(V.map
|
|
(+ (if null ais then 0 else V.maximum ais + 1))
|
|
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
|
|
A.log A.Debug
|
|
("layer: " <> (fromString $ show num) <>
|
|
", actors: " <> (fromString $ V.foldl (\acc (Cast c) -> acc ++ show c ++ " ") "" actorsHere) <>
|
|
", props: " <> (fromString $ V.foldl (\acc (StageSet s) -> acc ++ show s ++ " ") "" propsHere)
|
|
)
|
|
(
|
|
( is V.++ lis V.++ pis V.++ cis
|
|
, vs V.++ lvs V.++ pvs V.++ cvs
|
|
)
|
|
)
|
|
)
|
|
(V.empty, V.empty)
|
|
(V.zip (V.fromList [0 ..]) layers)
|