Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

- Little restructurization.

- RawToken structure is updated.
- Tests fixed.
  • Loading branch information...
commit 64fefc7213271d6101908169951cdd971e8fda74 1 parent 78baf84
@graninas authored
View
12 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
View
6 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
+import GameLogic.Data.Object
+import GameLogic.Data.World
+import GameLogic.Data.Game
View
4 Amoeba/GameLogic/Runtime/Game.hs → 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 }
View
14 Amoeba/GameLogic/Runtime/World.hs → 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)
View
2  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
+comment = liftM CommentToken commentString
View
2  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
View
6 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
View
8 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)
View
43 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"
View
51 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)
+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."
+
View
11 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
View
6 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
View
2  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")]]]
+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")]]]
View
2  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")]]]
+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")]]]
View
2  Amoeba/Test/EitherMonadCallTest.hs
@@ -17,4 +17,4 @@ callEitherMonad = do
main = do
let res = callEitherMonad
- putStrLn $ show res
+ print res
View
37 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
View
6 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)
View
6 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."
+
View
30 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 )
Please sign in to comment.
Something went wrong with that request. Please try again.