tools/pas2c.hs
branchwebgl
changeset 7953 97f41bdf0770
parent 7949 91511b219de7
child 7957 497ec84e0c21
--- a/tools/pas2c.hs	Sat Nov 03 23:44:49 2012 +0100
+++ b/tools/pas2c.hs	Sun Nov 04 02:13:25 2012 +0100
@@ -94,11 +94,11 @@
 docToLower :: Doc -> Doc
 docToLower = text . map toLower . render
 
-pas2C :: String -> IO ()
-pas2C fn = do
-    setCurrentDirectory "../hedgewars/"
+pas2C :: String -> String -> String -> IO ()
+pas2C fn inputPath outputPath = do
+    setCurrentDirectory inputPath
     s <- flip execStateT initState $ f fn
-    renderCFiles s
+    renderCFiles s outputPath
     where
     printLn = liftIO . hPutStrLn stdout
     print = liftIO . hPutStr stdout
@@ -120,7 +120,7 @@
                     let ptree = parse pascalUnit fileName fc
                     case ptree of
                          (Left a) -> do
-                            liftIO $ writeFile "preprocess.out" fc
+                            liftIO $ writeFile (outputPath ++ "preprocess.out") fc
                             printLn $ show a ++ "\nsee preprocess.out for preprocessed source"
                             fail "stop"
                          (Right a) -> do
@@ -129,13 +129,13 @@
                             mapM_ f (usesFiles a)
 
 
-renderCFiles :: Map.Map String PascalUnit -> IO ()
-renderCFiles units = do
+renderCFiles :: Map.Map String PascalUnit -> String -> IO ()
+renderCFiles units outputPath = do
     let u = Map.toList units
     let nss = Map.map (toNamespace nss) units
     --hPutStrLn stderr $ "Units: " ++ (show . Map.keys . Map.filter (not . Map.null) $ nss)
     --writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss
-    mapM_ (toCFiles nss) u
+    mapM_ (toCFiles outputPath nss) u
     where
     toNamespace :: Map.Map String Records -> PascalUnit -> Records
     toNamespace nss (System tvs) =
@@ -179,19 +179,19 @@
         records = Map.fromList $ map (\(Record a b d) -> (map toLower a, [Record (prefix ++ a) b d])) recs
         un [a] b = a : b
 
-toCFiles :: Map.Map String Records -> (String, PascalUnit) -> IO ()
-toCFiles _ (_, System _) = return ()
-toCFiles _ (_, Redo _) = return ()
-toCFiles ns p@(fn, pu) = do
+toCFiles :: String -> Map.Map String Records -> (String, PascalUnit) -> IO ()
+toCFiles _ _ (_, System _) = return ()
+toCFiles _ _ (_, Redo _) = return ()
+toCFiles outputPath ns p@(fn, pu) = do
     hPutStrLn stdout $ "Rendering '" ++ fn ++ "'..."
     toCFiles' p
     where
-    toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p
+    toCFiles' (fn, p@(Program {})) = writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p
     toCFiles' (fn, (Unit unitId@(Identifier i _) interface implementation _ _)) = do
         let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface True) initialState{currentUnit = map toLower i ++ "_"}
             (a', s') = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface False) initialState{currentUnit = map toLower i ++ "_"}
-        writeFile (fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text ""))
-        writeFile (fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation
+        writeFile (outputPath ++ fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text ""))
+        writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation
     initialState = emptyState ns
 
     render2C :: RenderState -> State RenderState Doc -> String
@@ -1084,4 +1084,8 @@
 op2C "/" = "/(float)"
 op2C a = a
 
-main = pas2C "hwengine"
+main = do
+    let programName = "hwengine"
+    let inputPath = "../hedgewars/"
+    let outputPath = "./"
+    pas2C programName inputPath outputPath