GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-09 03:02:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

globalized the resource tour

Browse Source
This commit is contained in:
aarne
2010-04-30 13:44:33 +00:00
parent a47df1d54e
commit 65ede6ff35
4 changed files with 1319 additions and 153 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
lib/doc/tour/MkTour.hs
View File

@@ -1,5 +1,6 @@
module Main where
import Char
import System
original = "tour.txt"
@@ -14,27 +15,30 @@ main = do
writeFile txt []
script <- mkTour lan language src txt gfs
system $ "gf -s Demo.pgf <" ++ gfs
system $ "txt2tags -thtml " ++ txt
system $ "txt2tags --toc -thtml " ++ txt
mkTour :: String -> String -> [String] -> FilePath -> FilePath -> IO ()
mkTour lan language src txt gfs = mapM_ mk src where
mk line = case line of
'>':command -> do -- gf command
let comm = loc command
apptxt ('>':comm)
appgfs (comm ++ " | " ++ appcomm)
appgfs "\n"
'*':_ -> return () -- gf-generated text
'#':_ -> return () -- Swedish-specific line
_ -> apptxt (loc line)
mk ll = do
let (lans,line) = lansline ll
if (not (null lans) && not (elem lan lans)) -- language-specific, not for lan
then return ()
else case line of
'>':command -> do -- gf command
let comm = loc command
apptxt ('>':comm)
appgfs (comm ++ " | " ++ appcomm)
appgfs "\n"
'*':_ -> return () -- gf-generated text
_ -> apptxt (loc line)
appgfs line = appendFile gfs line >> appendFile gfs "\n"
loc line = case line of
'S':'w':'e':'d':'i':'s':'h':cs -> language ++ loc cs
'S':'w':'e' :cs -> lan ++ loc cs
'L':'A':'N':'G':'U':'A':'G':'E':cs -> language ++ loc cs
'L':'N':'G' :cs -> lan ++ loc cs
c :cs -> c : loc cs
_ -> line
@@ -42,6 +46,9 @@ mkTour lan language src txt gfs = mapM_ mk src where
appcomm = "wf -append -file=" ++ txt
lansline ll = case ll of
'#':cs -> let (la,li) = break isSpace cs in (langs la, drop 1 li)
_ -> ([],ll)
langs = words . (map (\c -> if c==',' then ' ' else c))