Permalink
Browse files

- Advanced Translator design.

  • Loading branch information...
1 parent 7e9b5d9 commit 142f683bdad39663a209ef34d64ed60fc352ed17 @graninas committed Feb 16, 2014
View
@@ -67,7 +67,8 @@ library
GameLogic.Language.Parsers.RawParser,
GameLogic.Language.Parsers.Common,
GameLogic.Language.Parsers.RawToken,
- GameLogic.Language.Translator
+ GameLogic.Language.Translator,
+ Test.EitherMonadCallTest
executable Amoeba
build-depends: base >= 4
@@ -105,5 +106,6 @@ executable Amoeba
GameLogic.Language.Parsers.RawParser,
GameLogic.Language.Parsers.Common,
GameLogic.Language.Parsers.RawToken,
- GameLogic.Language.Translator
+ GameLogic.Language.Translator,
+ Test.EitherMonadCallTest
sers.ItemParser
@@ -8,5 +8,24 @@ worldFile dataPath = dataPath ++ "Raws/world.arf"
loadWorld dataPath = do
worldContents <- readFile dataPath
- return ()
-
+ case toWorld worldContents of
+ Left err -> putStrLn err
+ Right w -> putStrLn "World loaded." >> return w
+
+
+
+players = M.fromList [ ("Player0", D.dummyPlayer)
+ , ("Player1", D.player1) ]
+
+translateWorldProperties _ [] = return w
+translateWorldProperties w (IntProperty "width" i : ps) =
+ translateWorldProperties (w {_width = i}) ps
+translateWorldProperties w (IntProperty "height" i : ps) =
+ translateWorldProperties (w {_height = i}) ps
+translateWorldProperties w (ObjectProperty "defaultCell" obj : ps) =
+
+translateToWorld _ [] = Left "No data passed."
+translateToWorld w (RP.EmptyToken : ts) = translateToWorld w ts
+translateToWorld w (RP.World n prps : ts) = do
+ w' <- translateWorldProperties w prps
+ return $ translateToWorld w' ts
@@ -39,3 +39,4 @@ isResourceValid (Resource c Nothing) = c >= 0
resourceValidator r | isResourceValid r = r
| otherwise = error $ "Invalid resource property: " ++ show r
toResource (c, mbM) = resourceValidator $ Resource c mbM
+
@@ -1,34 +1,102 @@
module GameLogic.Language.Translator where
-import qualified GameLogic.Language.Parsers.RawParser as RP
-import GameLogic.Runtime.World
+import GameLogic.Language.Parsers.RawParser as RP
+import GameLogic.Language.Parsers.RawToken as RT
+import qualified GameLogic.Runtime.World as W
+import qualified GameLogic.Data.Facade as D
+
+import qualified Data.Map as M
+
+import Control.Monad.State
+import Control.Monad.Trans
+import Control.Monad.Trans.Either as E
+import Control.Monad
{-
-type Caption = String
-type Name = String
-type PlayerName = String
-
-data PropertyToken = IntProperty Name Int
- | ObjectProperty Name RawToken
- | CellsProperty Name [PropertyToken]
- | CellProperty (Int, Int) RawToken
- | IntResource Name (Int, Int)
- deriving (Show, Read, Eq)
-
-data RawToken = Comment String
- | World Name [PropertyToken]
- | Item Name [PropertyToken]
- | Object Name PlayerName
- | EmptyToken
- deriving (Show, Read, Eq)
+; General items
+
+Item "Karyon"
+ lifebound = (0, 5000)
+ durability = (100, 100)
+ energy = (300, 2000)
+
+; Conductor
+Item "Conductor"
+ lifebound = (0, 1000)
+ durability = (100, 100)
+ energy = (0, 100)
+
+; World definition file
+
+World "Pandora"
+ width = 20
+ height = 20
+ defaultCell = Object "Empty" "Player0"
+ cells =
+ (10, 10): Object "Karyon" "Player1"
+ (9, 9): Object "Plasma" "Player1"
+ (9, 10): Object "Plasma" "Player1"
+ (9, 11): Object "Plasma" "Player1"
+ (10, 9): Object "Plasma" "Player1"
+ (10, 11): Object "Plasma" "Player1"
+ (11, 9): Object "Plasma" "Player1"
+ (11, 10): Object "Plasma" "Player1"
+ (11, 11): Object "Plasma" "Player1"
+ (15, 15): Object "Karyon" "Player2"
-}
+data TransRt = TransRt { trtNextId :: State TransRt Int
+ , trtItemMap :: M.Map String String -- TODO
+ , trtWorldConstructor :: String -- TODO
+ }
+
+type Trans a = EitherT String (State TransRt) a
+
+nextId :: Int -> State TransRt Int
+nextId prevId = do
+ let nId = prevId + 1
+ ctx <- get
+ put $ ctx { trtNextId = nextId nId }
+ return nId
+
+
-translateToWorld w [] = Left "No data passed."
-translateToWorld w (EmptyToken : ts) = translateToWorld w ts
-translateToWorld w ts = undefined
+initialRt = TransRt (nextId 1) M.empty "Empty"
+
+(/>) trigger act = \token -> if trigger token
+ then act token
+ else return $ "Token not triggered: " ++ show token
+
+
+-- actions:
+skip :: RawToken -> Trans String
+skip t = return $ "Skip for: " ++ show t
+addItem t = return $ "Adding object template for: " ++ show t
+
+-- triggers:
+onComment (RT.Comment _) = True
+onComment _ = False
+onEmpty RT.EmptyToken = True
+onEmpty _ = False
+onItem (Item n props) = True
+onItem _ = False
+
+scheme = [ onComment /> skip
+ , onEmpty /> skip
+ , onItem /> addItem
+ ]
+
+
+translator _ [] = left "Test1."
+translator _ ts = left "Test2."
+
+
+translateToWorld tokens = evalState (runEitherT (translator scheme tokens)) initialRt
+
toWorld rawString = do
- ts <- RP.parseRawTokens rawString
- translateToWorld ts
+ ts <- RP.parseRawTokens rawString :: Either String [RawToken]
+ translateToWorld ts
+
+
@@ -17,19 +17,24 @@ data Action = Action
deriving (Show, Read, Eq)
type WorldMap = M.Map Point Object
-type World = { _worldMap :: WorldMap
- , _effectMap :: EffectMap
-
-
- }
+data World = World { _worldMap :: WorldMap
+ , _effectMap :: EffectMap
+ , _width :: Int
+ , _height :: Int
+ , _defaultCell :: Maybe Object
+ }
deriving (Show, Read, Eq)
+emptyWorld = World M.empty M.empty 0 0 Nothing
+
+{-
fromList :: [(Point, Object)] -> World
fromList list = World wm b
where
wm = M.fromList list
b = occupiedArea (map fst list)
+
resetWorldMap :: World -> WorldMap -> World
resetWorldMap w wm = w { worldMap = wm
, worldBound = worldMapBound wm }
@@ -40,12 +45,11 @@ refreshWorldBound w = w { worldBound = worldMapBound $ worldMap w }
lookup :: Point -> WorldMap -> Maybe Object
lookup = M.lookup
emptyMap = M.empty
-emptyWorld = World emptyMap noBound
-- Lenses
makeLenses ''World
-{-
+
alterMap :: WorldMap -> Point -> Object -> WorldMap
alterMap m p c = f m
where
@@ -0,0 +1,20 @@
+module Main where
+
+import Control.Monad.Error
+
+action1 :: Either String Int
+action1 = return 10
+
+action2 :: Either String String
+action2 = return "String"
+
+callEitherMonad :: Either String String
+callEitherMonad = do
+ res1 <- action1
+ res2 <- action2
+ return $ show res1 ++ res2
+
+
+main = do
+ let res = callEitherMonad
+ putStrLn $ show res
View
@@ -14,9 +14,11 @@ import qualified Data.Sequence as Seq
import Test.QuickCheck
import Test.QuickCheck.All
+{-
instance Monoid r => Monoid (Accessor r a) where
mempty = Accessor mempty
mappend (Accessor a) (Accessor b) = Accessor $ a <> b
+-}
type MyMap = Map.Map Int String
@@ -88,8 +90,9 @@ checks1 = (check1, check2)
checks2 = [check1, check2, check3]
checks3 = [check3, check4]
checks4 = [check3 . to not, check4]
-checks5 = check3 . to not <> check4 -- needs a Nonoid instance for Accessor
-checks6 = check3 <> check4 -- needs a Nonoid instance for Accessor
+-- broken with lens-4.0.3
+--checks5 = check3 . to not <> check4 -- needs a Monoid instance for Accessor
+--checks6 = check3 <> check4 -- needs a Monoid instance for Accessor
isJustTrue (Just x) = x
isJustTrue Nothing = False
@@ -106,8 +109,9 @@ q9 = allOf traverse (isJustTrue . (d ^?)) checks3 -- False
q10 = anyOf traverse (isJustTrue . (d ^?)) checks3 -- True
q11 = allOf traverse (isJustTrue . (d ^?)) checks4 -- True
q12 = anyOf traverse (isJustTrue . (d ^?)) checks4 -- True
-q13 = isJustTrue . (d ^?) $ checks5 -- True
-q14 = isJustTrue . (d ^?) $ checks6 -- False
+-- broken with lens-4.0.3
+--q13 = isJustTrue . (d ^?) $ checks5 -- True
+--q14 = isJustTrue . (d ^?) $ checks6 -- False
tests :: IO Bool
tests = $quickCheckAll
@@ -117,6 +121,4 @@ runTests = tests >>= \passed -> putStrLn $
else "Some tests failed."
main :: IO ()
-main = do
- runTests
- print q14
+main = runTests
@@ -26,19 +26,17 @@ worker = do
return [n1, n2, n3, n4]
--- The state, wich will be injected into client code.
+-- The state, which will be injected into client code.
nextId :: Int -> State Context Int
-nextId prevId = let nId = prevId + 1
- in do
+nextId prevId = do let nId = prevId + 1
ctx <- get
put $ ctx { ctxNextId1 = nextId nId
, ctxNextId2 = nextId nId
}
return nId
nextRnd :: StdGen -> State Context Int
-nextRnd prevG = let (r, g) = random prevG
- in do
+nextRnd prevG = do let (r, g) = random prevG
ctx <- get
put $ ctx { ctxNextId1 = nextRnd g
, ctxNextId2 = nextRnd g
@@ -0,0 +1,18 @@
+module Main where
+
+import GameLogic.Language.Parsers.RawToken
+import GameLogic.Language.Translator
+import GameLogic.Runtime.World
+
+import Control.Monad (liftM)
+
+
+main = do
+
+ tokens <- readFile "./Data/Raws/World3.arf"
+
+ let res = toWorld tokens :: Either String String
+
+ print res
+
+ putStrLn "Ok."

0 comments on commit 142f683

Please sign in to comment.