- Overdesign of translator.

graninas · Feb 19, 2014 · adc0e72 · adc0e72
1 parent a414cd9
commit adc0e72
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 15 deletions.
diff --git a/Amoeba/GameLogic/Language/Translating/Actions.hs b/Amoeba/GameLogic/Language/Translating/Actions.hs
@@ -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
diff --git a/Amoeba/GameLogic/Language/Translating/Runtime.hs b/Amoeba/GameLogic/Language/Translating/Runtime.hs
@@ -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
diff --git a/Amoeba/GameLogic/Language/Translating/Translator.hs b/Amoeba/GameLogic/Language/Translating/Translator.hs
@@ -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