Permalink
Browse files

- Translation by scheme fills ItemMap in context.

  • Loading branch information...
1 parent 5b6ae0f commit a11511c502d56c8dfa56ece227d12c2adb2258e7 @graninas committed Feb 16, 2014
@@ -4,6 +4,7 @@ module GameLogic.Data.Object where
import Control.Lens
import GameLogic.Data.Player
+import GameLogic.Data.Types
data Resource a = Resource { _stock :: a
@@ -14,8 +15,8 @@ type IntResource = Resource Int
data Object = Object {
-- Properties:
- _objectId :: Int -- static property
- , _objectType :: Int -- predefined property
+ _objectId :: ObjectId -- static property
+ , _objectType :: ObjectType -- predefined property
-- Runtime properties, resources:
, _ownership :: Player -- runtime property... or can be effect!
@@ -0,0 +1,5 @@
+module GameLogic.Data.Types where
+
+
+type ObjectType = Int
+type ObjectId = Int
@@ -16,6 +16,7 @@ skip t = do
log $ "Skip for: " ++ show t
return ""
-addItem t = do
- log $ "Adding object template for: " ++ show t
+addItem (Item name props) = do
+ log $ "Adding object template for: " ++ show name
+ insertObjectTemplate name props
return ""
@@ -1,14 +1,18 @@
module GameLogic.Language.Translating.Runtime where
-import qualified Data.Map as M
-
import Control.Monad.State
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.Language.RawToken
+
+type ObjectTemplate = (ObjectType, [PropertyToken])
data TransRt = TransRt { trtNextId :: State TransRt Int
- , trtItemMap :: M.Map String String -- TODO
+ , trtItemMap :: M.Map String ObjectTemplate
, trtWorldConstructor :: String -- TODO
, trtLog :: [String]
}
@@ -22,4 +26,20 @@ log s = do
put newCtx
+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."
+
initialRt idCounter = TransRt idCounter M.empty "Empty" []
@@ -15,39 +15,7 @@ import Control.Monad.State
import Control.Monad.Trans
import Control.Monad.Trans.Either as E
import Control.Monad
-
-{-
-; 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"
--}
+import Data.Either.Combinators (isRight)
nextId :: Int -> State TransRt Int
@@ -60,20 +28,31 @@ nextId prevId = do
indexingRt = initialRt (nextId 1)
-apply sc t = mapM_ ($ t) sc
-
+apply sc t = sequence_ (map ($ t) sc)
+ {-
+ let acts = [act | act <- map ($ t) sc]
+ case acts of
+ [] -> left $ "No translator for token " ++ show t
+ (act : []) -> act
+ _ -> left $ "Redundant translators for token " ++ show t
+ -}
+
translate _ [] = return ()
translate sc (t:ts) = do
apply sc t
translate sc ts
-
+
translateToWorld [] = Left "There are no tokens."
-translateToWorld tokens = return $ execState (runEitherT (translate scheme tokens)) indexingRt
+translateToWorld tokens = return $ evalState (runEitherT (translate scheme tokens)) indexingRt
+
+translateToWorld' _ [] = Left "There are no tokens."
+translateToWorld' eF tokens = return $ eF (runEitherT (translate scheme tokens)) indexingRt
+
toWorld rawString = do
ts <- RP.parseRawTokens rawString :: Either String [RawToken]
- ctx <- translateToWorld ts
- return $ trtLog ctx
+ res <- translateToWorld' execState ts
+ return $ trtItemMap res
@@ -0,0 +1,36 @@
+; General items
+
+Item "Karyon"
+ lifebound = (0, 5000)
+ durability = (100, 100)
+ energy = (300, 2000)
+
+; Conductor1
+Item "Conductor"
+ lifebound = (0, 1000)
+ durability = (100, 100)
+ energy = (0, 100)
+
+; Conductor2
+Item "Conductor"
+ lifebound = (0, 22)
+ durability = (3, 11)
+ energy = (0, 444)
+
+; 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"
@@ -10,9 +10,12 @@ import Control.Monad (liftM)
main = do
tokens <- readFile "./Data/Raws/World3.arf"
-
let res = toWorld tokens
-
print res
+
+ tokens2 <- readFile "./Data/Raws/World4_duplicate.arf"
+ print $ toWorld tokens2
+
+
putStrLn "Ok."
@@ -1,10 +0,0 @@
-#!/bin/bash
-
-set -e
-
-./scripts/clean-test-data.sh
-./scripts/copy-test-data.sh
-./scripts/build-tests.sh "$@"
-./scripts/run-tests-verbose.sh "$@"
-
-set +e
View
@@ -1,10 +0,0 @@
-#!/bin/bash
-
-set -e
-
-./scripts/clean-test-data.sh
-./scripts/copy-test-data.sh
-./scripts/build-tests.sh "$@"
-./scripts/run-tests.sh "$@"
-
-set +e
View
@@ -1,11 +0,0 @@
-#!/bin/bash
-
-set -e
-
-
-
-set +e
-
-echo "Copying..."
-rm -f "./Game/Amoeba"
-cp "./.bin/Amoeba" ./Game/

0 comments on commit a11511c

Please sign in to comment.