Hi all,
I have attached a prototype pdf generator pdf.l. It can be used to
generate pdf files directly without going through @lib/ps.l. It is
still experimental version. It can be used as follows:
(afmDir "fonts") # load & parse font metric files
(pdf "/tmp/A.pdf" # generate sample pdf file
(pdfWr (pdfO 1 0 (pdfM '/Type '/Page
'/Parent '(5 0 R)
'/Resources '(3 0 R)
'/Contents '(2 0 R) ) ) )
(pdfWr (pdfO 2 0 (pdfS NIL "BT
/F1 24 Tf
1 0 0 1 260 254 Tm
(Hello World)Tj
ET
0 0 1 rg
4 0 0 4 315 204 cm
0 5.5 m
-4 -5.5 l
6 1 l
-6 1 l
4 -5.5 l
f" ) ) )
(pdfWr (pdfO 3 0 (pdfM '/ProcSet (pdfV '/PDF '/Text)
'/Font (pdfM '/F1 '(4 0 R)) ) ) )
(pdfWr (pdfO 4 0 (pdfM '/Type '/Font
'/Subtype '/Type1
'/Name '/F1
'/BaseFont '/Helvetica ) ) )
(pdfWr (pdfO 5 0 (pdfM '/Type '/Pages
'/Kids (pdfV '(1 0 R))
'/Count 1
'/MediaBox (pdfV 0 0 612 446) ) ) )
(pdfWr (pdfO 6 0 (pdfM '/Type '/Catalog
'/Pages '(5 0 R) ) ) )
(setq *PdfX (pdfM '/Root '(6 0 R) '/Size 6)) )
(pdfUpdate "/tmp/A.pdf" "/tmp/A3.pdf" # incremental update
(pdfWr (pdfO 7 0 (pdfS NIL
(pdfDraw
(q (BT (Tf "/F1" 24)
(Tm 1 0 0 1 160 154)
(Tj "H£ll0 W€rld Ťitěrňoučká řeřiščička")
(let S "hello Minime"
(pdfDraw
(Tm 1 0 0 1 160 174)
(Tj S 'left)
(Tm 1 0 0 1 160 194)
(Tj S 'center)
(Tm 1 0 0 1 160 214)
(Tj S 'right) ) ) ) ) ) )))
(pdfWr (pdfO 1 0 (pdfM '/Type '/Page
'/Parent '(5 0 R)
'/Resources '(3 0 R)
'/Contents (pdfV '(7 0 R 2 0 R)) ) ) )
(setq *PdfX (pdfM '/Prev *Fpos)) ) #'/Root '(6 0 R)
Unicode does not work and incremental updates do not generate correct
updated xref section. Also, it expects a "fonts/" directory with afm
files and glyphs:
Courier.afm
Courier-Bold.afm
Courier-BoldOblique.afm
Courier-Oblique.afm
Helvetica.afm
Helvetica-Bold.afm
Helvetica-BoldOblique.afm
Helvetica-Oblique.afm
Symbol.afm
Times-Bold.afm
Times-BoldItalic.afm
Times-Italic.afm
Times-Roman.afm
ZapfDingbats.afm
glyphlist.txt
Alex, I need to call 'lseek' function. How could I get hold of the
current input and output file descriptors? I want to feed it to the
following function 'fpos':
(gcc "pdf" NIL 'fpos)
#include <sys/types.h>
#include <unistd.h>
any fpos(any ex) {
int fd = evCnt(ex, cdr(ex));
off_t offset = evCnt(ex, cddr(ex));
int whence = evCnt(ex, cdddr(ex));
whence = whence == 1 ? SEEK_CUR : (whence == 2 ? SEEK_END : SEEK_SET);
off_t z = lseek(fd, offset, whence);
return boxCnt(z);
}
/**/
and use it something like:
(in "/tmp/file"
(fpos (ifd) 123) # set current position to 123rd byte from start of the file
(fpos (ifd) 0 1) # get current position
..
and similar for 'out'.
Thank you,
Tomas
# requires iconv for utf-16be conversion
# *Glyph *Codepoint
# *Afm
# *Fpos *PdfO *PdfOa *PdfOut *PdfX *PdfDraw *Fnm *Fsz
### glyphs
(in "fonts/glyphlist.txt" #(appDir "fonts/glyphlist.txt")
(use (L N)
(while (setq L (line))
(unless (= '"#" (car L))
(setq L (split L '";") N (pack (car L)))
(for C (mapcar '((X) (char (hex (pack X)))) (split (cadr L) " "))
(if (idx '*Glyph C)
(push (car @) N)
(set C (list N))
(idx '*Glyph C T) )
(if (idx '*Codepoint N)
(push (car @) C)
(set N (list C))
(idx '*Codepoint N T) ) ) ) ) ) )
(de glyph (C)
(val (car (idx '*Glyph C))) )
(de codepoint (C)
(val (car (idx '*Codepoint C))) )
(====)
### afm
(class +Afm)
# nm c kpx
(dm charWidth> (C)
(setq C (pack (if (num? C) C (char C))))
(format (cadr (assoc "WX" (find '((X) (= C (cadr (assoc "C" X)))) (: c))))) )
(dm charGlyph> (C)
(setq C (pack (if (num? C) C (char C))))
(cadr (assoc "N" (find '((X) (= C (cadr (assoc "C" X)))) (: c)))) )
(dm glyphChar> (G)
(format (cadr (assoc "C" (find '((X) (= G (cadr (assoc "N" X)))) (: c))))) )
(dm strWidth> (S) # TODO kerning?
(apply + (mapcar '((C) (charWidth> This C)) (chop (pack S)))) )
(de afmFile (F)
(in F
(let (This (new '(+Afm)) C NIL K NIL P NIL L NIL @A NIL)
(while (setq L (line))
(cond
((match '("F" "o" "n" "t" "N" "a" "m" "e" " " @A) L)
(=: nm (pack @A)) )
((head '("K" "P" "X" " ") L)
(push 'K (mapcar pack (split L " "))) )
((= ";" (last L))
(let? X (clip (split (mapcar pack (split L " ")) ";"))
(when (gt0 (format (cadr (assoc "C" X))))
(push 'C X) ) ) ) ) )
(=: c C)
(=: kpx K)
This ) ) )
# ((match '("C" "o" "m" "m" "e" "n" "t" " " @A) L)
# (push 'P (list "Comment" (pack @A))) )
# (T
# (push 'P (mapcar pack (split L " "))) ) ) )
# (=: p P)
(de afmDir (D)
(for F (dir D)
(when (tail '("." "a" "f" "m") (chop F))
(let? This (afmFile (pack D "/" F))
(push '*Afm (cons (: nm) This)) ) ) ) )
(de strWidth (Fnm S)
(when (cdr (assoc Fnm *Afm))
(strWidth> @ S) ) )
### pdf
(de pdfOut (App . Prg)
(if (and App (info *PdfOut))
(let *Fpos (car @)
(out (pack "+" *PdfOut)
(run Prg 1 '(*Fpos)) ) )
(let *Fpos 0
(out *PdfOut
(run Prg 1 '(*Fpos)) ) ) ) )
(de pdfWrL (L)
(let S NIL
(while L
(and S (prin " "))
(on S)
(pdfWr (pop 'L)) ) )
L )
(de pdfWr (Any)
(cond
((isa '+pdf Any) (wr> Any))
((pair Any) (pdfWrL Any))
(T (prin Any)) )
Any )
(class +pdf)
(class +PdfT +pdf) # text
# val
(dm T (Val Utf)
(=: val Val)
(=: utf Utf) )
(de pdfT (Val Utf)
(new '(+PdfT) Val Utf) )
(dm wr> ()
(prin "<")
(when (: utf) # utf-16be marker
(prin "FEFF") )
(let (I (tmp "pdf.tmp") O (if (: utf) (tmp "pdf.utf") I))
(out I
(prin (: val)) )
(when (: utf)
(call "iconv" "-f" "utf-8" "-t" "utf-16be" I "-o" O) )
(in O
(use B
(while (setq B (rd 1))
(prin (when (< B 16) "0") (hex B)) ) ) ) )
(prin ">") )
(class +PdfM +pdf) # map
# val
(dm T (Val)
(=: val Val) )
(de pdfM @
(new '(+PdfM) (rest)) )
(dm wr> ()
(prin "<<")
(pdfWrL (: val))
(prin ">>") )
(class +PdfV +pdf) # vector
# val
(dm T (Val)
(=: val Val) )
(de pdfV @
(new '(+PdfV) (rest)) )
(dm wr> ()
(prin "[")
(pdfWrL (: val))
(prin "]") )
(class +PdfS +pdf) # stream
# map str
(dm T (Map Str)
(=: map Map)
(=: str Str) )
(de pdfS (Map Str)
(new '(+PdfS) Map Str) )
(dm wr> ()
(let F (tmp "pdf.tmp")
(out F
(pdfWr (: str)) )
(let N (car (info F))
(if (: map val)
(push @ '/Length N)
(=: map (pdfM '/Length N)) ) )
(pdfWr (: map))
(prinl)
(prinl "stream")
(in F
(echo) )
(prinl)
(prinl "endstream") ) )
(class +PdfO +pdf) # object
# nr ver val
(dm T (Nr Ver Val)
(=: nr (if (=T Nr) (inc '*PdfOa) Nr))
(=: ver Ver)
(=: val Val) )
(de pdfO (Nr Ver Val)
(new '(+PdfO) Nr Ver Val) )
(dm wr> ()
(pdfOut T
(push '*PdfO (cons (: nr) *Fpos))
(pdfWr (: nr))
(prin " ")
(pdfWr (: ver))
(prinl " obj")
(pdfWr (: val))
(prinl)
(prinl "endobj") ) )
(class +PdfX +pdf) # xref
# map
(dm T (Map)
(=: map Map) )
(de pdfX (Map)
(new '(+PdfX) Map) )
(dm wrG> (I L)
(pdfWr I)
(prinl " " (length L))
(for X L
(prinl (pad 10 (car X)) " " (pad 5 (cadr X)) " " (caddr X)) ) )
(dm wr> ()
(pdfOut T
(prinl "xref")
(let (L (sort *PdfO)
I 0 J I G (list (list 0 65535 "f")) )
(while L
(let (X (pop 'L) N (car X) P (cdr X))
(unless (<= N (inc 'J))
(wrG> This I (flip G))
(setq I N J I G NIL) )
(push 'G (list P 0 "n")) ) )
(wrG> This I (flip G)) )
(when (: map)
(prinl "trailer")
(pdfWr @)
(prinl) )
(prinl "startxref")
(prinl *Fpos) ) )
(de pdf (*PdfOut . Prg)
(let (*Fpos 0 *PdfO NIL *PdfOa 0 *PdfX NIL)
(pdfOut NIL
(prinl "%PDF-1.2") # TODO use newer version?
(prinl "%" (char 130) (char 131) (char 132) (char 133)) ) # bin marker
(run Prg)
(pdfOut T
(pdfWr (pdfX *PdfX))
(prinl "%%EOF") ) ) )
(de pdfUpdate (I *PdfOut . Prg)
(when (info I)
(let (*Fpos (car @) *PdfO NIL *PdfOa 0 *PdfX NIL)
(out *PdfOut (in I (echo)))
(run Prg)
(pdfOut T
(pdfWr (pdfX *PdfX)) # TODO updated xref /Prev calc etc.
(prinl "%%EOF") ) ) ) )
(de pdfDraw Prg # TODO more drawing functions
(if *PdfDraw
(run Prg)
(let (*PdfDraw T
*X 0
*Y 0
*Fnm *Fnm
*Fsz *Fsz
q '(Prg (link 'q) (run Prg) (link 'Q))
BT '(Prg (link 'BT) (run Prg) (link ET))
Tf '((Fnm Fsz) (link (setq *Fnm Fnm) (setq *Fsz Fsz) 'Tf))
Tm '((A B C D X Y) (link A B C D (setq *X X) (setq *Y Y) 'Tm))
Tj '((Str Align)
(case Align
# TODO /Font => /BaseFont lookup real name for afm:-(
(center
(let (*X *X W (strWidth "Helvetica" Str))
(pdfDraw (Tm 1 0 0 1 (- *X (*/ W *Fsz 2000)) *Y))
(link (pdfT Str) 'Tj)) )
(right
(let (*X *X W (strWidth "Helvetica" Str))
(pdfDraw (Tm 1 0 0 1 (- *X (*/ W *Fsz 1000)) *Y))
(link (pdfT Str) 'Tj)) )
(T (link (pdfT Str) 'Tj)) ) ) )
(make
(run Prg) ) ) ) )
