Disable gfMoreWind for land objects on turn end only after a fixed-time delay
15s sounds much, but it's the average amount for gfMineStrike mines to settle
naturally. And it would be very confusing to see falling mines suddenly not
caring about gfMoreWind for no apparent reason.
Note this whole thing is a giant hack anyway, to prevent a turn being
blocked by infinitely bouncing mines.
The better solution would be to help gfMoreWind-affected land objects settle
naturally more reliably even under extreme wind.
But this commit is "good enough" for now.
If you don't like the delay, you can always tweak the constant.
{-# LANGUAGE ScopedTypeVariables #-}
module PascalPreprocessor where
import Text.Parsec
import Control.Monad.IO.Class
import Control.Monad
import System.IO
import qualified Data.Map as Map
import qualified Control.Exception as E
char' :: Char -> ParsecT String u IO ()
char' = void . char
string' :: String -> ParsecT String u IO ()
string' = void . string
-- comments are removed
comment :: ParsecT String u IO String
comment = choice [
char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
, (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
, (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
]
preprocess :: String -> String -> String -> [String] -> IO String
preprocess inputPath alternateInputPath fn symbols = do
r <- runParserT (preprocessFile (inputPath ++ fn)) (Map.fromList $ map (\s -> (s, "")) symbols, [True]) "" ""
case r of
(Left a) -> do
hPutStrLn stderr (show a)
return ""
(Right a) -> return a
where
preprocessFile fn' = do
f <- liftIO (readFile fn')
setInput f
preprocessor
preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
preprocessor = chainr codeBlock (return (++)) ""
codeBlock = do
s <- choice [
switch
, comment
, char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
, identifier >>= replace
, noneOf "{" >>= \a -> return [a]
]
(_, ok) <- getState
return $ if and ok then s else ""
--otherChar c = c `notElem` "{/('_" && not (isAlphaNum c)
identifier = do
c <- letter <|> oneOf "_"
s <- many (alphaNum <|> oneOf "_")
return $ c:s
switch = do
try $ string' "{$"
s <- choice [
include
, ifdef
, if'
, elseSwitch
, endIf
, define
, unknown
]
return s
include = do
try $ string' "INCLUDE"
spaces
(char' '"')
ifn <- many1 $ noneOf "\"\n"
char' '"'
spaces
char' '}'
f <- liftIO (readFile (inputPath ++ ifn)
`E.catch` (\(_ :: E.IOException) -> readFile (alternateInputPath ++ ifn)
`E.catch` (\(_ :: E.IOException) -> error $ "File not found: " ++ ifn)
)
)
c <- getInput
setInput $ f ++ c
return ""
ifdef = do
s <- try (string "IFDEF") <|> try (string "IFNDEF")
let f = if s == "IFNDEF" then not else id
ds <- (spaces >> identifier) `sepBy` (spaces >> string "OR")
spaces
char' '}'
updateState $ \(m, b) ->
(m, (f $ any (flip Map.member m) ds) : b)
return ""
if' = do
try (string' "IF" >> notFollowedBy alphaNum)
void $ manyTill anyChar (char' '}')
--char '}'
updateState $ \(m, b) ->
(m, False : b)
return ""
elseSwitch = do
try $ string' "ELSE}"
updateState $ \(m, b:bs) -> (m, (not b):bs)
return ""
endIf = do
try $ string' "ENDIF}"
updateState $ \(m, _:bs) -> (m, bs)
return ""
define = do
try $ string' "DEFINE"
spaces
i <- identifier
d <- ((string ":=" >> return ()) <|> spaces) >> many (noneOf "}")
char' '}'
updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b)
return ""
replace s = do
(m, _) <- getState
return $ Map.findWithDefault s s m
unknown = do
un <- many1 $ noneOf "}\n"
char' '}'
return $ "{$" ++ un ++ "}"