diff --git a/line2pdf.cabal b/line2pdf.cabal --- a/line2pdf.cabal +++ b/line2pdf.cabal @@ -1,5 +1,5 @@ name: line2pdf -version: 0.0.5 +version: 0.0.6 copyright: 2008 Audrey Tang license: BSD3 license-file: LICENSE diff --git a/line2pdf.hs b/line2pdf.hs --- a/line2pdf.hs +++ b/line2pdf.hs @@ -8,16 +8,17 @@ main = do args <- getArgs - (lang, input) <- case args of + (enc, input) <- case args of [] -> do - putStrLn "Usage: line2pdf [-big5|-gbk|-euc-jp|-euc-kr] input.txt > output.pdf" + putStrLn "Usage: line2pdf [-big5|-gbk|-shiftjis|-euc-jp|-euc-kr] input.txt > output.pdf" putStrLn " (Form feed (^L) in input denotes a pagebreak.)" exitWith ExitSuccess - ("-big5":i:_) -> return (TraditionalChinese, i) - ("-gbk":i:_) -> return (SimplifiedChinese, i) - ("-euc-jp":i:_) -> return (Japanese, i) - ("-euc-kr":i:_) -> return (Korean, i) - (i:_) -> return (Latin, i) + ("-big5":i:_) -> return (Big5, i) + ("-gbk":i:_) -> return (GBK, i) + ("-euc-jp":i:_) -> return (EUC_JP, i) + ("-euc-kr":i:_) -> return (EUC_KR, i) + ("-shiftjis":i:_) -> return (ShiftJIS, i) + (i:_) -> return (Latin, i) src <- L.readFile input - lineToPDF $ defaultConfig lang src + lineToPDF $ defaultConfig enc src diff --git a/src/Text/LineToPDF.hs b/src/Text/LineToPDF.hs --- a/src/Text/LineToPDF.hs +++ b/src/Text/LineToPDF.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ImplicitParams, ExistentialQuantification #-} -module Text.LineToPDF (lineToPDF, defaultConfig, AppConfig(..), Language(..)) where +module Text.LineToPDF (lineToPDF, defaultConfig, AppConfig(..), Encoding(..)) where import Data.IORef import System.IO import System.IO.Unsafe @@ -24,32 +24,35 @@ __PAGE__ :: IORef [Obj] __PAGE__ = unsafePerformIO (newRef []) -data Language +data Encoding = Latin - | TraditionalChinese - | SimplifiedChinese - | Japanese - | Korean + | Big5 + | GBK + | EUC_JP + | EUC_KR + | ShiftJIS data AppConfig = forall a. MkAppConfig { pageWidth :: Int , pageHeight :: Int , ptSize :: Float - , language :: Language + , encodings :: [Encoding] , srcLines :: [a] , srcPut :: a -> IO () + , srcEscape :: Char -> a -> a , srcLength :: a -> Int , srcHead :: a -> Char } -defaultConfig :: Language -> L.ByteString -> AppConfig -defaultConfig lang txt = MkAppConfig +defaultConfig :: Encoding -> L.ByteString -> AppConfig +defaultConfig enc txt = MkAppConfig { pageWidth = 842 , pageHeight = 595 , ptSize = 12 - , language = lang + , encodings = [enc] , srcLines = L.lines txt , srcPut = L.putStr + , srcEscape = \ch -> L.intercalate (L.pack ['\\', ch]) . L.split ch , srcLength = fromEnum . L.length , srcHead = L.head } @@ -63,7 +66,7 @@ pr$ "%PDF-1.2\n" ++ "%\xE2\xE3\xCF\xD3\n" - (info, root, tPages, resources) <- writeHeader appConfig + (info, root, tPages, resources) <- writeHeader $ encodings appConfig pageObjs <- let ?tPages = tPages ?resources = resources in writePages appConfig @@ -119,29 +122,30 @@ printObj :: String -> M Obj printObj str = markObj $ (pr str >>) . return -writeHeader :: AppConfig -> M (Obj, Obj, Obj, Obj) -writeHeader appConfig = do +writeHeader :: [Encoding] -> M (Obj, Obj, Obj, Obj) +writeHeader encs = do info <- printObj $ "/CreationDate(D:20080707163949+08'00')" ++ "/Producer(line2pdf.hs)" ++ "/Title(Untitled)" encoding <- printObj strDefaultEncoding - everyFont <- (`mapM` ([1..] `zip` baseFonts)) $ \(n, font) -> do + latinFonts <- (`mapM` ([1..] `zip` baseFonts)) $ \(n, font) -> do markObj $ \obj -> do pr$ "/Type/Font" ++ "/Subtype/Type1" ++ "/Name/F" pr$ show (n :: Int) pr$ "/Encoding " ++ show encoding ++ " 0 R" pr$ font return $ "/F" ++ show n ++ " " ++ show obj ++ " 0 R" - tradFont <- case language appConfig of - Latin -> return [] - TraditionalChinese -> writeTradChineseFonts - SimplifiedChinese -> writeSimpChineseFonts - Japanese -> writeJapaneseFonts - Korean -> writeKoreanFonts + cjkFonts <- (`mapM` encs) $ \enc -> case enc of + Latin -> return [] + Big5 -> writeFontsBig5 + GBK -> writeFontsGBK + EUC_JP -> writeFontsEUC_JP + EUC_KR -> writeFontsEUC_KR + ShiftJIS -> writeFontsShiftJIS root <- incrObj tPages <- incrObj markObj $ \resources -> do - pr$ "/Font<<" ++ concat everyFont ++ concat tradFont ++ ">>" + pr$ "/Font<<" ++ concat latinFonts ++ concat (concat cjkFonts) ++ ">>" ++ "/ProcSet[/PDF/Text]" ++ "/XObject<<>>" return (info, root, tPages, resources) @@ -200,15 +204,16 @@ loc <- currentLocation modifyRef __LOC__ $ IM.insert obj (show loc) -fontOf :: Language -> String -fontOf Latin = "1" -fontOf TraditionalChinese = "30" -fontOf SimplifiedChinese = "35" -fontOf Japanese = "20" -fontOf Korean = "40" +fontOf :: Encoding -> String +fontOf Latin = "1" +fontOf EUC_JP = "20" +fontOf ShiftJIS = "25" +fontOf Big5 = "30" +fontOf GBK = "35" +fontOf EUC_KR = "40" startPage :: (?tPages :: Obj, ?resources :: Obj) => AppConfig -> M Int -startPage MkAppConfig{ pageHeight = height, ptSize = pt, language = lang } = do +startPage MkAppConfig{ pageHeight = height, ptSize = pt, encodings = encs } = do markObj $ \obj -> do modifyRef __PAGE__ (obj:) pr$ "/Type/Page" @@ -225,7 +230,10 @@ streamPos <- currentLocation pr$ "BT\n"; - pr$ "/F" ++ fontOf lang ++ " " ++ show pt ++ " Tf\n" + let font = fontOf $ case encs of + (l:_) -> l + _ -> Latin + pr$ "/F" ++ font ++ " " ++ show pt ++ " Tf\n" pr$ "1 0 0 1 50 " ++ show (height - 40) ++ " Tm\n" pr$ show pt ++ " TL\n" @@ -251,19 +259,21 @@ , srcPut = put , srcHead = hd , srcLines = lns + , srcEscape = esc , pageHeight = height } = do pos <- newRef =<< startPage appConfig (`mapM_` lns) $ \ln -> do - case fromEnum (len ln) of + case len ln of 1 | hd ln == '\f' -> do endPage =<< readRef pos writeRef pos =<< startPage appConfig - len -> do + _ -> do pr$ "T*(" - put ln - modifyRef __POS__ (+ len) + let ln' = (esc '(' . esc ')' . esc '\\') ln + put ln' + modifyRef __POS__ (+ len ln') pr$ ")Tj\n" endPage =<< readRef pos @@ -319,8 +329,26 @@ , descriptor :: String } -writeJapaneseFonts :: M [String] -writeJapaneseFonts = writeFonts japaneseFonts $ MkFontConfig +writeFontsShiftJIS :: M [String] +writeFontsShiftJIS = writeFonts fontsShiftJIS $ MkFontConfig + { encoding = "90ms-RKSJ-H" + , cidFontType = "0" + , ordering = "Japan1" + , supplement = "2" + , wBox = "50 500 500" + , descriptor = "/Ascent 723" + ++ "/CapHeight 709" + ++ "/Descent -241" + ++ "/Flags 6" + ++ "/FontBBox[-123 -257 1001 910]" + ++ "/ItalicAngle 0" + ++ "/StemV 69" + ++ "/XHeight 450" + ++ "/Style<>>>>" + } + +writeFontsEUC_JP :: M [String] +writeFontsEUC_JP = writeFonts fontsEUC_JP $ MkFontConfig { encoding = "EUC-H" , cidFontType = "0" , ordering = "Japan1" @@ -337,8 +365,8 @@ ++ "/Style<>>>>" } -writeKoreanFonts :: M [String] -writeKoreanFonts = writeFonts koreanFonts $ MkFontConfig +writeFontsEUC_KR :: M [String] +writeFontsEUC_KR = writeFonts fontsEUC_KR $ MkFontConfig { encoding = "KSCms-UHC-H/WinCharSet 129" , cidFontType = "2" , ordering = "Korea1" @@ -360,8 +388,8 @@ ++ "/Style<>>" } -writeSimpChineseFonts :: M [String] -writeSimpChineseFonts = writeFonts simpChineseFonts $ MkFontConfig +writeFontsGBK :: M [String] +writeFontsGBK = writeFonts fontsGBK $ MkFontConfig { encoding = "GB-EUC-H" , cidFontType = "2" , ordering = "GB1" @@ -377,8 +405,8 @@ ++ "/ItalicAngle 0" } -writeTradChineseFonts :: M [String] -writeTradChineseFonts = writeFonts tradChineseFonts $ MkFontConfig +writeFontsBig5 :: M [String] +writeFontsBig5 = writeFonts fontsBig5 $ MkFontConfig { encoding = "ETen-B5-H" , cidFontType = "2" , ordering = "CNS1" @@ -439,19 +467,19 @@ , (n+3, f ++ ",BoldItalic") ] -japaneseFonts :: [(Int, String)] -japaneseFonts = concatMap (uncurry fontFamily) - [ (20, "HeiseiMin-W3-EUC-H") --- , (24, "HeiseiKakuGo-W5-EUC-H") - ] +fontsEUC_JP :: [(Int, String)] +fontsEUC_JP = fontFamily 20 "HeiseiMin-W3-EUC-H" -tradChineseFonts :: [(Int, String)] -tradChineseFonts = fontFamily 30 "MingLiU" +fontsShiftJIS :: [(Int, String)] +fontsShiftJIS = fontFamily 25 "HeiseiMin-W3-90ms-RKSJ-H" -simpChineseFonts :: [(Int, String)] -simpChineseFonts = fontFamily 35 "STSong" +fontsBig5 :: [(Int, String)] +fontsBig5 = fontFamily 30 "MingLiU" -koreanFonts :: [(Int, String)] -koreanFonts = fontFamily 40 "#B5#B8#BF#F2#C3#BC" +fontsGBK :: [(Int, String)] +fontsGBK = fontFamily 35 "STSong" + +fontsEUC_KR :: [(Int, String)] +fontsEUC_KR = fontFamily 40 "#B5#B8#BF#F2#C3#BC" -- Target size = AFP size / 3