line2pdf 0.0.3 → 0.0.4
raw patch · 3 files changed
+480/−319 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- line2pdf.cabal +12/−2
- line2pdf.hs +11/−317
- src/Text/LineToPDF.hs +457/−0
line2pdf.cabal view
@@ -1,5 +1,5 @@ name: line2pdf-version: 0.0.3+version: 0.0.4 copyright: 2008 Audrey Tang license: BSD3 license-file: LICENSE@@ -16,10 +16,20 @@ flag small_base description: Choose the new smaller, split-up base package. +library+ exposed-modules: Text.LineToPDF+ extensions: ImplicitParams, ExistentialQuantification+ if flag(small_base)+ build-depends: base >= 3, containers, bytestring+ else+ build-depends: base < 3+ hs-source-dirs: src+ executable line2pdf main-is: line2pdf.hs- extensions: ImplicitParams+ extensions: ImplicitParams, ExistentialQuantification if flag(small_base) build-depends: base >= 3, containers, bytestring else build-depends: base < 3+ hs-source-dirs: . src
line2pdf.hs view
@@ -1,329 +1,23 @@-{-# LANGUAGE ImplicitParams #-}--module Main (main) where-import Data.IORef-import System.IO-import System.IO.Unsafe+module Main where import System.Exit import System.Environment-import Control.Applicative+import Text.LineToPDF import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.IntMap as IM -{-# NOINLINE __POS__ #-}-__POS__ :: IORef Int-__POS__ = unsafePerformIO (newRef 0)--{-# NOINLINE __OBJ__ #-}-__OBJ__ :: IORef Int-__OBJ__ = unsafePerformIO (newRef 0)--{-# NOINLINE __LOC__ #-}-__LOC__ :: IORef (IM.IntMap String)-__LOC__ = unsafePerformIO (newRef IM.empty)--{-# NOINLINE __PAGE__ #-}-__PAGE__ :: IORef [Obj]-__PAGE__ = unsafePerformIO (newRef [])--type M = IO-type Obj = Int- main :: IO () main = do args <- getArgs - input <- case args of+ (lang, input) <- case args of [] -> do- putStrLn "Usage: line2pdf input.txt > output.pdf"+ putStrLn "Usage: line2pdf [-big5|-gbk|-euc-jp|-euc-kr] input.txt > output.pdf" putStrLn " (Form feed (^L) in input denotes a pagebreak.)" exitWith ExitSuccess- (i:_) -> return i-- hSetBinaryMode stdout True-- pr$ "%PDF-1.2\n" ++ "%\xE2\xE3\xCF\xD3\n"-- (info, root, tPages, resources) <- writeHeader-- pageObjs <- let ?tPages = tPages- ?resources = resources in writePages =<< (L.lines <$> L.readFile input)-- markLocation root- writeObj root $ do- pr$ "/Type/Catalog" ++ "/Pages "- pr$ show tPages ++ " 0 R" -- markLocation tPages- writeObj tPages $ do- pr$ "/Type/Pages" ++ "/Count "- pr$ show (length pageObjs)- ++ "/MediaBox[0 0 "- ++ show pageWidth ++ " " ++ show pageHeight- pr$ "]" ++ "/Kids["- pr$ concatMap ((++ " 0 R ") . show) pageObjs- pr$ "]"-- xfer <- currentLocation-- objCount <- incrObj- pr$ "xref\n" ++ "0 " ++ show objCount ++ "\n"- ++ "0000000000 65535 f \r"-- writeLocations-- pr$ "trailer\n" ++ "<<" ++ "/Size "- pr$ show objCount-- pr$ "/Root " ++ show root ++ " 0 R"- pr$ "/Info " ++ show info ++ " 0 R"- pr$ ">>\n" ++ "startxref\n"- pr$ show xfer ++ "\n" ++ "%%EOF\n"--writeObj :: Obj -> M a -> M a-writeObj obj f = do- pr$ show obj ++ " 0 obj" ++ "<<"- rv <- f- pr$ ">>" ++ "endobj\n"- return rv--writeLocations :: M ()-writeLocations = do- locs <- IM.elems <$> readRef __LOC__- pr$ concatMap fmt locs- where- fmt x = pad ++ x ++ " 00000 n \r"- where- pad = replicate (10-l) '0'- l = length x --printObj :: String -> M Obj-printObj str = markObj $ (pr str >>) . return--writeHeader :: M (Obj, Obj, Obj, Obj)-writeHeader = do- info <- printObj $ "/CreationDate(D:20080707163949+08'00')"- ++ "/Producer(line2pdf.hs)"- ++ "/Title(Untitled)"- encoding <- printObj strDefaultEncoding- everyFont <- (`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 <- writeTradChineseFonts- root <- incrObj- tPages <- incrObj- markObj $ \resources -> do- pr$ "/Font<<" ++ concat everyFont ++ concat tradFont ++ ">>"- ++ "/ProcSet[/PDF/Text]" ++ "/XObject<<>>"- return (info, root, tPages, resources)--baseFonts :: [String]-baseFonts =- [ "/BaseFont/Courier"- , "/BaseFont/Courier-Oblique"- , "/BaseFont/Courier-Bold"- , "/BaseFont/Courier-BoldOblique"- , "/BaseFont/Helvetica"- , "/BaseFont/Helvetica-Oblique"- , "/BaseFont/Helvetica-Bold"- , "/BaseFont/Helvetica-BoldOblique"- , "/BaseFont/Times-Roman"- , "/BaseFont/Times-Italic"- , "/BaseFont/Times-Bold"- , "/BaseFont/Times-BoldItalic"- , "/BaseFont/Symbol"- , "/BaseFont/ZapfDingbats"- ]- -pr :: String -> M ()-pr str = do- putStr str- modifyRef __POS__ (+ (length str))--currentLocation :: IO Int-currentLocation = readRef __POS__--newRef :: a -> M (IORef a)-newRef = newIORef--readRef :: IORef a -> M a-readRef = readIORef--writeRef :: IORef a -> a -> M ()-writeRef = writeIORef--modifyRef :: IORef a -> (a -> a) -> M ()-modifyRef = modifyIORef--incrObj :: M Obj-incrObj = do- obj <- succ <$> readRef __OBJ__- writeRef __OBJ__ obj- return obj--markObj :: (Obj -> M a) -> M a-markObj f = do- obj <- incrObj- markLocation obj- writeObj obj (f obj)--markLocation :: Obj -> M ()-markLocation obj = do- loc <- currentLocation- modifyRef __LOC__ $ IM.insert obj (show loc)--startPage :: (?tPages :: Obj, ?resources :: Obj) => M Int-startPage = do- markObj $ \obj -> do- modifyRef __PAGE__ (obj:)- pr$ "/Type/Page"- pr$ "/Parent " ++ show ?tPages ++ " 0 R"- pr$ "/Resources " ++ show ?resources ++ " 0 R"- pr$ "/Contents " ++ show (succ obj) ++ " 0 R"- pr$ "/Rotate 0"-- obj <- incrObj- markLocation obj- pr$ show obj ++ " 0 obj" ++ "<<"- pr$ "/Length " ++ show (succ obj) ++ " 0 R"- pr$ ">>" ++ "stream\n"-- streamPos <- currentLocation- pr$ "BT\n";- let fontN = 30 :: Int- ptSize = 12 :: Int- pr$ "/F" ++ show fontN ++ " " ++ show ptSize ++ " Tf\n"- pr$ "1 0 0 1 50 " ++ show (pageHeight - 40) ++ " Tm\n"- pr$ "12 TL\n"-- return streamPos--endPage :: Int -> M ()-endPage streamStart = do- pr$ "ET\n"- streamEnd <- currentLocation- pr$ "endstream\n"- ++ "endobj\n"-- obj <- incrObj- markLocation obj-- pr$ show obj ++ " 0 obj\n"- ++ show (streamEnd - streamStart) ++ "\n"- ++ "endobj\n"--writePages :: (?tPages :: Obj, ?resources :: Obj) => [L.ByteString] -> M [Obj]-writePages lns = do- pos <- newRef =<< startPage-- (`mapM_` lns) $ \ln -> do- case fromEnum (L.length ln) of- 1 | L.head ln == '\f' -> do- endPage =<< readRef pos- writeRef pos =<< startPage- len -> do- pr$ "T*("- L.putStr ln- modifyRef __POS__ (+ len)- pr$ ")Tj\n"-- endPage =<< readRef pos- reverse <$> readRef __PAGE__--strDefaultEncoding :: String-strDefaultEncoding = "/Type/Encoding"- ++ "/Differences[0 /.notdef/.notdef/.notdef/.notdef"- ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"- ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"- ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"- ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"- ++ "/.notdef/.notdef/.notdef/.notdef/space/exclam"- ++ "/quotedbl/numbersign/dollar/percent/ampersand"- ++ "/quoteright/parenleft/parenright/asterisk/plus/comma"- ++ "/hyphen/period/slash/zero/one/two/three/four/five"- ++ "/six/seven/eight/nine/colon/semicolon/less/equal"- ++ "/greater/question/at/A/B/C/D/E/F/G/H/I/J/K/L"- ++ "/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft"- ++ "/backslash/bracketright/asciicircum/underscore"- ++ "/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p"- ++ "/q/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright"- ++ "/asciitilde/.notdef/.notdef/.notdef/.notdef/.notdef"- ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"- ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"- ++ "/dotlessi/grave/acute/circumflex/tilde/macron/breve"- ++ "/dotaccent/dieresis/.notdef/ring/cedilla/.notdef"- ++ "/hungarumlaut/ogonek/caron/space/exclamdown/cent"- ++ "/sterling/currency/yen/brokenbar/section/dieresis"- ++ "/copyright/ordfeminine/guillemotleft/logicalnot/hyphen"- ++ "/registered/macron/degree/plusminus/twosuperior"- ++ "/threesuperior/acute/mu/paragraph/periodcentered"- ++ "/cedilla/onesuperior/ordmasculine/guillemotright"- ++ "/onequarter/onehalf/threequarters/questiondown/Agrave"- ++ "/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE"- ++ "/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave"- ++ "/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve"- ++ "/Oacute/Ocircumflex/Otilde/Odieresis/multiply/Oslash"- ++ "/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn"- ++ "/germandbls/agrave/aacute/acircumflex/atilde/adieresis"- ++ "/aring/ae/ccedilla/egrave/eacute/ecircumflex"- ++ "/edieresis/igrave/iacute/icircumflex/idieresis/eth"- ++ "/ntilde/ograve/oacute/ocircumflex/otilde/odieresis"- ++ "/divide/oslash/ugrave/uacute/ucircumflex/udieresis"- ++ "/yacute/thorn/ydieresis]"--pageWidth :: Int-pageWidth = 792--pageHeight :: Int-pageHeight = 612--writeTradChineseFonts :: M [String]-writeTradChineseFonts = do- tradFont <- newRef []- let addFont o fn = modifyRef tradFont- (("/F" ++ show fn ++ " " ++ show o ++ " 0 R"):)- markFont fn name = do- markObj $ \obj -> do- addFont obj fn- pr$ "/Type/Font"- ++ "/Subtype/Type0"- ++ "/Name/F"- pr$ show fn ++ "/BaseFont/"- pr$ name ++ "/Encoding/ETen-B5-H"- pr$ "/DescendantFonts[" ++ show (succ obj) ++ " 0 R]"- markObj $ \obj -> do- pr$ "/Type/Font"- ++ "/Subtype/CIDFontType2"- ++ "/BaseFont/"- pr$ name ++ "/FontDescriptor " ++ show (succ obj) ++ " 0 R"- ++ "/CIDSystemInfo<<"- ++ "/Registry(Adobe)"- ++ "/Ordering(CNS1)"- ++ "/Supplement 0"- ++ ">>"- ++ "/DW 1000"- ++ "/W[13500 14000 500]"- printObj $ "/Type/FontDescriptor"- ++ "/FontName/"- ++ takeWhile (/= ',') name- ++ "/FontBBox[0 -199 1000 801]"- ++ "/Flags 7"- ++ "/CapHeight 0"- ++ "/Ascent 800"- ++ "/Descent -199"- ++ "/StemV 0"- ++ "/ItalicAngle 0"- mapM_ (uncurry markFont) tradChineseFonts- readRef tradFont+ ("-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) -tradChineseFonts :: [(Int, String)]-tradChineseFonts =- [ (30, "MingLiU")- , (31, "MingLiU,Italic")- , (32, "MingLiU,Bold")- , (33, "MingLiU,BoldItalic")- ]+ src <- L.readFile input+ lineToPDF $ defaultConfig lang src
+ src/Text/LineToPDF.hs view
@@ -0,0 +1,457 @@+{-# LANGUAGE ImplicitParams, ExistentialQuantification #-}++module Text.LineToPDF (lineToPDF, defaultConfig, AppConfig(..), Language(..)) where+import Data.IORef+import System.IO+import System.IO.Unsafe+import Control.Applicative+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.IntMap as IM++{-# NOINLINE __POS__ #-}+__POS__ :: IORef Int+__POS__ = unsafePerformIO (newRef 0)++{-# NOINLINE __OBJ__ #-}+__OBJ__ :: IORef Int+__OBJ__ = unsafePerformIO (newRef 0)++{-# NOINLINE __LOC__ #-}+__LOC__ :: IORef (IM.IntMap String)+__LOC__ = unsafePerformIO (newRef IM.empty)++{-# NOINLINE __PAGE__ #-}+__PAGE__ :: IORef [Obj]+__PAGE__ = unsafePerformIO (newRef [])++data Language+ = Latin+ | TraditionalChinese+ | SimplifiedChinese+ | Japanese+ | Korean++data AppConfig = forall a. MkAppConfig+ { pageWidth :: Int+ , pageHeight :: Int+ , ptSize :: Int+ , language :: Language+ , srcLines :: [a]+ , srcPut :: a -> IO ()+ , srcLength :: a -> Int+ , srcHead :: a -> Char+ }++defaultConfig :: Language -> L.ByteString -> AppConfig+defaultConfig lang txt = MkAppConfig+ { pageWidth = 842+ , pageHeight = 595+ , ptSize = 12+ , language = lang+ , srcLines = L.lines txt+ , srcPut = L.putStr+ , srcLength = fromEnum . L.length+ , srcHead = L.head+ }++type M = IO+type Obj = Int++lineToPDF :: AppConfig -> IO ()+lineToPDF appConfig = do+ hSetBinaryMode stdout True++ pr$ "%PDF-1.2\n" ++ "%\xE2\xE3\xCF\xD3\n"++ (info, root, tPages, resources) <- writeHeader appConfig++ pageObjs <- let ?tPages = tPages+ ?resources = resources in writePages appConfig++ markLocation root+ writeObj root $ do+ pr$ "/Type/Catalog" ++ "/Pages "+ pr$ show tPages ++ " 0 R" ++ markLocation tPages+ writeObj tPages $ do+ pr$ "/Type/Pages" ++ "/Count "+ pr$ show (length pageObjs)+ ++ "/MediaBox[0 0 "+ ++ show (pageWidth appConfig) ++ " " ++ show (pageHeight appConfig)+ pr$ "]" ++ "/Kids["+ pr$ concatMap ((++ " 0 R ") . show) pageObjs+ pr$ "]"++ xfer <- currentLocation++ objCount <- incrObj+ pr$ "xref\n" ++ "0 " ++ show objCount ++ "\n"+ ++ "0000000000 65535 f \r"++ writeLocations++ pr$ "trailer\n" ++ "<<" ++ "/Size "+ pr$ show objCount++ pr$ "/Root " ++ show root ++ " 0 R"+ pr$ "/Info " ++ show info ++ " 0 R"+ pr$ ">>\n" ++ "startxref\n"+ pr$ show xfer ++ "\n" ++ "%%EOF\n"++writeObj :: Obj -> M a -> M a+writeObj obj f = do+ pr$ show obj ++ " 0 obj" ++ "<<"+ rv <- f+ pr$ ">>" ++ "endobj\n"+ return rv++writeLocations :: M ()+writeLocations = do+ locs <- IM.elems <$> readRef __LOC__+ pr$ concatMap fmt locs+ where+ fmt x = pad ++ x ++ " 00000 n \r"+ where+ pad = replicate (10-l) '0'+ l = length x ++printObj :: String -> M Obj+printObj str = markObj $ (pr str >>) . return++writeHeader :: AppConfig -> M (Obj, Obj, Obj, Obj)+writeHeader appConfig = do+ info <- printObj $ "/CreationDate(D:20080707163949+08'00')"+ ++ "/Producer(line2pdf.hs)"+ ++ "/Title(Untitled)"+ encoding <- printObj strDefaultEncoding+ everyFont <- (`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+ root <- incrObj+ tPages <- incrObj+ markObj $ \resources -> do+ pr$ "/Font<<" ++ concat everyFont ++ concat tradFont ++ ">>"+ ++ "/ProcSet[/PDF/Text]" ++ "/XObject<<>>"+ return (info, root, tPages, resources)++baseFonts :: [String]+baseFonts =+ [ "/BaseFont/Courier"+ , "/BaseFont/Courier-Oblique"+ , "/BaseFont/Courier-Bold"+ , "/BaseFont/Courier-BoldOblique"+ , "/BaseFont/Helvetica"+ , "/BaseFont/Helvetica-Oblique"+ , "/BaseFont/Helvetica-Bold"+ , "/BaseFont/Helvetica-BoldOblique"+ , "/BaseFont/Times-Roman"+ , "/BaseFont/Times-Italic"+ , "/BaseFont/Times-Bold"+ , "/BaseFont/Times-BoldItalic"+ , "/BaseFont/Symbol"+ , "/BaseFont/ZapfDingbats"+ ]+ +pr :: String -> M ()+pr str = do+ putStr str+ modifyRef __POS__ (+ (length str))++currentLocation :: IO Int+currentLocation = readRef __POS__++newRef :: a -> M (IORef a)+newRef = newIORef++readRef :: IORef a -> M a+readRef = readIORef++writeRef :: IORef a -> a -> M ()+writeRef = writeIORef++modifyRef :: IORef a -> (a -> a) -> M ()+modifyRef = modifyIORef++incrObj :: M Obj+incrObj = do+ obj <- succ <$> readRef __OBJ__+ writeRef __OBJ__ obj+ return obj++markObj :: (Obj -> M a) -> M a+markObj f = do+ obj <- incrObj+ markLocation obj+ writeObj obj (f obj)++markLocation :: Obj -> M ()+markLocation obj = do+ 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"++startPage :: (?tPages :: Obj, ?resources :: Obj) => AppConfig -> M Int+startPage MkAppConfig{ pageHeight = height, ptSize = pt, language = lang } = do+ markObj $ \obj -> do+ modifyRef __PAGE__ (obj:)+ pr$ "/Type/Page"+ pr$ "/Parent " ++ show ?tPages ++ " 0 R"+ pr$ "/Resources " ++ show ?resources ++ " 0 R"+ pr$ "/Contents " ++ show (succ obj) ++ " 0 R"+ pr$ "/Rotate 0"++ obj <- incrObj+ markLocation obj+ pr$ show obj ++ " 0 obj" ++ "<<"+ pr$ "/Length " ++ show (succ obj) ++ " 0 R"+ pr$ ">>" ++ "stream\n"++ streamPos <- currentLocation+ pr$ "BT\n";+ pr$ "/F" ++ fontOf lang ++ " " ++ show pt ++ " Tf\n"+ pr$ "1 0 0 1 50 " ++ show (height - 40) ++ " Tm\n"+ pr$ "12 TL\n"++ return streamPos++endPage :: Int -> M ()+endPage streamStart = do+ pr$ "ET\n"+ streamEnd <- currentLocation+ pr$ "endstream\n"+ ++ "endobj\n"++ obj <- incrObj+ markLocation obj++ pr$ show obj ++ " 0 obj\n"+ ++ show (streamEnd - streamStart) ++ "\n"+ ++ "endobj\n"++writePages :: (?tPages :: Obj, ?resources :: Obj) => AppConfig -> M [Obj]+writePages appConfig@MkAppConfig+ { srcLength = len+ , srcPut = put+ , srcHead = hd+ , srcLines = lns+ , pageHeight = height+ } = do+ pos <- newRef =<< startPage appConfig++ (`mapM_` lns) $ \ln -> do+ case fromEnum (len ln) of+ 1 | hd ln == '\f' -> do+ endPage =<< readRef pos+ writeRef pos =<< startPage appConfig+ len -> do+ pr$ "T*("+ put ln+ modifyRef __POS__ (+ len)+ pr$ ")Tj\n"++ endPage =<< readRef pos+ reverse <$> readRef __PAGE__++strDefaultEncoding :: String+strDefaultEncoding = "/Type/Encoding"+ ++ "/Differences[0 /.notdef/.notdef/.notdef/.notdef"+ ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"+ ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"+ ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"+ ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"+ ++ "/.notdef/.notdef/.notdef/.notdef/space/exclam"+ ++ "/quotedbl/numbersign/dollar/percent/ampersand"+ ++ "/quoteright/parenleft/parenright/asterisk/plus/comma"+ ++ "/hyphen/period/slash/zero/one/two/three/four/five"+ ++ "/six/seven/eight/nine/colon/semicolon/less/equal"+ ++ "/greater/question/at/A/B/C/D/E/F/G/H/I/J/K/L"+ ++ "/M/N/O/P/Q/R/S/T/U/V/W/X/Y/Z/bracketleft"+ ++ "/backslash/bracketright/asciicircum/underscore"+ ++ "/quoteleft/a/b/c/d/e/f/g/h/i/j/k/l/m/n/o/p"+ ++ "/q/r/s/t/u/v/w/x/y/z/braceleft/bar/braceright"+ ++ "/asciitilde/.notdef/.notdef/.notdef/.notdef/.notdef"+ ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"+ ++ "/.notdef/.notdef/.notdef/.notdef/.notdef/.notdef"+ ++ "/dotlessi/grave/acute/circumflex/tilde/macron/breve"+ ++ "/dotaccent/dieresis/.notdef/ring/cedilla/.notdef"+ ++ "/hungarumlaut/ogonek/caron/space/exclamdown/cent"+ ++ "/sterling/currency/yen/brokenbar/section/dieresis"+ ++ "/copyright/ordfeminine/guillemotleft/logicalnot/hyphen"+ ++ "/registered/macron/degree/plusminus/twosuperior"+ ++ "/threesuperior/acute/mu/paragraph/periodcentered"+ ++ "/cedilla/onesuperior/ordmasculine/guillemotright"+ ++ "/onequarter/onehalf/threequarters/questiondown/Agrave"+ ++ "/Aacute/Acircumflex/Atilde/Adieresis/Aring/AE"+ ++ "/Ccedilla/Egrave/Eacute/Ecircumflex/Edieresis/Igrave"+ ++ "/Iacute/Icircumflex/Idieresis/Eth/Ntilde/Ograve"+ ++ "/Oacute/Ocircumflex/Otilde/Odieresis/multiply/Oslash"+ ++ "/Ugrave/Uacute/Ucircumflex/Udieresis/Yacute/Thorn"+ ++ "/germandbls/agrave/aacute/acircumflex/atilde/adieresis"+ ++ "/aring/ae/ccedilla/egrave/eacute/ecircumflex"+ ++ "/edieresis/igrave/iacute/icircumflex/idieresis/eth"+ ++ "/ntilde/ograve/oacute/ocircumflex/otilde/odieresis"+ ++ "/divide/oslash/ugrave/uacute/ucircumflex/udieresis"+ ++ "/yacute/thorn/ydieresis]"++data FontConfig = MkFontConfig+ { encoding :: String+ , cidFontType :: String+ , ordering :: String+ , supplement :: String+ , wBox :: String+ , descriptor :: String+ }++writeJapaneseFonts :: M [String]+writeJapaneseFonts = writeFonts japaneseFonts $ MkFontConfig+ { encoding = "EUC-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>>>>>"+ }++writeKoreanFonts :: M [String]+writeKoreanFonts = writeFonts koreanFonts $ MkFontConfig+ { encoding = "KSCms-UHC-H/WinCharSet 129"+ , cidFontType = "2"+ , ordering = "Korea1"+ , supplement = "0"+ , wBox = "0 1000 500"+ , descriptor = "/Flags 7"+ ++ "/FontBBox[-100 -142 102 1000]"+ ++ "/MissingWidth 500"+ ++ "/StemV 91"+ ++ "/StemH 91"+ ++ "/ItalicAngle 0"+ ++ "/CapHeight 858"+ ++ "/XHeight 429"+ ++ "/Ascent 858"+ ++ "/Descent -142"+ ++ "/Leading 148"+ ++ "/MaxWidth 2"+ ++ "/AvgWidth 500"+ ++ "/Style<</Panose<000000400000000000000000>>>"+ }++writeSimpChineseFonts :: M [String]+writeSimpChineseFonts = writeFonts simpChineseFonts $ MkFontConfig+ { encoding = "GB-EUC-H"+ , cidFontType = "2"+ , ordering = "GB1"+ , supplement = "0"+ , wBox = "500 1000 500 7716 [500]"+ , descriptor = "/FontBBox[0 -199 1000 801]"+ ++ "/Flags 6"+ ++ "/CapHeight 658"+ ++ "/Ascent 801"+ ++ "/Descent -199"+ ++ "/StemV 56"+ ++ "/XHeight 429"+ ++ "/ItalicAngle 0"+ }++writeTradChineseFonts :: M [String]+writeTradChineseFonts = writeFonts tradChineseFonts $ MkFontConfig+ { encoding = "ETen-B5-H"+ , cidFontType = "2"+ , ordering = "CNS1"+ , supplement = "0"+ , wBox = "13500 14000 500"+ , descriptor = "/FontBBox[0 -199 1000 801]"+ ++ "/Flags 7"+ ++ "/CapHeight 0"+ ++ "/Ascent 800"+ ++ "/Descent -199"+ ++ "/StemV 0"+ ++ "/ItalicAngle 0"+ }++writeFonts fonts cfg = do + ref <- newRef []+ let addFont o fn = modifyRef ref+ (("/F" ++ show fn ++ " " ++ show o ++ " 0 R"):)+ markFont fn name = do+ markObj $ \obj -> do+ addFont obj fn+ pr$ "/Type/Font"+ ++ "/Subtype/Type0"+ ++ "/Name/F"+ pr$ show fn ++ "/BaseFont/"+ pr$ name ++ "/Encoding/" ++ encoding cfg+ pr$ "/DescendantFonts[" ++ show (succ obj) ++ " 0 R]"+ markObj $ \obj -> do+ pr$ "/Type/Font"+ ++ "/Subtype/CIDFontType"+ pr$ cidFontType cfg+ ++ "/BaseFont/"+ pr$ name ++ "/FontDescriptor " ++ show (succ obj) ++ " 0 R"+ ++ "/CIDSystemInfo<<"+ ++ "/Registry(Adobe)"+ ++ "/Ordering("+ pr$ ordering cfg+ ++ ")"+ ++ "/Supplement "+ pr$ supplement cfg+ ++ ">>"+ ++ "/DW 1000"+ ++ "/W["+ pr$ wBox cfg+ ++ "]"+ printObj $ "/Type/FontDescriptor"+ ++ "/FontName/"+ ++ takeWhile (/= ',') name+ ++ descriptor cfg+ mapM_ (uncurry markFont) fonts+ readRef ref++fontFamily :: Int -> String -> [(Int, String)]+fontFamily n f =+ [ (n, f)+ , (n+1, f ++ ",Italic")+ , (n+2, f ++ ",Bold")+ , (n+3, f ++ ",BoldItalic")+ ]++japaneseFonts :: [(Int, String)]+japaneseFonts = concatMap (uncurry fontFamily)+ [ (20, "HeiseiMin-W3-EUC-H")+-- , (24, "HeiseiKakuGo-W5-EUC-H")+ ]++tradChineseFonts :: [(Int, String)]+tradChineseFonts = fontFamily 30 "MingLiU"++simpChineseFonts :: [(Int, String)]+simpChineseFonts = fontFamily 35 "STSong"++koreanFonts :: [(Int, String)]+koreanFonts = fontFamily 40 "#B5#B8#BF#F2#C3#BC"++-- Target size = AFP size / 3