Permalink
Browse files

- Overdesign of translator.

  • Loading branch information...
1 parent a414cd9 commit adc0e729a5c9d9f5806b6cbab53df640b0b1f896 @graninas committed Feb 19, 2014
@@ -6,9 +6,9 @@ import GameLogic.Language.Translating.Runtime
import Prelude hiding (log)
import Control.Monad.Trans.Either (left)
-(/>) trigger act = \token -> if trigger token
- then act token
- else logExt $ "Token not triggered: " ++ show token
+(/>) trigger act token = if trigger token
+ then act token
+ else logExt $ "Token not triggered: " ++ show token
skip, addItem :: RawToken -> Trans ()
@@ -22,7 +22,11 @@ addItem t = left $ "addItem: Item expected but got " ++ show t
setupWorld (World name props) = do
- log $ "Setting World."
+ 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
@@ -1,3 +1,4 @@
+{-# LANGUAGE RankNTypes #-}
module GameLogic.Language.Translating.Runtime where
import Control.Monad (when, liftM)
@@ -9,35 +10,49 @@ import Prelude hiding (log)
import GameLogic.Data.Types
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 -- TODO
+ , trtWorldConstructor :: String --State TransRt World
, trtLog :: [String]
, trtExtendedLogs :: Bool
}
type Trans a = EitherT String (State TransRt) a
+-- System
+
getExtendedLogs :: Trans Bool
getExtendedLogs = liftM trtExtendedLogs get
-getItemMap = liftM trtItemMap get
-putItemMap m = do
- ctx <- get
- put $ ctx { trtItemMap = m }
-
log s = do
ctx <- get
- let newCtx = ctx { trtLog = (trtLog ctx ++ [s]) }
+ let newCtx = ctx { trtLog = trtLog ctx ++ [s] }
put newCtx
logExt s = do
isExtendedLogs <- getExtendedLogs
when isExtendedLogs (log s)
-
+
+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
+ put $ ctx { trtItemMap = m }
+
objectTemplate objType props = (objType, props)
insertObjectTemplate :: String -> [PropertyToken] -> Trans ()
@@ -49,4 +64,3 @@ insertObjectTemplate name props = do
Just _ -> left $ "Object template for item " ++ name ++ " is duplicated."
log $ "Object template for item " ++ name ++ " added."
-initialRt idCounter = TransRt idCounter M.empty "Empty" [] False
@@ -29,10 +29,14 @@ indexingRt = initialRt (nextId 1)
-- Makes from scheme's list the list of context modificators.
-- Folds the new list with applying to current context.
+apply sc t = mapM_ ($ t) sc
+
+{- Same function:
apply sc t = sequence_ (map ($ t) sc)
+-}
-{- Equal function:
-apply' sc t = do
+{- Same function:
+apply sc t = do
ctx <- get
let ctxModifier t ctx mod = do
put ctx

0 comments on commit adc0e72

Please sign in to comment.