pituicat/src/Scenes/Test/Util.hs

120 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) <>
",\nactors: " <> (fromString $ V.foldl (\acc (Cast c) -> acc ++ show c ++ " ") "" actorsHere) <>
",\nprops: " <> (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)