Permalink
Browse files

- RawToken structure little update.

- Tests repared.
- Further development of translating rules.
  • Loading branch information...
1 parent 7c552a0 commit 69df24ce14823dc1012b23ecf5ca9100ff86f850 @graninas committed Feb 21, 2014
View
6 Amoeba.cabal
@@ -70,7 +70,8 @@ library
GameLogic.Language.Translator,
Test.EitherMonadCallTest,
Test.TypeFamilyTest2,
- Test.TypeFamilyTest1
+ Test.TypeFamilyTest1,
+ GameLogic.Language.Scheme
executable Amoeba
build-depends: base >= 4
@@ -111,5 +112,6 @@ executable Amoeba
GameLogic.Language.Translator,
Test.EitherMonadCallTest,
Test.TypeFamilyTest2,
- Test.TypeFamilyTest1
+ Test.TypeFamilyTest1,
+ GameLogic.Language.Scheme
sers.ItemParser
View
35 Amoeba/GameLogic/Language/Parsing/WorldParser.hs
@@ -2,12 +2,13 @@ module GameLogic.Language.Parsing.WorldParser where
import GameLogic.Language.Parsing.Common
import GameLogic.Language.RawToken
+import qualified GameLogic.Language.Scheme as S
import Middleware.Parsing.Facade as P
world :: GenParser Char st RawToken
world = do
- string "World" >> many1 trueSpace
+ string S.world >> many1 trueSpace
itemName <- stringConstant
lineEnd
rs <- properties
@@ -16,15 +17,31 @@ world = do
properties :: GenParser Char st [PropertyToken]
properties = many property
+{- Uncomment for GHC 7.6.
+{-# LANGUAGE MultiWayIf #-}
property :: GenParser Char st PropertyToken
property = do
identation 4
name <- identifier
- case name of
- "width" -> intProperty name
- "height" -> intProperty name
- "defaultCell" -> objectProperty name
- "cells" -> cellsProperty name
+ if | name == width -> intProperty name
+ | name == height -> intProperty name
+ | name == defaultCell -> objectProperty name
+ | name == cells -> cellsProperty name
+ | otherwise -> fail $ "unknown property: " ++ name
+
+-}
+
+property :: GenParser Char st PropertyToken
+property = do
+ identation 4
+ name <- identifier
+ chooseProperty name
+ where
+ chooseProperty name | name == S.width = intProperty name
+ | name == S.height = intProperty name
+ | name == S.defaultCell = objectProperty name
+ | name == S.cells = cellsProperty name
+ | otherwise = fail $ "unknown property: " ++ name
intProperty :: String -> GenParser Char st PropertyToken
intProperty name = do
@@ -38,11 +55,11 @@ objectProperty name = do
assignment
o <- object
lineEnd
- return $ ObjectProperty name o
+ return $ ObjectProperty name o
object :: GenParser Char st RawToken
object = do
- string "Object" >> many1 trueSpace
+ string S.object >> many1 trueSpace
objectName <- stringConstant
many trueSpace
playerName <- stringConstant
@@ -60,4 +77,4 @@ cell = do
trueSpaces >> char ':' >> trueSpaces
o <- object
lineEnd
- return $ CellProperty coords o
+ return $ CellProperty S.cell coords o
View
2 Amoeba/GameLogic/Language/RawToken.hs
@@ -7,7 +7,7 @@ type PlayerName = String
data PropertyToken = IntProperty Name Int
| ObjectProperty Name RawToken
| CellsProperty Name [PropertyToken]
- | CellProperty (Int, Int) RawToken
+ | CellProperty Name (Int, Int) RawToken
| IntResource Name (Int, Int)
deriving (Show, Read, Eq)
View
22 Amoeba/GameLogic/Language/Scheme.hs
@@ -0,0 +1,22 @@
+module GameLogic.Language.Scheme where
+
+width = "width"
+height = "height"
+cells = "cells"
+cell = "cell"
+defaultCell = "defaultCell"
+
+world = "World"
+object = "Object"
+
+energy = "energy"
+lifebound = "lifebound"
+durability = "durability"
+
+karyon = "Karyon"
+conductor = "Conductor"
+plasma = "Plasma"
+empty = "Empty"
+
+player0 = "Player0"
+player1 = "Player1"
View
32 Amoeba/GameLogic/Language/Translating/Actions.hs
@@ -6,27 +6,39 @@ import GameLogic.Language.Translating.Runtime
import Prelude hiding (log)
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
-skip, addItem :: RawToken -> Trans ()
+skip :: Show a => a -> Trans ()
skip t = log $ "Skip for: " ++ show t
addItem (Item 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 <- getProperty "width" props
--- ht <- getProperty "height" props
--- cells <- getWorldCells props
--- constructWorld wg ht cells
-
-
-setupWorld t = left $ "setupWorld: World expected but got " ++ show t
+ 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 propsScheme t = undefined
+
+setWidth = undefined
+setHeight = undefined
+setCells = undefined
View
14 Amoeba/GameLogic/Language/Translating/Rules.hs
@@ -0,0 +1,14 @@
+module GameLogic.Language.Translating.Rules where
+
+import GameLogic.Language.Translating.Triggers
+import GameLogic.Language.Translating.Actions
+import GameLogic.Language.Scheme
+
+scheme = [ onComment /> skip
+ , onEmpty /> skip
+ , onItem /> addItem
+ , onWorld /> setupWorld [ onProp width /> setWidth
+ , onProp height /> setHeight
+ , onProp cells /> setCells
+ ]
+ ]
View
8 Amoeba/GameLogic/Language/Translating/Runtime.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE RankNTypes #-}
module GameLogic.Language.Translating.Runtime where
import Control.Monad (when, liftM)
@@ -41,13 +40,6 @@ initialRt idCounter = TransRt idCounter M.empty "Empty" [] False
-- Specific
-{-
-getProperty :: forall b . String -> PropertyToken -> Trans b
-getProperty name (IntProperty n i) | name == n = return i
-getProperty name (IntResource n r) | name == n = return r
-getProperty name _ = left $ "There is no property with name " ++ name ++ "."
--}
-
getItemMap = liftM trtItemMap get
putItemMap m = do
ctx <- get
View
12 Amoeba/GameLogic/Language/Translating/Scheme.hs
@@ -1,12 +0,0 @@
-module GameLogic.Language.Translating.Scheme where
-
-import GameLogic.Language.Translating.Triggers
-import GameLogic.Language.Translating.Actions
-
-
-
-scheme = [ onComment /> skip
- , onEmpty /> skip
- , onItem /> addItem
- , onWorld /> setupWorld
- ]
View
2 Amoeba/GameLogic/Language/Translating/Translator.hs
@@ -6,8 +6,8 @@ import GameLogic.Language.RawToken as RT
import qualified GameLogic.Runtime.World as W
import qualified GameLogic.Data.Facade as D
-import GameLogic.Language.Translating.Scheme
import GameLogic.Language.Translating.Runtime
+import GameLogic.Language.Translating.Rules
import Prelude hiding (log)
View
12 Amoeba/GameLogic/Language/Translating/Triggers.hs
@@ -2,7 +2,7 @@ module GameLogic.Language.Translating.Triggers where
import GameLogic.Language.RawToken
-
+onComment :: RawToken -> Bool
onComment (Comment _) = True
onComment _ = False
@@ -13,4 +13,12 @@ onItem (Item n props) = True
onItem _ = False
onWorld (World name props) = True
-onWorld _ = False
+onWorld _ = False
+
+onProp :: String -> PropertyToken -> Bool
+onProp name (IntProperty n _) | n == name = True
+onProp name (ObjectProperty n _) | n == name = True
+onProp name (CellsProperty n _) | n == name = True
+onProp name (CellProperty n _ _) | n == name = True
+onProp name (IntResource n _ ) | n == name = True
+onProp _ _ = False
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 (10,10) (Object "Karyon" "Player1"),CellProperty (9,9) (Object "Plasma" "Player1"),CellProperty (9,10) (Object "Plasma" "Player1"),CellProperty (9,11) (Object "Plasma" "Player1"),CellProperty (10,9) (Object "Plasma" "Player1"),CellProperty (10,11) (Object "Plasma" "Player1"),CellProperty (11,9) (Object "Plasma" "Player1"),CellProperty (11,10) (Object "Plasma" "Player1"),CellProperty (11,11) (Object "Plasma" "Player1"),CellProperty (15,15) (Object "Karyon" "Player2")]]]
+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")]]]
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 (10,10) (Object "Karyon" "Player1"),CellProperty (9,9) (Object "Plasma" "Player1"),CellProperty (9,10) (Object "Plasma" "Player1"),CellProperty (9,11) (Object "Plasma" "Player1"),CellProperty (10,9) (Object "Plasma" "Player1"),CellProperty (10,11) (Object "Plasma" "Player1"),CellProperty (11,9) (Object "Plasma" "Player1"),CellProperty (11,10) (Object "Plasma" "Player1"),CellProperty (11,11) (Object "Plasma" "Player1"),CellProperty (15,15) (Object "Karyon" "Player2")]]]
+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")]]]
View
11 Amoeba/Test/ParsingTest.hs
@@ -11,22 +11,23 @@ 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.
items1 = ("Items1", "./Data/Raws/Items.arf",
parseRawTokens,
- Right [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)]])
+ 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 "Karyon" [IntResource "lifebound" (0,5000), IntResource "durability" (100,100), IntResource "energy" (300,2000)]])
+ 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 "width" 20, IntProperty "height" 20, ObjectProperty "defaultCell" (Object "Empty" "Player0")
- , CellsProperty "cells" [ CellProperty (10, 10) (Object "Karyon" "Player1")
- , CellProperty (9, 9) (Object "Plasma" "Player1")]] ])
+ , 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
View
4 Amoeba/Test/TypeFamilyTest3.hs
@@ -22,9 +22,9 @@ instance Show (PropertyToken Int) where
instance Show (PropertyToken (Int, Int)) where
show (IntResource _ i) = show i
-class Show a => Prop a where
+class (Show a) => Prop a where
type Out a b :: *
- getProperty :: a -> Out a ()
+ getProperty :: (a ~ Out b ()) => a -> Out a ()
printProperty :: a -> String
instance Prop (PropertyToken a) where

0 comments on commit 69df24c

Please sign in to comment.