From b1402e8bd6a68a891b00a214d6cf184d66defe19 Mon Sep 17 00:00:00 2001 From: aarne Date: Mon, 22 Sep 2003 13:16:55 +0000 Subject: Founding the newly structured GF2.0 cvs archive. --- src/tools/WriteF.hs | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 src/tools/WriteF.hs (limited to 'src/tools/WriteF.hs') diff --git a/src/tools/WriteF.hs b/src/tools/WriteF.hs new file mode 100644 index 000000000..fd491b4e5 --- /dev/null +++ b/src/tools/WriteF.hs @@ -0,0 +1,57 @@ +module Main where +import Fudgets +import System + +import Operations + +import Greek (mkGreek) +import Arabic (mkArabic) +import Hebrew (mkHebrew) +import Russian (mkRussian) + +-- AR 12/4/2000 + +main = do + xx <- getArgs + (case xx of + "HELP" : _ -> putStrLn usageWriteF + "FILE" : file : _ -> do + str <- readFileIf file + fudlogueWrite (Just str) + w:_ -> fudlogueWrite (Just (unwords xx)) + _ -> fudlogueWrite Nothing) + +usageWriteF = + "Usage: WriteF [-H20Mg -A5M] [FILE | | HELP]" ++++ + "Without arguments, an interactive display is opened." ++++ + "Prefix your string with / for Greek, - for Arabic, + for Hebrew, _ for Russian." + +fudlogueWrite mbstr = + fudlogue $ + shellF "Unicode Output" (writeF mbstr >+< quitButtonF) + +writeF Nothing = writeOutputF >==< writeInputF +writeF (Just str) = startupF [str] writeOutputF + +displaySizeP = placerF (spacerP (sizeS (Point 440 500)) verticalP) + +writeOutputF = + displaySizeP (moreF' (setFont myFont)) +--- displaySizeP (scrollF (displayF' (setFont myFont))) +--- >=^< +--- vboxD' 0 . map g + >==< + mapF (map mkUnicode . lines) + +writeInputF = stringInputF' (setShowString mkUnicode . setFont myFont) + +mkUnicode s = case s of + '/':cs -> mkGreek cs + '+':cs -> mkHebrew cs + '-':cs -> mkArabic cs + '_':cs -> mkRussian cs + _ -> s + +myFont = "-mutt-clearlyu-medium-r-normal--17-120-100-100-p-101-iso10646-1" +--- myFont = "-arabic-newspaper-medium-r-normal--32-246-100-100-p-137-iso10646-1" +--- myFont = "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1" -- cgit v1.2.3