Create pdf from jbig2 files

mkpdf.icl

// clm -IL Platform -IL ArgEnv -IL Directory -IL StdLib -b -nr -nt mkpdf -o pdf
// rewrite of https://github.com/agl/jbig2enc/blob/master/pdf.py
module mkpdf

import StdEnv, ArgEnv, StdMaybe, StdArrayExtensions, Directory, Data.Func

Start w
  | argc == 1
  # (p, w) = getCurrentDirectory w
    ((ec, files), w) = getDirectoryContents p w
    names = map (\x -> x.fileName) files
  = case (ec, matchFile argv.[1] names) of
     (NoDirError, xs=:[_:_]) -> main w (argv.[1] +++ ".pdf") (argv.[1] +++ ".sym") xs
     _ -> fclose (stderr <<< "no file found\n") w
  | otherwise
  = fclose (stderr <<< "Usage: "
     <<< argv.[0] <<< " [file_basename]\n") w
   where
     argc = size argv - 1
     argv = getCommandLine

isPrefix pref s =
    size pref < size s - 1 &&
    pref%(0, size pref - 1) == s%(0, size pref - 1) &&
    all isDigit [c \\ c <-: s%(size pref + 1, size s - 1)]

matchFile pref names = filter (isPrefix pref) (sortBy (<) names)

main w o x xs
  # (ok, c, w) = fopen o FWriteText w
    (ss, w) = mapSt readAll xs w
    (sym, w) = readAll x w
    c = case sym of
          Just s -> putDoc (mkDoc s (catMaybes ss)) c
          Nothing -> c
  = fclose c w

BUF_SIZE :== 1000

readAll :: String *World -> (Maybe String, *World)
readAll n w
   # (ok,f,w) = fopen n FReadData w
   | not ok = (Nothing, w)
   # (s, f) = aux f
     (_, w) = fclose f w
   = (Just s, w)
  where
    aux f
      # (s, f) = freads f BUF_SIZE
        next = aux f
      | size s < BUF_SIZE = (s, f)
      | otherwise = (s +++ fst next, snd next)

DPI :== 72

getSize :: String -> (Int, Int, Int, Int)
getSize s =
  (decode bw, decode bh, if (xres == 0) DPI xres, if (yres == 0) DPI yres)
   where p = s%(11,26)
         bw = p%(0,3)
         bh = p%(4,7)
         bx = p%(8,11)
         xres = decode bx
         by = p%(12,15)
         yres = decode by
         decode s = (((((toInt s.[0] << 8) + toInt s.[1] ) << 8) + toInt s.[2]) << 8) + toInt s.[3]


put x = \c -> c <<< x
:: Obj = { id :: Int, d :: [(String, *File -> *File)], stream :: Maybe String }

mkObj d Nothing i = ({ id = i, d = d, stream = Nothing }, i+1)
mkObj d st=:(Just s) i =
  ({ id = i, d = d ++ [("Length", put (size s))], stream = st }, i+1)

mkRef :: Int -> (*File -> *File)
mkRef x = \c -> c <<< x <<< " 0 R"

join :: [*File -> *File] -> (*File -> *File)
join xs = \c -> (aux xs (c <<< "[")) <<< "]"
  where
   aux [] c = c
   aux [x] c = x c
   aux [x:xs] c = aux xs (x c <<< " ")

mkDoc :: String [String] -> [Obj]
mkDoc sym pages = [cat, ol, pg, sd] ++ flatten objs
  where
    (cat, g1) = mkObj [("Type", put "/Catalog"), ("Outlines", mkRef 2),
                      ("Pages", mkRef 3)] Nothing 1
    (ol, g2) = mkObj [("Type", put "/Outlines"), ("Count", put 0)]
                      Nothing g1
    (pg, g3) = mkObj [("Type", put "/Pages"),
                      ("Count", put (length pageOs)),
                      ("Kids", join (map (\x -> mkRef x.id) pageOs))]
                      Nothing g2
    (sd, g4) = mkObj [] (Just sym) g3
    (objs, (pageOs, _)) = mapSt mkPg pages ([], g4)
    mkPg s (p, i)
      # (width, height, xres, yres) = getSize s
        (xobj, i) = mkObj [("Type", put "/XObject"),
                           ("Subtype", put "/Image"),
                           ("Width", put width),
                           ("Height", put height),
                           ("ColorSpace", put "/DeviceGray"),
                           ("BitsPerComponent", put 1),
                           ("Filter", put "/JBIG2Decode"),
                           ("DecodeParms", \e -> e <<< " << /JBIG2Globals "
                                                   <<< sd.id <<< " 0 R >>")]
                           (Just s) i
        x = toString (toReal (width * 72) / toReal xres) +++ ".000000"
        y = toString (toReal (height * 72) / toReal yres) +++ ".000000"
        (cont, i) = mkObj [] (Just ("q " +++ x +++ " 0 0 " +++ y
                              +++ " 0 0 cm /Im1 Do Q")) i
        (res, i) = mkObj [("ProcSet", put "[/PDF /ImageB]"),
                          ("XObject", \e -> e <<< "<< /Im1 " <<< xobj.id <<< " 0 R >>")]
                         Nothing i
        (pg, i) = mkObj [("Type", put "/Page"), ("Parent", put "3 0 R"),
                         ("MediaBox", \e -> e <<< "[ 0 0 " <<< x <<< " " <<< y <<< " ]"),
                         ("Contents", mkRef cont.id),
                         ("Resources", mkRef res.id)]
                         Nothing i
       = ([xobj,cont,res,pg], (p ++ [pg], i))


instance <<< Obj where
 (<<<) :: !*File !Obj -> *File
 (<<<) c o
   # c = c <<< o.id <<< " 0 obj\n"
     c = putD o.d c
     c = case o.stream of
           Just s -> c <<< "stream\n" <<< s <<< "\nendstream\n"
           Nothing -> c
   = c <<< "endobj\n\n"
    where putD xs c
           # c = c <<< "<< "
             c = seqSt (\ (k, v) c -> (v (c <<< "/" <<< k <<< " ")) <<< "\n") xs c
           = c <<< ">>\n"


putDoc xs c
  # c = c <<< "%PDF-1.4\n"
    (offs, c) = mapSt putObj xs c
    (xrefstart, c) = fposition c 
    c = c <<< "xref\n0 " <<< len <<< "\n0000000000 65535 f \n"
    c = seqSt pad offs c
    c = c <<< "\ntrailer\n<< /Size " <<< len <<< "\n/Root 1 0 R >>\n"
  = c <<< "startxref\n" <<< xrefstart <<< "\n%%EOF\n"
  where len = length xs + 1
        putObj x c = (mk, nc <<< x)
          where (mk, nc) = fposition c
        pad x c = c <<< (createString (10 - size s) '0') <<< s <<< " 00000 n \n"
          where s = toString x