typesetting/pitfall/pitfall/page.rkt

#lang debug racket/base
(require
  racket/dict
  racket/match
  "reference.rkt"
  sugar/unstable/dict
  "core.rkt")

(provide (all-defined-out))

(define (current-page doc)
  (match (pdf-pages doc)
    [(? pair? ps) (car ps)]
    [_ (raise-argument-error 'current-page "no pages in pdf" doc)]))

(define (add-content doc data)
  (page-write (current-page doc) data))

(struct $page (page-parent options size layout dimensions width height content resources margins ref)
  #:transparent #:mutable)

(define (make-page [page-parent #false] [options (mhasheq)])
  (define size (hash-ref options 'size "letter"))
  (define layout (hash-ref options 'layout "portrait"))
  (define dimensions (if (list? size)
                         size
                         (hash-ref page-sizes (string-upcase size))))
  (match-define (list width height) ((if (equal? layout "portrait") values reverse) dimensions))
  (define content (make-ref))
  (define resources (make-ref (mhash 'ProcSet '(PDF Text ImageB ImageC ImageI))))
  (define margins
    (match (hash-ref options 'margin #f)
      [(? number? margin-value) (margin margin-value margin-value margin-value margin-value)]
      [_ (hash-ref options 'margins (current-default-margins))]))
  (define page-ref
    (make-ref (mhasheq 'Type 'Page
                       'Parent page-parent
                       'MediaBox (list 0 0 width height)
                       'Contents content
                       'Resources resources)))
  ($page page-parent options size layout dimensions width height content resources margins page-ref))

(define (page-fonts p)
  (dict-ref! ($page-resources p) 'Font (make-hasheq)))

(define (page-xobjects p)
  (dict-ref! ($page-resources p) 'XObject (make-hasheq)))

(define (page-ext_gstates p)
  (dict-ref! ($page-resources p) 'ExtGState (make-hasheq)))

(define (page-patterns p)
  (dict-ref! ($page-resources p) 'Pattern (make-hasheq)))

(define (page-annotations p [annot #f])
  (if annot
      (dict-update! ($page-ref p) 'Annots (λ (val) (cons annot val)) null)
      (dict-ref! ($page-ref p) 'Annots null)))

(define (page-maxY p)
  (- ($page-height p) (margin-bottom ($page-margins p))))

(define (page-write p chunk)
  (ref-write ($page-content p) chunk)) 

(define (page-end p)
  (ref-end ($page-ref p))
  (ref-end ($page-resources p))
  (ref-end ($page-content p)))


(define page-sizes
  (hash "4A0" '(4767.87 6740.79)
        "2A0" '(3370.39 4767.87)
        "A0" '(2383.94 3370.39)
        "A1" '(1683.78 2383.94)
        "A2" '(1190.55 1683.78)
        "A3" '(841.89 1190.55)
        "A4" '(595.28 841.89)
        "A5" '(419.53 595.28)
        "A6" '(297.64 419.53)
        "A7" '(209.76 297.64)
        "A8" '(147.40 209.76)
        "A9" '(104.88 147.40)
        "A10" '(73.70 104.88)
        "B0" '(2834.65 4008.19)
        "B1" '(2004.09 2834.65)
        "B2" '(1417.32 2004.09)
        "B3" '(1000.63 1417.32)
        "B4" '(708.66 1000.63)
        "B5" '(498.90 708.66)
        "B6" '(354.33 498.90)
        "B7" '(249.45 354.33)
        "B8" '(175.75 249.45)
        "B9" '(124.72 175.75)
        "B10" '(87.87 124.72)
        "C0" '(2599.37 3676.54)
        "C1" '(1836.85 2599.37)
        "C2" '(1298.27 1836.85)
        "C3" '(918.43 1298.27)
        "C4" '(649.13 918.43)
        "C5" '(459.21 649.13)
        "C6" '(323.15 459.21)
        "C7" '(229.61 323.15)
        "C8" '(161.57 229.61)
        "C9" '(113.39 161.57)
        "C10" '(79.37 113.39)
        "RA0" '(2437.80 3458.27)
        "RA1" '(1729.13 2437.80)
        "RA2" '(1218.90 1729.13)
        "RA3" '(864.57 1218.90)
        "RA4" '(609.45 864.57)
        "SRA0" '(2551.18 3628.35)
        "SRA1" '(1814.17 2551.18)
        "SRA2" '(1275.59 1814.17)
        "SRA3" '(907.09 1275.59)
        "SRA4" '(637.80 907.09)
        "EXECUTIVE" '(521.86 756.00)
        "FOLIO" '(612.00 936.00)
        "LEGAL" '(612.00 1008.00)
        "LETTER" '(612.00 792.00)
        "TABLOID" '(792.00 1224.00)))