Permalink
Browse files

* OpenAFP modernization

  • Loading branch information...
1 parent bd532df commit 74d7dd4b4e7b794f29537229b0d232f303a954a4 @audreyt committed May 3, 2006
Showing with 130 additions and 30 deletions.
  1. +1 −1 Makefile
  2. +88 −0 OpenAFP.cabal
  3. +10 −0 Setup.lhs
  4. +19 −24 bin/afp-udcfix.hs
  5. +12 −5 src/OpenAFP/Prelude/Exts.hs
View
@@ -52,7 +52,7 @@ docs ::
rm -rf docs
mkdir docs
cp -Rf src/OpenAFP docs/OpenAFP
- cp Main.hs docs/Main.hs
+ cp -Rf src/OpenAFP.hs docs/OpenAFP.hs
perl -pi -e 's/IArray UArray/UArray/g' docs/OpenAFP/Internals/Binary.hs
chdir docs && find . -name '*.*hs' | \
xargs haddock \
View
@@ -0,0 +1,88 @@
+name: OpenAFP
+version: 1.0
+license: BSD3
+License-file: LICENSE
+author: Audrey Tang
+maintainer: audreyt@audreyt.org
+exposed-modules: OpenAFP.Internals.UConv OpenAFP.Internals.Binary OpenAFP.Internals.Ebc2Asc
+ OpenAFP.Prelude.Utils OpenAFP.Prelude.Instances OpenAFP.Prelude.InstanceT
+ OpenAFP.Prelude.Lookups
+ OpenAFP.Prelude.InstanceAFP OpenAFP.Prelude.InstancePTX OpenAFP.Prelude.Exts
+ OpenAFP.Records.T.LDOPM OpenAFP.Records.T.OSFO OpenAFP.Records.T.FRMT
+ OpenAFP.Records.T.OCH OpenAFP.Records.T.MO OpenAFP.Records.T.T2FRMT
+ OpenAFP.Records.T.FDS OpenAFP.Records.T.OCL OpenAFP.Records.T.OO
+ OpenAFP.Records.T.CGCSGI OpenAFP.Records.T.PSRM OpenAFP.Records.T.TO
+ OpenAFP.Records.T.AD OpenAFP.Records.T.RLI OpenAFP.Records.T.TS
+ OpenAFP.Records.T.RUA OpenAFP.Records.T.CF OpenAFP.Records.T.PPI
+ OpenAFP.Records.T.ROI OpenAFP.Records.T.EF OpenAFP.Records.T.ERLI
+ OpenAFP.Records.T.FF OpenAFP.Records.T.MOR OpenAFP.Records.T.FCGCSGI
+ OpenAFP.Records.T.POCP OpenAFP.Records.T.MF OpenAFP.Records.T.DP
+ OpenAFP.Records.T.MEC OpenAFP.Records.T.CR OpenAFP.Records.T.OBE
+ OpenAFP.Records.T.T1CRMT OpenAFP.Records.T.LDTS OpenAFP.Records.T.AV
+ OpenAFP.Records.T.MMPN OpenAFP.Records.T.OFSS OpenAFP.Records.T.OBO
+ OpenAFP.Records.T.UDTS OpenAFP.Records.T.ESI OpenAFP.Records.T.OCO
+ OpenAFP.Records.T.PSMR OpenAFP.Records.T.OAS OpenAFP.Records.T.C
+ OpenAFP.Records.T.FQN OpenAFP.Records.T.PV OpenAFP.Records.T.FHSF
+ OpenAFP.Records.T.OOI OpenAFP.Records.T.MIS OpenAFP.Records.T.OSFE
+ OpenAFP.Records.T.MA OpenAFP.Records.T.OAMU OpenAFP.Records.T.II
+ OpenAFP.Records.T.AQ OpenAFP.Records.T.PC OpenAFP.Records.T.RSN
+ OpenAFP.Records.T.FO OpenAFP.Records.T.ROT OpenAFP.Records.T.CS
+ OpenAFP.Records.MCF.T OpenAFP.Records.AFP.ECP OpenAFP.Records.AFP.BIM
+ OpenAFP.Records.AFP.PFC OpenAFP.Records.AFP.PTD1 OpenAFP.Records.AFP.IEL
+ OpenAFP.Records.AFP.BMM OpenAFP.Records.AFP.ICP OpenAFP.Records.AFP.PTX
+ OpenAFP.Records.AFP.EDT OpenAFP.Records.AFP.FNI OpenAFP.Records.AFP.IPD
+ OpenAFP.Records.AFP.LNC OpenAFP.Records.AFP.BPM OpenAFP.Records.AFP.IRD
+ OpenAFP.Records.AFP.PMC OpenAFP.Records.AFP.EDX OpenAFP.Records.AFP.FNM
+ OpenAFP.Records.AFP.MCF1 OpenAFP.Records.AFP.EPT OpenAFP.Records.AFP.EBC
+ OpenAFP.Records.AFP.BDD OpenAFP.Records.AFP.EAG OpenAFP.Records.AFP.MMT
+ OpenAFP.Records.AFP.EDG OpenAFP.Records.AFP.FGD OpenAFP.Records.AFP.EFG
+ OpenAFP.Records.AFP.CFI OpenAFP.Records.AFP.MBC OpenAFP.Records.AFP.MCC
+ OpenAFP.Records.AFP.BCP OpenAFP.Records.AFP.MFC OpenAFP.Records.AFP.EOC
+ OpenAFP.Records.AFP.FND OpenAFP.Records.AFP.ENG OpenAFP.Records.AFP.BDT
+ OpenAFP.Records.AFP.EOG OpenAFP.Records.AFP.IOC OpenAFP.Records.AFP.EPG
+ OpenAFP.Records.AFP.CPI OpenAFP.Records.AFP.MMC OpenAFP.Records.AFP.BDX
+ OpenAFP.Records.AFP.ERG OpenAFP.Records.AFP.ESG OpenAFP.Records.AFP.IPG
+ OpenAFP.Records.AFP.EMO OpenAFP.Records.AFP.MGO OpenAFP.Records.AFP.FNP
+ OpenAFP.Records.AFP.MPG OpenAFP.Records.AFP.MIO OpenAFP.Records.AFP.BPT
+ OpenAFP.Records.AFP.BBC OpenAFP.Records.AFP.EPS OpenAFP.Records.AFP.IPO
+ OpenAFP.Records.AFP.MMO OpenAFP.Records.AFP.BAG OpenAFP.Records.AFP.CDD
+ OpenAFP.Records.AFP.GAD OpenAFP.Records.AFP.IPS OpenAFP.Records.AFP.MPO
+ OpenAFP.Records.AFP.BDG OpenAFP.Records.AFP.NOP OpenAFP.Records.AFP.ECF
+ OpenAFP.Records.AFP.BFG OpenAFP.Records.AFP.GDD OpenAFP.Records.AFP.MPS
+ OpenAFP.Records.AFP.BOC OpenAFP.Records.AFP.OBD OpenAFP.Records.AFP.MCF
+ OpenAFP.Records.AFP.OCD OpenAFP.Records.AFP.CPD OpenAFP.Records.AFP.BNG
+ OpenAFP.Records.AFP.FNC OpenAFP.Records.AFP.BOG OpenAFP.Records.AFP.CAT
+ OpenAFP.Records.AFP.EFN OpenAFP.Records.AFP.BPG OpenAFP.Records.AFP.IOB
+ OpenAFP.Records.AFP.BRG OpenAFP.Records.AFP.FNG OpenAFP.Records.AFP.BSG
+ OpenAFP.Records.AFP.LLE OpenAFP.Records.AFP.EGR OpenAFP.Records.AFP.BMO
+ OpenAFP.Records.AFP.OBP OpenAFP.Records.AFP.FNO OpenAFP.Records.AFP.MDR
+ OpenAFP.Records.AFP.BPS OpenAFP.Records.AFP.TLE OpenAFP.Records.AFP.ECA
+ OpenAFP.Records.AFP.BCF OpenAFP.Records.AFP.CFC OpenAFP.Records.AFP.MCA
+ OpenAFP.Records.AFP.EDI OpenAFP.Records.AFP.BR OpenAFP.Records.AFP.EDM
+ OpenAFP.Records.AFP.CPC OpenAFP.Records.AFP.BFN OpenAFP.Records.AFP.EII
+ OpenAFP.Records.AFP.ER OpenAFP.Records.AFP.EFM OpenAFP.Records.AFP.PGP1
+ OpenAFP.Records.AFP.CTC OpenAFP.Records.AFP.EIM OpenAFP.Records.AFP.BGR
+ OpenAFP.Records.AFP.PGD OpenAFP.Records.AFP.LND OpenAFP.Records.AFP.EMM
+ OpenAFP.Records.AFP.DXD OpenAFP.Records.AFP.EPM OpenAFP.Records.AFP.FNN
+ OpenAFP.Records.AFP.IMM OpenAFP.Records.AFP.BCA OpenAFP.Records.AFP.BDA
+ OpenAFP.Records.AFP.PGP OpenAFP.Records.AFP.PTD OpenAFP.Records.AFP.BDI
+ OpenAFP.Records.AFP.IDD OpenAFP.Records.AFP.BDM OpenAFP.Records.AFP.BII
+ OpenAFP.Records.AFP.MCD OpenAFP.Records.AFP.BFM OpenAFP.Records.AFP.MDD
+ OpenAFP.Records.AFP.MSU OpenAFP.Records.AFP.IID OpenAFP.Records.PTX.AMI
+ OpenAFP.Records.PTX.DBR OpenAFP.Records.PTX.BLN OpenAFP.Records.PTX.SIA
+ OpenAFP.Records.PTX.SBI OpenAFP.Records.PTX.DIR OpenAFP.Records.PTX.RMB
+ OpenAFP.Records.PTX.SCFL OpenAFP.Records.PTX.RMI OpenAFP.Records.PTX.SIM
+ OpenAFP.Records.PTX.STC OpenAFP.Records.PTX.BSU OpenAFP.Records.PTX.NOP
+ OpenAFP.Records.PTX.ESU OpenAFP.Records.PTX.AMB OpenAFP.Records.PTX.SVI
+ OpenAFP.Records.PTX.TRN OpenAFP.Records.PTX.RPS OpenAFP.Records.PTX.STO
+ OpenAFP.Records.AFP OpenAFP.Records.PTX OpenAFP.Records.T OpenAFP.Records.MCF
+ OpenAFP.Types.Chunk OpenAFP.Types.Buffer OpenAFP.Types.View
+ OpenAFP.Types.Record OpenAFP.Internals OpenAFP.Records OpenAFP.Types OpenAFP
+includes: unicode/ucnv.h
+extensions: CPP, ForeignFunctionInterface
+build-depends: base, mtl, haskell98
+include-dirs: /usr/local/include
+extra-lib-dirs: /usr/local/lib
+ld-options: -licuuc
+ghc-options: -O -fglasgow-exts -funbox-strict-fields -fno-warn-missing-signatures
+hs-source-dirs: src
View
@@ -0,0 +1,10 @@
+#!/usr/bin/env runghc
+\begin{code}
+
+module Main where
+import Distribution.Simple
+
+main :: IO ()
+main = defaultMain
+
+\end{code}
View
@@ -26,8 +26,8 @@ stateMain = do
chunks <- liftOpt readInputAFP
fh <- liftOpt openOutputAFP
bh <- liftIO $ openBinIO_ fh
- mapM_ ((liftIO . put bh =<<) . pageHandler)
- $ splitRecords _PGD chunks
+ forM_ (splitRecords _PGD chunks)
+ ((liftIO . put bh =<<) . pageHandler)
liftIO $ hClose fh
-- | Check a page's PTX records for UDC characters. If none is seen,
@@ -66,33 +66,31 @@ mcf1Handler r = do
-- | Split PTX into "groups", each one begins with a SCFL chunk.
ptxCheckUDC :: PTX -> VarsIO ()
-ptxCheckUDC r = mapM_ ptxGroupCheckUDC groups
+ptxCheckUDC r = forM_ groups ptxGroupCheckUDC
where
groups = splitRecords _PTX_SCFL chunks
- chunks = [ c | c <- readChunks r, want c ]
+ chunks = filter want (readChunks r)
want c = (c ~~ _PTX_SCFL) || (c ~~ _PTX_TRN)
-- | Check a PTX to see if the leading SCFL indicates a DBCS font;
-- if yes, pass remaining TRN chunks to trnCheckUDC.
ptxGroupCheckUDC :: [PTX_] -> VarsIO ()
ptxGroupCheckUDC (scfl:trnList) = do
- font <- readArray _IdToFont
- =<< ptx_scfl `applyToChunk` scfl
+ font <- readArray _IdToFont =<< ptx_scfl `applyToChunk` scfl
isDBCS <- fontIsDBCS &: font
when (isDBCS) $ liftIO $ do
- mapM_ (>>= trnCheckUDC)
- $ [ ptx_trn `applyToChunk` c | c <- trnList ]
+ forM_ (map (ptx_trn `applyToChunk`) trnList)
+ (>>= trnCheckUDC)
-- | Look inside TRN buffers for UDC characters. If we find one,
-- raise an IO exception so the page handler can switch to UDC mode.
trnCheckUDC :: NStr -> IO ()
trnCheckUDC nstr = do
- withForeignPtr (castForeignPtr pstr) $ \cstr ->
- mapM_ (\off -> do
- hi <- peekByteOff cstr off
- when (isUDC hi) $
- throwError $ strMsg "Found UDC")
- $ offsets
+ withForeignPtr (castForeignPtr pstr) $ \cstr -> do
+ forM_ offsets $ \off -> do
+ hi <- peekByteOff cstr off
+ when (isUDC hi) $ do
+ throwError (strMsg "Found UDC")
where
(pstr, len) = bufToPStrLen nstr
offsets = [0, 2..len-1]
@@ -145,7 +143,8 @@ trnHandler r = do
False -> do
-- If font is single byte, simply add each byte's increments.
-- without parsing UDC.
- incrs <- mapM (\r -> incrementOf font (0x00, r)) trn
+ incrs <- forM trn $ \r -> do
+ incrementOf font (0x00, r)
(_X += sum) incrs
push r
@@ -187,8 +186,7 @@ endPageHandler r = do
, ioc_YMap = 0x03E8
, ioc_YOrientation = yo
}
- mapM_ (udcCharHandler xp yo)
- $ reverse udcList
+ forM_ (reverse udcList) (udcCharHandler xp yo)
push _EII
push r
@@ -405,8 +403,7 @@ getOpts = do
paths <- filterM checkPath $ fontlibPaths opts
when (null paths) $ do
die $ "cannot find a valid font library path"
- seq (fontIsDBCS opts) $
- mapM_ warn errs
+ fontIsDBCS opts `seq` forM_ errs warn
return opts { readFontlibAFP = reader paths (fontlibSuffix opts) }
where
checkPath path = do
@@ -451,11 +448,9 @@ defaultOpts = Opts
isUDC :: N1 -> Bool
isUDC hi = hi >= 0x92 && hi <= 0xFE
-- isDBCS hi = hi >= 0x40 && hi <= 0x91
- checkUDC (cstr, len) = do
- mapM_ (\off -> do
- hi <- peekByteOff cstr off
- when (isUDC hi) $ fail "UDC")
- $ [0, 2..len-1]
+ checkUDC (cstr, len) = forM_ [0, 2..len-1] $ \off -> do
+ hi <- peekByteOff cstr off
+ when (isUDC hi) $ fail "UDC"
segment :: FontField -> [N1] -> VarsIO [N1]
segment = dbcsHandler
{-
@@ -33,11 +33,6 @@ type RE = String
(=~) :: String -> String -> Bool
s =~ p = isJust $ matchRegex (mkRegexWithOpts p False True) s
-#if __GLASGOW_HASKELL__ <= 602
-splitRegex :: RE -> String -> [String]
-splitRegex regexpr src = fst $ splitRegexWithMatches regexpr src
-#endif
-
splitRegexWithMatches :: RE -> String -> ([String], [String])
splitRegexWithMatches regexpr src = splitRegex' src
where
@@ -106,3 +101,15 @@ breakOnGlue glue rest@(x:xs)
split_first_word :: String -> (String, String)
split_first_word xs = (w, dropWhile isSpace xs')
where (w, xs') = break isSpace xs
+
+forM :: (Monad m)
+ => [a] -- ^ List of values to loop over
+ -> (a -> m b) -- ^ The \'body\' of the for loop
+ -> m [b] -- ^ Monad containing a list of the results
+forM = flip mapM
+
+forM_ :: (Monad m)
+ => [a] -- ^ List of values to loop over
+ -> (a -> m b) -- ^ The \'body\' of the for loop
+ -> m ()
+forM_ = flip mapM_

0 comments on commit 74d7dd4

Please sign in to comment.