diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -The "MIT" License +Copyright 2004-2008 by Audrey Tang Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/OpenAFP-Utils.cabal b/OpenAFP-Utils.cabal --- a/OpenAFP-Utils.cabal +++ b/OpenAFP-Utils.cabal @@ -1,5 +1,5 @@ Name: OpenAFP-Utils -Version: 1.2.1 +Version: 1.3 License: BSD3 License-file: LICENSE Author: Audrey Tang @@ -8,58 +8,64 @@ Description: Assorted utilities to work with AFP data streams Category: Data Build-type: Simple +Cabal-Version: >= 1.2 -Executable: afp-dump -Main-is: afp-dump.hs -Build-depends: OpenAFP, haskell98, base, bytestring, containers, uconv, xhtml -Extensions: DeriveDataTypeable, PatternGuards +Executable afp2line2pdf + Main-is: afp2line2pdf.hs + Build-depends: OpenAFP >= 1.2, haskell98, base, line2pdf >= 0.0.7 + Extensions: StandaloneDeriving, GeneralizedNewtypeDeriving, ImplicitParams, + ExistentialQuantification, PatternGuards -Executable: afp-page -Main-is: afp-page.hs -Build-depends: OpenAFP, haskell98, base +Executable afp-olndump + Main-is: afp-olndump.hs + Build-depends: OpenAFP >= 1.2, haskell98, base, bytestring, containers, binary -Executable: afp-replace -Main-is: afp-replace.hs -Build-depends: OpenAFP, haskell98, base -Extensions: DeriveDataTypeable, FlexibleContexts, PatternGuards +Executable afp-dump + Main-is: afp-dump.hs + Build-depends: OpenAFP >= 1.2, haskell98, base, bytestring, containers, uconv, xhtml + Extensions: DeriveDataTypeable, PatternGuards -Executable: afp-scanudc -Main-is: afp-scanudc.hs -Build-depends: OpenAFP, haskell98, base, directory -Extensions: BangPatterns +Executable afp-page + Main-is: afp-page.hs + Build-depends: OpenAFP >= 1.2, haskell98, base -Executable: afp-split -Main-is: afp-split.hs -Build-depends: OpenAFP, haskell98, base +Executable afp-replace + Main-is: afp-replace.hs + Build-depends: OpenAFP >= 1.2, haskell98, base + Extensions: DeriveDataTypeable, FlexibleContexts, PatternGuards -Executable: afp-split-scb -Main-is: afp-split-scb.hs -Build-depends: OpenAFP, haskell98, base +Executable afp-scanudc + Main-is: afp-scanudc.hs + Build-depends: OpenAFP >= 1.2, haskell98, base>=3 && <4, directory + Extensions: BangPatterns, PatternGuards -Executable: afp-split-tcb -Main-is: afp-split-tcb.hs -Build-depends: OpenAFP, haskell98, base, filepath -Extensions: ImplicitParams +Executable afp-split + Main-is: afp-split.hs + Build-depends: OpenAFP >= 1.2, haskell98, base -Executable: afp-type -Main-is: afp-type.hs -Build-depends: OpenAFP, haskell98, base +Executable afp-split-scb + Main-is: afp-split-scb.hs + Build-depends: OpenAFP >= 1.2, haskell98, base -Executable: afp-udcfix -Main-is: afp-udcfix.hs -Build-depends: OpenAFP, haskell98, base, regex-base, regex-posix -Extensions: DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts +Executable afp-split-tcb + Main-is: afp-split-tcb.hs + Build-depends: OpenAFP >= 1.2, haskell98, base, filepath + Extensions: ImplicitParams -Executable: afp-validate -Main-is: afp-validate.hs -Build-depends: OpenAFP, haskell98, base +Executable afp-type + Main-is: afp-type.hs + Build-depends: OpenAFP >= 1.2, haskell98, base -Executable: afp2line -Main-is: afp2line.hs -Build-depends: OpenAFP, haskell98, base -Extensions: GeneralizedNewtypeDeriving +Executable afp-udcfix + Main-is: afp-udcfix.hs + Build-depends: OpenAFP >= 1.2, haskell98, base, regex-base, regex-posix + Extensions: DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, PatternGuards, RankNTypes -Executable: afp-olndump -Main-is: afp-olndump.hs -Build-depends: OpenAFP, haskell98, base, bytestring, containers, binary +Executable afp-validate + Main-is: afp-validate.hs + Build-depends: OpenAFP >= 1.2, haskell98, base>=3 && <4 +Executable afp2line + Main-is: afp2line.hs + Build-depends: OpenAFP >= 1.2, haskell98, base + Extensions: GeneralizedNewtypeDeriving diff --git a/afp-dump.hs b/afp-dump.hs --- a/afp-dump.hs +++ b/afp-dump.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -O -fglasgow-exts -funbox-strict-fields -fimplicit-params #-} - module Main where import Text.XHtml import Codec.Text.UConv diff --git a/afp-page.hs b/afp-page.hs --- a/afp-page.hs +++ b/afp-page.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -O -fglasgow-exts #-} - module Main where import OpenAFP import System.Exit diff --git a/afp-replace.hs b/afp-replace.hs --- a/afp-replace.hs +++ b/afp-replace.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, PatternGuards #-} module Main where import OpenAFP import qualified Data.ByteString.Lazy as L diff --git a/afp-scanudc.hs b/afp-scanudc.hs --- a/afp-scanudc.hs +++ b/afp-scanudc.hs @@ -1,11 +1,9 @@ -{-# OPTIONS -O -fglasgow-exts -funbox-strict-fields -fbang-patterns #-} - module Main where import OpenAFP import System.Mem import System.Directory import Control.Concurrent -import qualified Control.Exception as E (try, catch, throwIO) +import qualified Control.Exception as E (try, catch, throwIO, Exception(..)) import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B @@ -59,9 +57,9 @@ _ -> return False -- skip non-afp files where tryOpen = openBinaryFile file ReadMode `E.catch` tryErr - tryErr (IOException ioe) | isFullError ioe = threadDelay 200 >> tryOpen + tryErr (E.IOException ioe) | isFullError ioe = threadDelay 200 >> tryOpen tryErr e = E.throwIO e - hdl (IOException ioe) | Just e <- cast ioe, isUserError e = return True + hdl (E.IOException ioe) | Just e <- cast ioe, isUserError e = return True hdl _ = return False scanPTX :: PTX -> IO () diff --git a/afp-split-scb.hs b/afp-split-scb.hs --- a/afp-split-scb.hs +++ b/afp-split-scb.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -O -fglasgow-exts #-} - module Main where import OpenAFP import System.Exit diff --git a/afp-split-tcb.hs b/afp-split-tcb.hs --- a/afp-split-tcb.hs +++ b/afp-split-tcb.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -O -fglasgow-exts #-} - module Main where import OpenAFP import System.Exit diff --git a/afp-split.hs b/afp-split.hs --- a/afp-split.hs +++ b/afp-split.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -O -fglasgow-exts #-} - module Main where import OpenAFP import System.Exit diff --git a/afp-type.hs b/afp-type.hs --- a/afp-type.hs +++ b/afp-type.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -O -fglasgow-exts #-} - module Main where import OpenAFP diff --git a/afp-udcfix.hs b/afp-udcfix.hs --- a/afp-udcfix.hs +++ b/afp-udcfix.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -O -fglasgow-exts -funbox-strict-fields #-} - module Main where import OpenAFP import qualified Data.Map as Map diff --git a/afp-validate.hs b/afp-validate.hs --- a/afp-validate.hs +++ b/afp-validate.hs @@ -1,5 +1,3 @@ -{-# OPTIONS -O -fglasgow-exts #-} - module Main where import OpenAFP import System.Exit diff --git a/afp2line.hs b/afp2line.hs --- a/afp2line.hs +++ b/afp2line.hs @@ -1,25 +1,24 @@ -{-# OPTIONS_GHC -O2 -fglasgow-exts #-} - module Main where import OpenAFP import Data.Monoid -import System.Posix.Resource import qualified Data.IntMap as IM import qualified Data.ByteString as S import qualified Data.ByteString.Unsafe as S import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Char8 as C - -__1GB__ :: Integer -__1GB__ = 1024 * 1024 * 1024 - -mkLimit :: Integer -> ResourceLimits -mkLimit x = ResourceLimits (ResourceLimit x) (ResourceLimit x) - +-- +-- import System.Posix.Resource +-- +-- __1GB__ :: Integer +-- __1GB__ = 1024 * 1024 * 1024 +-- +-- mkLimit :: Integer -> ResourceLimits +-- mkLimit x = ResourceLimits (ResourceLimit x) (ResourceLimit x) +-- main :: IO () main = do - setResourceLimit ResourceTotalMemory (mkLimit __1GB__) - setResourceLimit ResourceCoreFileSize (mkLimit 0) + -- setResourceLimit ResourceTotalMemory (mkLimit __1GB__) + -- setResourceLimit ResourceCoreFileSize (mkLimit 0) hSetBinaryMode stdout True args <- getArgs @@ -155,22 +154,27 @@ ptxGroupDump :: [PTX_] -> IO () ptxGroupDump (scfl:cs) = do let scflId = ptx_scfl (decodeChunk scfl) + curEncoding <- lookupFontEncoding scflId cs ..> - [ _PTX_TRN ... \trn -> case curEncoding of - Just CP37 -> let bstr = packAStr' (ptx_trn trn) in do - insertText bstr - modifyIORef _CurrentColumn (+ S.length bstr) - Just CP835 -> pack835 (ptx_trn trn) >>= \bstr -> do - insertText bstr - modifyIORef _CurrentColumn (+ S.length bstr) - Just CP939 -> pack939 (ptx_trn trn) >>= \bstr -> do - insertText bstr - modifyIORef _CurrentColumn (+ S.length bstr) - Just CP950 -> let bstr = packBuf (ptx_trn trn) in do - insertText bstr - modifyIORef _CurrentColumn (+ S.length bstr) - _ -> fail "TRN without SCFL?" + [ _PTX_TRN ... \trn -> do + when (ptx_scfl (decodeChunk scfl) == 2) $ do + hPrint stderr (ptx_trn trn) + case curEncoding of + Just CP37 -> let bstr = packAStr' (ptx_trn trn) in do + insertText bstr + modifyIORef _CurrentColumn (+ S.length bstr) + Just CP835 -> pack835 (ptx_trn trn) >>= \bstr -> do + insertText bstr + modifyIORef _CurrentColumn (+ S.length bstr) + Just CP939 -> pack939 (ptx_trn trn) >>= \bstr -> do + C.hPut stderr bstr + insertText bstr + modifyIORef _CurrentColumn (+ S.length bstr) + Just CP950 -> let bstr = packBuf (ptx_trn trn) in do + insertText bstr + modifyIORef _CurrentColumn (+ S.length bstr) + _ -> fail "TRN without SCFL?" , _PTX_BLN ... \_ -> do writeIORef _CurrentColumn 0 modifyIORef _CurrentLine (+1) diff --git a/afp2line2pdf.hs b/afp2line2pdf.hs new file mode 100644 --- /dev/null +++ b/afp2line2pdf.hs @@ -0,0 +1,354 @@ +{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImplicitParams, ExistentialQuantification, PatternGuards #-} + +module Main where +import OpenAFP +import Control.Applicative +import System.Exit +import System.Environment +import Text.LineToPDF.Internals hiding (Encoding) +-- import System.Posix.Resource +import qualified Data.ByteString as S +import qualified Data.ByteString.Unsafe as S +import qualified Data.ByteString.Internal as S +import qualified Data.ByteString.Char8 as C +import qualified Text.LineToPDF.Internals as PDF + +deriving instance Eq Encoding +deriving instance Ord Encoding +deriving instance Ix Encoding +deriving instance Bounded Encoding + +__1GB__ :: Integer +__1GB__ = 1024 * 1024 * 1024 + +-- mkLimit :: Integer -> ResourceLimits +-- mkLimit x = ResourceLimits (ResourceLimit x) (ResourceLimit x) + +main :: IO () +main = do + -- setResourceLimit ResourceTotalMemory (mkLimit __1GB__) + -- setResourceLimit ResourceCoreFileSize (mkLimit 0) + + hSetBinaryMode stdout True + args <- getArgs + when (null args) $ do + putStrLn "Usage: afp2line2pdf input.afp > output.pdf" + forM_ args $ \f -> do + ft <- guessFileType f + processFile ft f + +data FileType = F_ASCII | F_EBCDIC | F_AFP | F_PDF | F_Unknown deriving Show + +-- | Read the first byte to determine its file type: +-- +-- * '1' indicates ASCII Plain Text line data +-- +-- * '\xF1' indicates EBCDIC line data +-- +-- * 'Z' indicates AFP file +-- +-- * '%' indicates PDF file +-- +guessFileType :: FilePath -> IO FileType +guessFileType fn = do + fh <- openBinaryFile fn ReadMode + bs <- S.hGet fh 1 + hClose fh + return $ if S.null bs then F_Unknown else case C.head bs of + 'Z' -> F_AFP + '%' -> F_PDF + '1' -> F_ASCII + '0' -> F_ASCII + ' ' -> F_ASCII + '\xF0' -> F_EBCDIC + '\xF1' -> F_EBCDIC + '@' -> F_EBCDIC + _ -> F_Unknown + +imageChunkTypes :: [ChunkType] +imageChunkTypes = + [ chunkTypeOf _BII + , chunkTypeOf _BIM + , chunkTypeOf _MIO + , chunkTypeOf _IRD + , chunkTypeOf _IPD + ] + +_blanks :: [C.ByteString] +_blanks = map C.pack + [ "BLANK" + , "BLN" + , "blank" + , "bln" + ] + +isBlank :: [AFP_] -> Bool +isBlank cs = case find (~~ _BR) cs of + Just c -> let str = S.drop 2 (packAStr $ br (decodeChunk c)) in + any (`S.isPrefixOf` str) _blanks + _ -> False + +processFile :: FileType -> FilePath -> IO () +processFile F_ASCII _ = do + -- ...Look at each line's first byte to determine what to output... + return () +processFile F_AFP f = do + cs <- readAFP f + + env <- getEnvironment + case lookup "AFP2PDF2LINE_SKIP_IMAGE" env of + Just "1" | not (isBlank cs), any ((`elem` imageChunkTypes) . chunkType) cs -> do + -- We can't process image data, sorry. + exitWith (ExitFailure 1) + _ -> return () + + hSetBinaryMode stdout True + pr$ "%PDF-1.2\n" ++ "%\xE2\xE3\xCF\xD3\n" + (info, root, tPages, resources) <- writeHeader [Latin, Big5, ShiftJIS] + + forM_ (filter (~~ _PGD) cs) $ \c -> do + let pgd = decodeChunk c + xSize = toPt $ pgd_XPageSize pgd + ySize = toPt $ pgd_YPageSize pgd + modifyIORef __MAX_WIDTH__ (max xSize) + modifyIORef __MAX_HEIGHT__ (max ySize) + + modifyIORef __MAX_WIDTH__ (+30) + modifyIORef __MAX_HEIGHT__ (+30) + + forM_ (tail $ splitRecords _BPG cs) $ \pageChunks -> do + -- Start page + 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" + + streamStart <- currentLocation + pr$ "BT\n"; + + pageChunks ..> + [ _PTX ... ptxDump + , _MCF ... mcfHandler + , _MCF1 ... mcf1Handler + ] + + -- End Page + 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" + + pageObjs <-reverse <$> readRef __PAGE__ + markLocation root + writeObj root $ do + pr$ "/Type/Catalog" ++ "/Pages " + pr$ show tPages ++ " 0 R" + + maxPageWidth <- readIORef __MAX_WIDTH__ + maxPageHeight <- readIORef __MAX_HEIGHT__ + + markLocation tPages + writeObj tPages $ do + pr$ "/Type/Pages" ++ "/Count " + pr$ show (length pageObjs) + ++ "/MediaBox[0 0 " + ++ show maxPageWidth ++ " " ++ show maxPageHeight + 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" + +processFile t f = warn $ "Unknown file type: " ++ show t ++ " (" ++ f ++ ")" + +{-# NOINLINE __MAX_WIDTH__ #-} +__MAX_WIDTH__ :: IORef Float +__MAX_WIDTH__ = unsafePerformIO $ newIORef 0 + +{-# NOINLINE __MAX_HEIGHT__ #-} +__MAX_HEIGHT__ :: IORef Float +__MAX_HEIGHT__ = unsafePerformIO $ newIORef 0 + +{-# NOINLINE _CurrentLine #-} +_CurrentLine :: IORef Float +_CurrentLine = unsafePerformIO $ newIORef 0 + +{-# NOINLINE _CurrentColumn #-} +_CurrentColumn :: IORef Float +_CurrentColumn = unsafePerformIO $ newIORef 0 + +{-# NOINLINE _MaxColumn #-} +_MaxColumn :: IORef Int +_MaxColumn = unsafePerformIO $ newIORef 0 + +{-# NOINLINE _MaxLine #-} +_MaxLine :: IORef Int +_MaxLine = unsafePerformIO $ newIORef 0 + +{-# NOINLINE _MaxEncoding #-} +_MaxEncoding :: IORef Encoding +_MaxEncoding = unsafePerformIO $ newIORef CP37 + +{-# NOINLINE _MinFontSize #-} +_MinFontSize :: IORef Size +_MinFontSize = unsafePerformIO $ newIORef 12 + +lookupFontEncoding :: N1 -> IO (Maybe Encoding) +lookupFontEncoding = hashLookup _FontToEncoding + +insertFonts :: [(N1, ByteString)] -> IO () +insertFonts = mapM_ $ \(i, f) -> do + let (enc, sz) = fontInfoOf f + modifyIORef _MinFontSize $ \szMin -> case szMin of + 0 -> sz + _ -> min szMin sz + modifyIORef _MaxEncoding (max enc) + hashInsert _FontToEncoding i enc + +{-# NOINLINE _FontToEncoding #-} +_FontToEncoding :: HashTable N1 Encoding +_FontToEncoding = unsafePerformIO $ hashNew (==) fromIntegral + +-- | Record font Id to Name mappings in MCF's RLI and FQN chunks. +mcfHandler :: MCF -> IO () +mcfHandler r = do + readChunks r ..> + [ _MCF_T ... \mcf -> do + let cs = readChunks mcf + ids = [ t_rli (decodeChunk c) | c <- cs, c ~~ _T_RLI ] + fonts = [ t_fqn (decodeChunk c) | c <- cs, c ~~ _T_FQN ] + insertFonts (ids `zip` map packAStr fonts) + ] + +-- | Record font Id to Name mappings in MCF1's Data chunks. +mcf1Handler :: MCF1 -> IO () +mcf1Handler r = do + insertFonts + [ (mcf1_CodedFontLocalId mcf1, packA8 $ mcf1_CodedFontName mcf1) + | Record mcf1 <- readData r + ] + +ptxDump :: PTX -> IO () +ptxDump ptx = mapM_ ptxGroupDump . splitRecords _PTX_SCFL $ readChunks ptx + +convertEncoding :: Encoding -> PDF.Encoding +convertEncoding CP37 = Latin +convertEncoding CP835 = Big5 +convertEncoding CP939 = ShiftJIS +convertEncoding CP950 = Big5 + +ptxGroupDump :: [PTX_] -> IO () +ptxGroupDump (scfl:cs) | scfl ~~ _PTX_SCFL = do + let scflId = ptx_scfl (decodeChunk scfl) + + rv <- lookupFontEncoding scflId + case rv of + Nothing -> return () + Just curEncoding -> do + height <- readIORef __MAX_HEIGHT__ + curSize <- readIORef _MinFontSize + let display (enc, getBStr) = do + font <- case enc of + Latin -> do + (fontOf . convertEncoding) <$> readIORef _MaxEncoding + _ -> return (fontOf enc) + pr$ "/F" ++ font ++ " " ++ show curSize ++ " Tf\n" + pr$ show curSize ++ " TL\n" + col <- readIORef _CurrentColumn + ln <- readIORef _CurrentLine + pr$ "1 0 0 1 " ++ show (col + 25) ++ " " ++ show (height - ln - 25) ++ " Tm(" + let escape ch = C.intercalate (C.pack ['\\', ch]) . C.split ch + escapeTxt = escape '(' . escape ')' . escape '\\' + origBStr <- getBStr + let origLen = S.length origBStr + escapedLen = S.length escapedBStr + escapedBStr = escapeTxt origBStr + C.putStr escapedBStr + modifyRef __POS__ (+ escapedLen) + pr$ ")Tj\n" + modifyIORef _CurrentColumn (+ (realToFrac (origLen * curSize) * 0.5)) + cs ..> + [ _PTX_TRN ... \trn -> display $ case curEncoding of + CP37 -> (Latin, return $ packAStr' (ptx_trn trn)) + CP835 -> (Big5, pack835 (ptx_trn trn)) + CP939 -> (ShiftJIS, pack939 (ptx_trn trn)) + CP950 -> (Big5, return $ packBuf (ptx_trn trn)) + , _PTX_BLN ... \_ -> do + writeIORef _CurrentColumn 0 -- XXX + modifyIORef _CurrentLine (+ realToFrac curSize) + , _PTX_AMB ... \x -> do + -- hPrint stderr ("AMB", fromEnum $ ptx_amb x) + movePosition Absolute _CurrentLine . ptx_amb $ x + , _PTX_RMB ... \x -> do + -- hPrint stderr ("RMB", fromEnum $ ptx_rmb x) + movePosition Relative _CurrentLine . ptx_rmb $ x + , _PTX_AMI ... movePosition Absolute _CurrentColumn . ptx_ami + , _PTX_RMI ... movePosition Relative _CurrentColumn . ptx_rmi + ] +ptxGroupDump _ = return () + +data Position = Absolute | Relative + +movePosition :: Position -> IORef Float -> N2 -> IO () +movePosition p ref n = do + case p of + Absolute -> writeIORef ref (toPt n) + Relative -> modifyIORef ref (+ (toPt n)) + + +toPt :: Enum a => a -> Float +toPt x = realToFrac (fromEnum x) * 0.3 + +packAStr' :: AStr -> S.ByteString +packAStr' astr = S.map (ebc2ascIsPrintW8 !) (packBuf astr) + +{-# INLINE pack835 #-} +{-# INLINE pack939 #-} +pack835, pack939 :: NStr -> IO S.ByteString +pack835 = packWith convert835to950 +pack939 = packWith convert939to932 + +{-# INLINE packWith #-} +packWith :: (Int -> Int) -> NStr -> IO S.ByteString +packWith f nstr = S.unsafeUseAsCStringLen (packBuf nstr) $ \(src, len) -> S.create len $ \target -> do + let s = castPtr src + let t = castPtr target + forM_ [0..(len `div` 2)-1] $ \i -> do + hi <- peekByteOff s (i*2) :: IO Word8 + lo <- peekByteOff s (i*2+1) :: IO Word8 + let ch = f (fromEnum hi * 256 + fromEnum lo) + (hi', lo') = ch `divMod` 256 + pokeByteOff t (i*2) (toEnum hi' :: Word8) + pokeByteOff t (i*2+1) (toEnum lo' :: Word8) + +-- Target size = AFP size / 3