diff --git a/Amoeba.cabal b/Amoeba.cabal index b1a8911..d23f821 100644 --- a/Amoeba.cabal +++ b/Amoeba.cabal @@ -45,8 +45,6 @@ library GameLogic.Data.Object, GameLogic.Data.Player, GameLogic.Runtime.Evaluation, - GameLogic.Runtime.Game, - GameLogic.Runtime.World, Middleware.Config.Config, Middleware.Config.Facade, Middleware.Config.Scheme, @@ -71,7 +69,10 @@ library Test.EitherMonadCallTest, Test.TypeFamilyTest2, Test.TypeFamilyTest1, - GameLogic.Language.Scheme + GameLogic.Language.Scheme, + GameLogic.Data.World, + GameLogic.Data.Game, + Test.Utils.WorldArfData executable Amoeba build-depends: base >= 4 @@ -82,7 +83,6 @@ executable Amoeba Application.Boot, Application.Environment, Application.MainLoop, - GameLogic.Runtime.Game, GameLogic.AI.AI, GameLogic.AI.GenericAI, GameLogic.Assets.Scenarios, @@ -113,5 +113,7 @@ executable Amoeba Test.EitherMonadCallTest, Test.TypeFamilyTest2, Test.TypeFamilyTest1, - GameLogic.Language.Scheme + GameLogic.Language.Scheme, + GameLogic.Data.Game, + Test.Utils.WorldArfData sers.ItemParser diff --git a/Amoeba/GameLogic/Data/Facade.hs b/Amoeba/GameLogic/Data/Facade.hs index 80bd9d6..544dd4a 100644 --- a/Amoeba/GameLogic/Data/Facade.hs +++ b/Amoeba/GameLogic/Data/Facade.hs @@ -1,7 +1,11 @@ module GameLogic.Data.Facade ( module GameLogic.Data.Player , module GameLogic.Data.Object + , module GameLogic.Data.World + , module GameLogic.Data.Game ) where import GameLogic.Data.Player -import GameLogic.Data.Object \ No newline at end of file +import GameLogic.Data.Object +import GameLogic.Data.World +import GameLogic.Data.Game \ No newline at end of file diff --git a/Amoeba/GameLogic/Runtime/Game.hs b/Amoeba/GameLogic/Data/Game.hs similarity index 78% rename from Amoeba/GameLogic/Runtime/Game.hs rename to Amoeba/GameLogic/Data/Game.hs index e317e78..7eda444 100644 --- a/Amoeba/GameLogic/Runtime/Game.hs +++ b/Amoeba/GameLogic/Data/Game.hs @@ -1,11 +1,11 @@ {-# LANGUAGE TemplateHaskell #-} -module GameLogic.Game where +module GameLogic.Data.Game where import Control.Lens import System.Random -import GameLogic.World +import GameLogic.Data.World data Game = Game { _world :: World , _rndGen :: StdGen } diff --git a/Amoeba/GameLogic/Runtime/World.hs b/Amoeba/GameLogic/Data/World.hs similarity index 85% rename from Amoeba/GameLogic/Runtime/World.hs rename to Amoeba/GameLogic/Data/World.hs index 5abf989..2bd71fa 100644 --- a/Amoeba/GameLogic/Runtime/World.hs +++ b/Amoeba/GameLogic/Data/World.hs @@ -1,12 +1,12 @@ {-# LANGUAGE TemplateHaskell #-} -module GameLogic.Runtime.World where +module GameLogic.Data.World where import qualified Control.Lens as L import qualified Data.Map as M import Prelude hiding (null, lookup) import GameLogic.Base.Geometry -import GameLogic.Data.Facade as O +import GameLogic.Data.Object data Effect = Effect deriving (Show, Read, Eq) @@ -17,11 +17,11 @@ data Action = Action deriving (Show, Read, Eq) type WorldMap = M.Map Point Object -data World = World { _worldMap :: WorldMap - , _effectMap :: EffectMap - , _width :: Int - , _height :: Int - , _defaultCell :: Maybe Object +data World = World { worldMap :: WorldMap + , effectMap :: EffectMap + , width :: Int + , height :: Int + , defaultCell :: Maybe Object } deriving (Show, Read, Eq) diff --git a/Amoeba/GameLogic/Language/Parsing/Common.hs b/Amoeba/GameLogic/Language/Parsing/Common.hs index ff6346b..5a9046e 100644 --- a/Amoeba/GameLogic/Language/Parsing/Common.hs +++ b/Amoeba/GameLogic/Language/Parsing/Common.hs @@ -9,4 +9,4 @@ emptyToken :: GenParser Char st RawToken emptyToken = eol >> return EmptyToken comment :: GenParser Char st RawToken -comment = liftM Comment commentString \ No newline at end of file +comment = liftM CommentToken commentString \ No newline at end of file diff --git a/Amoeba/GameLogic/Language/Parsing/ItemParser.hs b/Amoeba/GameLogic/Language/Parsing/ItemParser.hs index f4c108e..a1ace9e 100644 --- a/Amoeba/GameLogic/Language/Parsing/ItemParser.hs +++ b/Amoeba/GameLogic/Language/Parsing/ItemParser.hs @@ -11,7 +11,7 @@ item = do itemName <- stringConstant lineEnd rs <- resources - return $ Item itemName rs + return $ ItemToken itemName rs resources :: GenParser Char st [PropertyToken] resources = many resource diff --git a/Amoeba/GameLogic/Language/Parsing/WorldParser.hs b/Amoeba/GameLogic/Language/Parsing/WorldParser.hs index f86f2c1..dd1a886 100644 --- a/Amoeba/GameLogic/Language/Parsing/WorldParser.hs +++ b/Amoeba/GameLogic/Language/Parsing/WorldParser.hs @@ -12,13 +12,13 @@ world = do itemName <- stringConstant lineEnd rs <- properties - return $ World itemName rs + return $ WorldToken itemName rs properties :: GenParser Char st [PropertyToken] properties = many property {- Uncomment for GHC 7.6. -{-# LANGUAGE MultiWayIf #-} + LANGUAGE MultiWayIf property :: GenParser Char st PropertyToken property = do identation 4 @@ -63,7 +63,7 @@ object = do objectName <- stringConstant many trueSpace playerName <- stringConstant - return $ Object objectName playerName + return $ ObjectToken objectName playerName cellsProperty :: String -> GenParser Char st PropertyToken cellsProperty name = do diff --git a/Amoeba/GameLogic/Language/RawToken.hs b/Amoeba/GameLogic/Language/RawToken.hs index 2f09add..dde2176 100644 --- a/Amoeba/GameLogic/Language/RawToken.hs +++ b/Amoeba/GameLogic/Language/RawToken.hs @@ -11,9 +11,9 @@ data PropertyToken = IntProperty Name Int | IntResource Name (Int, Int) deriving (Show, Read, Eq) -data RawToken = Comment String - | World Name [PropertyToken] - | Item Name [PropertyToken] - | Object Name PlayerName +data RawToken = CommentToken String + | WorldToken Name [PropertyToken] + | ItemToken Name [PropertyToken] + | ObjectToken Name PlayerName | EmptyToken deriving (Show, Read, Eq) diff --git a/Amoeba/GameLogic/Language/Translating/Actions.hs b/Amoeba/GameLogic/Language/Translating/Actions.hs index 42caa9c..eec99f5 100644 --- a/Amoeba/GameLogic/Language/Translating/Actions.hs +++ b/Amoeba/GameLogic/Language/Translating/Actions.hs @@ -3,6 +3,8 @@ module GameLogic.Language.Translating.Actions where import GameLogic.Language.RawToken import GameLogic.Language.Translating.Runtime +import GameLogic.Data.World + import Prelude hiding (log) import Control.Monad.Trans.Either (left) @@ -10,40 +12,31 @@ import Control.Monad.Trans.Either (left) (/>) :: Show a => (a -> Bool) -> (a -> Trans ()) -> a -> Trans () (/>) trigger act token = if trigger token then act token - else logExt $ "Token not triggered: " ++ show token + else logExt $ "Token hasn't been triggered: " ++ show token -- Action that do nothing, only logs info. skip :: Show a => a -> Trans () skip t = log $ "Skip for: " ++ show t -- Action inserts item as object template. -addItem (Item name props) = do +addItem (ItemToken name props) = do log $ "Adding object template for: " ++ show name insertObjectTemplate name props -addItem t = left $ "addItem: Item expected but got " ++ show t - -{- -setupWorld (World name props) = do - log "Setting World." - wh <- get int "width" props - ht <- get int "height" props - cells <- getWorldCells props - constructWorld wg ht cells -setupWorld t = left $ "setupWorld: World expected but got " ++ show t - -getIntProperty :: String -> PropertyToken -> Trans Int -getIntProperty name (IntProperty n i : ps) | name == n = return i -getIntProperty name _ = - -getWorldCells props = do --} - ---setupWorld :: a -> PropertyToken -> Trans () -setupWorld rules (World name props) = do +addItem t = left $ "addItem: unexpected token got: " ++ show t + +setupWorld rules (WorldToken name props) = do log $ "Setting World: " ++ name ++ "." translate rules props -setupWorld _ t = left $ "setupWorld: World expected but got " ++ show t +setupWorld _ t = left $ "setupWorld: unexpected token got: " ++ show t + +setWidth (IntProperty _ i) = do + log "setWidth" +-- w <- getWorld +-- setWorld $ w { + +setWidth p = left $ "setWidth: unexpected property got: " ++ show p + +setHeight (IntProperty _ i) = log $ "setHeight" +setHeight p = left $ "setHeight: unexpected property got: " ++ show p -setWidth _ = log $ "setWidth" -setHeight _ = log $ "setHeight" setCells _ = log $ "setCells" diff --git a/Amoeba/GameLogic/Language/Translating/Runtime.hs b/Amoeba/GameLogic/Language/Translating/Runtime.hs index a79a997..9ef9203 100644 --- a/Amoeba/GameLogic/Language/Translating/Runtime.hs +++ b/Amoeba/GameLogic/Language/Translating/Runtime.hs @@ -2,20 +2,20 @@ module GameLogic.Language.Translating.Runtime where import Control.Monad (when, liftM) import Control.Monad.State -import Control.Monad.Trans +--import Control.Monad.Trans import Control.Monad.Trans.Either as E import qualified Data.Map as M import Prelude hiding (log) import GameLogic.Data.Types +import GameLogic.Data.World import GameLogic.Language.RawToken -import GameLogic.Runtime.World type ObjectTemplate = (ObjectType, [PropertyToken]) data TransRt = TransRt { trtNextId :: State TransRt Int , trtItemMap :: M.Map String ObjectTemplate - , trtWorldConstructor :: String --State TransRt World + , trtWorld :: World , trtLog :: [String] , trtExtendedLogs :: Bool } @@ -27,6 +27,9 @@ type Trans a = EitherT String (State TransRt) a getExtendedLogs :: Trans Bool getExtendedLogs = liftM trtExtendedLogs get +getWorld :: Trans World +getWorld = liftM trtWorld get + log s = do ctx <- get let newCtx = ctx { trtLog = trtLog ctx ++ [s] } @@ -36,27 +39,10 @@ logExt s = do isExtendedLogs <- getExtendedLogs when isExtendedLogs (log s) -initialRt idCounter = TransRt idCounter M.empty "Empty" [] False - --- Specific - -getItemMap = liftM trtItemMap get -putItemMap m = do - ctx <- get - put $ ctx { trtItemMap = m } -objectTemplate objType props = (objType, props) +initialRt idCounter = TransRt idCounter M.empty emptyWorld [] False -insertObjectTemplate :: String -> [PropertyToken] -> Trans () -insertObjectTemplate name props = do - m <- getItemMap - let objectType = M.size m + 1 - case M.lookup name m of - Nothing -> putItemMap $ M.insert name (objectTemplate objectType props) m - Just _ -> left $ "Object template for item " ++ name ++ " is duplicated." - log $ "Object template for item " ++ name ++ " added." - --- Makes from rules list the list of context modificators. +-- Makes from rules list the list of context modifiers. -- Folds the new list with applying to current context. apply rules t = mapM_ ($ t) rules @@ -74,4 +60,23 @@ apply rules t = do foldM_ (ctxModifier t) ctx rules -} -translate rules = mapM_ (apply rules) \ No newline at end of file +translate rules = mapM_ (apply rules) + +-- Specific + +getItemMap = liftM trtItemMap get +putItemMap m = do + ctx <- get + put $ ctx { trtItemMap = m } + +objectTemplate objType props = (objType, props) + +insertObjectTemplate :: String -> [PropertyToken] -> Trans () +insertObjectTemplate name props = do + m <- getItemMap + let objectType = M.size m + 1 + case M.lookup name m of + Nothing -> putItemMap $ M.insert name (objectTemplate objectType props) m + Just _ -> left $ "Object template for item " ++ name ++ " is duplicated." + log $ "Object template for item " ++ name ++ " added." + diff --git a/Amoeba/GameLogic/Language/Translating/Translator.hs b/Amoeba/GameLogic/Language/Translating/Translator.hs index 9c1a2ac..9daf1fc 100644 --- a/Amoeba/GameLogic/Language/Translating/Translator.hs +++ b/Amoeba/GameLogic/Language/Translating/Translator.hs @@ -3,19 +3,12 @@ module GameLogic.Language.Translating.Translator where import GameLogic.Language.Parsing.RawParser as RP import GameLogic.Language.RawToken as RT -import qualified GameLogic.Runtime.World as W -import qualified GameLogic.Data.Facade as D - import GameLogic.Language.Translating.Runtime import GameLogic.Language.Translating.Rules -import Prelude hiding (log) - import Control.Monad.State -import Control.Monad.Trans -import Control.Monad.Trans.Either -import Control.Monad -import Data.Either.Combinators (isRight) +--import Control.Monad.Trans +import Control.Monad.Trans.Either (runEitherT) nextId :: Int -> State TransRt Int diff --git a/Amoeba/GameLogic/Language/Translating/Triggers.hs b/Amoeba/GameLogic/Language/Translating/Triggers.hs index 36fba3e..431bd22 100644 --- a/Amoeba/GameLogic/Language/Translating/Triggers.hs +++ b/Amoeba/GameLogic/Language/Translating/Triggers.hs @@ -3,16 +3,16 @@ module GameLogic.Language.Translating.Triggers where import GameLogic.Language.RawToken onComment :: RawToken -> Bool -onComment (Comment _) = True +onComment (CommentToken _) = True onComment _ = False onEmpty EmptyToken = True onEmpty _ = False -onItem (Item n props) = True +onItem (ItemToken n props) = True onItem _ = False -onWorld (World name props) = True +onWorld (WorldToken name props) = True onWorld _ = False onProp :: String -> PropertyToken -> Bool diff --git a/Amoeba/Test/Data/Raws/World2.adt b/Amoeba/Test/Data/Raws/World2.adt index 9201891..f38f699 100644 --- a/Amoeba/Test/Data/Raws/World2.adt +++ b/Amoeba/Test/Data/Raws/World2.adt @@ -1 +1 @@ -Right [Comment " World definition file",EmptyToken,World "Pandora" [IntProperty "width" 20,IntProperty "height" 20,ObjectProperty "defaultCell" (Object "Empty" "Player0"),CellsProperty "cells" [CellProperty "cell" (10,10) (Object "Karyon" "Player1"),CellProperty "cell" (9,9) (Object "Plasma" "Player1"),CellProperty "cell" (9,10) (Object "Plasma" "Player1"),CellProperty "cell" (9,11) (Object "Plasma" "Player1"),CellProperty "cell" (10,9) (Object "Plasma" "Player1"),CellProperty "cell" (10,11) (Object "Plasma" "Player1"),CellProperty "cell" (11,9) (Object "Plasma" "Player1"),CellProperty "cell" (11,10) (Object "Plasma" "Player1"),CellProperty "cell" (11,11) (Object "Plasma" "Player1"),CellProperty "cell" (15,15) (Object "Karyon" "Player2")]]] \ No newline at end of file +Right [CommentToken " World definition file",EmptyToken,WorldToken "Pandora" [IntProperty "width" 20,IntProperty "height" 20,ObjectProperty "defaultCell" (ObjectToken "Empty" "Player0"),CellsProperty "cells" [CellProperty "cell" (10,10) (ObjectToken "Karyon" "Player1"),CellProperty "cell" (9,9) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (9,10) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (9,11) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (10,9) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (10,11) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (11,9) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (11,10) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (11,11) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (15,15) (ObjectToken "Karyon" "Player2")]]] \ No newline at end of file diff --git a/Amoeba/Test/Data/Raws/World3.adt b/Amoeba/Test/Data/Raws/World3.adt index bc19f85..ba133d9 100644 --- a/Amoeba/Test/Data/Raws/World3.adt +++ b/Amoeba/Test/Data/Raws/World3.adt @@ -1 +1 @@ -Right [EmptyToken,Comment " General items",EmptyToken,Item "Karyon" [IntResource "lifebound" (0,5000),IntResource "durability" (100,100),IntResource "energy" (300,2000)],EmptyToken,Comment " Conductor",Item "Conductor" [IntResource "lifebound" (0,1000),IntResource "durability" (100,100),IntResource "energy" (0,100)],EmptyToken,Comment " World definition file",EmptyToken,World "Pandora" [IntProperty "width" 20,IntProperty "height" 20,ObjectProperty "defaultCell" (Object "Empty" "Player0"),CellsProperty "cells" [CellProperty "cell" (10,10) (Object "Karyon" "Player1"),CellProperty "cell" (9,9) (Object "Plasma" "Player1"),CellProperty "cell" (9,10) (Object "Plasma" "Player1"),CellProperty "cell" (9,11) (Object "Plasma" "Player1"),CellProperty "cell" (10,9) (Object "Plasma" "Player1"),CellProperty "cell" (10,11) (Object "Plasma" "Player1"),CellProperty "cell" (11,9) (Object "Plasma" "Player1"),CellProperty "cell" (11,10) (Object "Plasma" "Player1"),CellProperty "cell" (11,11) (Object "Plasma" "Player1"),CellProperty "cell" (15,15) (Object "Karyon" "Player2")]]] \ No newline at end of file +Right [EmptyToken,CommentToken " General items",EmptyToken,ItemToken "Karyon" [IntResource "lifebound" (0,5000),IntResource "durability" (100,100),IntResource "energy" (300,2000)],EmptyToken,CommentToken " Conductor",ItemToken "Conductor" [IntResource "lifebound" (0,1000),IntResource "durability" (100,100),IntResource "energy" (0,100)],EmptyToken,CommentToken " World definition file",EmptyToken,WorldToken "Pandora" [IntProperty "width" 20,IntProperty "height" 20,ObjectProperty "defaultCell" (ObjectToken "Empty" "Player0"),CellsProperty "cells" [CellProperty "cell" (10,10) (ObjectToken "Karyon" "Player1"),CellProperty "cell" (9,9) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (9,10) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (9,11) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (10,9) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (10,11) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (11,9) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (11,10) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (11,11) (ObjectToken "Plasma" "Player1"),CellProperty "cell" (15,15) (ObjectToken "Karyon" "Player2")]]] \ No newline at end of file diff --git a/Amoeba/Test/EitherMonadCallTest.hs b/Amoeba/Test/EitherMonadCallTest.hs index 4c14588..58cc86e 100644 --- a/Amoeba/Test/EitherMonadCallTest.hs +++ b/Amoeba/Test/EitherMonadCallTest.hs @@ -17,4 +17,4 @@ callEitherMonad = do main = do let res = callEitherMonad - putStrLn $ show res \ No newline at end of file + print res \ No newline at end of file diff --git a/Amoeba/Test/ParsingTest.hs b/Amoeba/Test/ParsingTest.hs index 41dd366..b98b66c 100644 --- a/Amoeba/Test/ParsingTest.hs +++ b/Amoeba/Test/ParsingTest.hs @@ -11,40 +11,17 @@ import GameLogic.Language.Parsing.ItemParser import GameLogic.Language.Parsing.WorldParser import GameLogic.Language.Parsing.RawParser import GameLogic.Language.RawToken -import qualified GameLogic.Language.Scheme as S --- 'ARF' stands for 'Amoeba Raw File' or 'Amoeba Raw Format' if you wish. +import Test.Utils.WorldArfData -items1 = ("Items1", "./Data/Raws/Items.arf", - parseRawTokens, - Right [Comment " General items",EmptyToken,Item S.karyon [IntResource S.lifebound (0,5000),IntResource S.durability (100,100),IntResource S.energy (300,2000)],EmptyToken,Comment " Conductor",Item S.conductor [IntResource S.lifebound (0,1000),IntResource S.durability (100,100),IntResource S.energy (0,100)]]) -items2 = ("Items2", "./Data/Raws/Item.arf", - parseRawTokens, - Right [Item S.karyon [IntResource S.lifebound (0,5000), IntResource S.durability (100,100), IntResource S.energy (300,2000)]]) -world1 = ("World1", "./Data/Raws/World1.arf", - parseRawTokens, - Right [ Comment " World definition file" - , EmptyToken - , World "Pandora" [ IntProperty S.width 20, IntProperty S.height 20, ObjectProperty S.defaultCell (Object S.empty S.player0) - , CellsProperty S.cells [ CellProperty S.cell (10, 10) (Object S.karyon S.player1) - , CellProperty S.cell (9, 9) (Object S.plasma S.player1)]] ]) -world2 = ( "World2" - , "./Data/Raws/World2.arf" - , parseRawTokens - , undefined ) -world3 = ( "World3" - , "./Data/Raws/World3.arf" - , parseRawTokens - , undefined ) +parseExample dataFile = liftM parseRawTokens (readFile dataFile) -parseExample parser dataFile = liftM parser (readFile dataFile) - -testExample ex@(testName, dataFile, parser, res) = do - parsed <- parseExample parser dataFile +testExample ex@(testName, dataFile, res) = do + parsed <- parseExample dataFile return $ res == parsed -examineExample ex@(testName, dataFile, parser, res) pred = do - parsed <- parseExample parser dataFile +examineExample ex@(testName, dataFile, res) pred = do + parsed <- parseExample dataFile return $ pred res parsed prop_parseItems1 = monadicIO $ do @@ -74,7 +51,7 @@ prop_parseWorld3 = monadicIO $ do pred expected _ parsed = expected == parsed writeAdt rawFile destFile = do - p <- parseExample parseRawTokens rawFile + p <- parseExample rawFile writeFile destFile $ show p tests :: IO Bool diff --git a/Amoeba/Test/TranslatingTest.hs b/Amoeba/Test/TranslatingTest.hs index e86e948..71a5dd5 100644 --- a/Amoeba/Test/TranslatingTest.hs +++ b/Amoeba/Test/TranslatingTest.hs @@ -3,7 +3,7 @@ module Main where import GameLogic.Language.RawToken import GameLogic.Language.Translating.Translator import GameLogic.Language.Translating.Runtime -import GameLogic.Runtime.World +import GameLogic.Data.World import Control.Monad (liftM) import Data.Either.Combinators @@ -17,8 +17,8 @@ main = do tokens <- readFile "./Data/Raws/World3.arf" let res = toWorld tokens putStrLn $ unlines . fromRight' . extractLog $ res - putStrLn $ show . fromRight' . extractItemMap $ res - putStrLn $ show . fromRight' . extractResult $ res + print ((fromRight' . extractItemMap) res) + print ((fromRight' . extractResult) res) diff --git a/Amoeba/Test/TypeFamilyTest2.hs b/Amoeba/Test/TypeFamilyTest2.hs index 92c5512..ced9bd7 100644 --- a/Amoeba/Test/TypeFamilyTest2.hs +++ b/Amoeba/Test/TypeFamilyTest2.hs @@ -51,8 +51,6 @@ b :: (PropertyBag a, Prop p, p ~ Elem a) => p -> a b p = insert (getProperty p) empty -} -main = do +main = putStrLn "Ok." - -- let x = b prop1 - - putStrLn "Ok." \ No newline at end of file + \ No newline at end of file diff --git a/Amoeba/Test/Utils/WorldArfData.hs b/Amoeba/Test/Utils/WorldArfData.hs new file mode 100644 index 0000000..84cbf55 --- /dev/null +++ b/Amoeba/Test/Utils/WorldArfData.hs @@ -0,0 +1,30 @@ +module Test.Utils.WorldArfData where + +import GameLogic.Language.RawToken +import qualified GameLogic.Language.Scheme as S + +-- 'ARF' stands for 'Amoeba Raw File' or 'Amoeba Raw Format' if you wish. + +items1 = ("Items1", "./Data/Raws/Items.arf", + Right [ CommentToken " General items", EmptyToken + , ItemToken S.karyon [ IntResource S.lifebound (0,5000) + , IntResource S.durability (100,100) + , IntResource S.energy (300,2000)] + , EmptyToken, CommentToken " Conductor" + , ItemToken S.conductor [IntResource S.lifebound (0,1000),IntResource S.durability (100,100),IntResource S.energy (0,100)]]) + +items2 = ("Items2", "./Data/Raws/Item.arf", + Right [ItemToken S.karyon [IntResource S.lifebound (0,5000), IntResource S.durability (100,100), IntResource S.energy (300,2000)]]) + +world1 = ("World1", "./Data/Raws/World1.arf", + Right [ CommentToken " World definition file" + , EmptyToken + , WorldToken "Pandora" [ IntProperty S.width 20, IntProperty S.height 20, ObjectProperty S.defaultCell (ObjectToken S.empty S.player0) + , CellsProperty S.cells [ CellProperty S.cell (10, 10) (ObjectToken S.karyon S.player1) + , CellProperty S.cell (9, 9) (ObjectToken S.plasma S.player1)]] ]) +world2 = ( "World2" + , "./Data/Raws/World2.arf" + , undefined ) +world3 = ( "World3" + , "./Data/Raws/World3.arf" + , undefined ) \ No newline at end of file