{-#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 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 ( is V.++ lis V.++ pis V.++ cis , vs V.++ lvs V.++ pvs V.++ cvs ) ) (V.empty, V.empty) (V.zip (V.fromList [0 ..]) layers)