line2pdf 0.0.5 → 0.0.6
raw patch · 3 files changed
+90/−61 lines, 3 files
Files
- line2pdf.cabal +1/−1
- line2pdf.hs +9/−8
- src/Text/LineToPDF.hs +80/−52
line2pdf.cabal view
@@ -1,5 +1,5 @@ name: line2pdf-version: 0.0.5+version: 0.0.6 copyright: 2008 Audrey Tang license: BSD3 license-file: LICENSE
line2pdf.hs view
@@ -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
src/Text/LineToPDF.hs view
@@ -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<</Panose<010502020400000000000000>>>>>"+ }++writeFontsEUC_JP :: M [String]+writeFontsEUC_JP = writeFonts fontsEUC_JP $ MkFontConfig { encoding = "EUC-H" , cidFontType = "0" , ordering = "Japan1"@@ -337,8 +365,8 @@ ++ "/Style<</Panose<010502020400000000000000>>>>>" } -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<</Panose<000000400000000000000000>>>" } -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