page & page-sizes
parent
ea88ccb05e
commit
c574a9a844
@ -0,0 +1,72 @@
|
||||
#lang debug at-exp racket/base
|
||||
(require racket/string
|
||||
racket/match)
|
||||
(provide page-sizes-ref)
|
||||
|
||||
(define page-size-strs
|
||||
@list{
|
||||
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
|
||||
})
|
||||
|
||||
(define page-sizes
|
||||
(make-hasheq
|
||||
(for*/list ([line (in-list page-size-strs)]
|
||||
[toks (in-value (for/list ([tok (in-port read (open-input-string line))])
|
||||
tok))]
|
||||
#:unless (null? toks))
|
||||
toks)))
|
||||
|
||||
(define (page-sizes-ref name [other-name #false])
|
||||
(define name-key (string->symbol (string-upcase name)))
|
||||
(if other-name
|
||||
(hash-ref page-sizes name-key (λ () (page-sizes-ref other-name)))
|
||||
(hash-ref page-sizes name-key)))
|
@ -0,0 +1,63 @@
|
||||
#lang debug racket/base
|
||||
(require "quad.rkt"
|
||||
"attr.rkt"
|
||||
"pipeline.rkt"
|
||||
"constants.rkt"
|
||||
"param.rkt"
|
||||
"page-sizes.rkt"
|
||||
racket/match)
|
||||
(provide (all-defined-out))
|
||||
|
||||
(define (quad-with-page-size? x)
|
||||
(and (quad? x)
|
||||
(number? (quad-ref x :page-width #false))
|
||||
(number? (quad-ref x :page-height #false))
|
||||
;; at this point :page-size and :page-orientation
|
||||
;; have been parsed into width & height
|
||||
(not (quad-has-key? x :page-size))
|
||||
(not (quad-has-key? x :page-orientation))))
|
||||
|
||||
(define (parse-page-size attrs)
|
||||
;; if set, debug-page-width and debug-page-height override the requested width & height
|
||||
(define width (or (debug-page-width) (hash-ref attrs :page-width #false)))
|
||||
(define height (or (debug-page-height) (hash-ref attrs :page-height #false)))
|
||||
(define size (hash-ref attrs :page-size default-page-size))
|
||||
(define orientation (hash-ref attrs :page-orientation default-page-orientation))
|
||||
|
||||
;; parsed-width and parsed-height are derived from named size & orientation
|
||||
(match-define (list parsed-width parsed-height)
|
||||
(sort
|
||||
(page-sizes-ref size default-page-size)
|
||||
;; for portrait, shorter edge is width
|
||||
(if (member orientation '("portrait" "tall")) < >)))
|
||||
|
||||
(hash-set! attrs :page-width (or width parsed-width))
|
||||
(hash-set! attrs :page-height (or height parsed-height))
|
||||
(hash-remove! attrs :page-size)
|
||||
(hash-remove! attrs :page-orientation)
|
||||
attrs)
|
||||
|
||||
|
||||
(module+ test
|
||||
(require rackunit racket/sequence)
|
||||
(define (attrs . args)
|
||||
(make-hash (for/list ([duo (in-slice 2 args)])
|
||||
(apply cons duo))))
|
||||
(define (width-height attrs)
|
||||
(cons (hash-ref attrs :page-width) (hash-ref attrs :page-height)))
|
||||
;; TODO: test other weird combinations of attr keys
|
||||
(check-equal? (width-height (parse-page-size (attrs :page-width 240))) (cons 240 792.0))
|
||||
(check-equal? (width-height (parse-page-size (attrs :page-height 240))) (cons 612.0 240))
|
||||
(check-equal? (width-height (parse-page-size (attrs :page-size "legal"))) (cons 612.0 1008.0))
|
||||
(check-equal? (width-height (parse-page-size (attrs :page-orientation "wide"))) (cons 792.0 612.0)))
|
||||
|
||||
|
||||
(define-pass (parse-page-sizes qs)
|
||||
;; put the default values for mandatory keys at the top level
|
||||
;; so that when we linearize, they will percolate downward
|
||||
#:pre (list-of quad?)
|
||||
#:post (list-of quad-with-page-size?)
|
||||
(for-each-attrs qs (λ (q)
|
||||
(unless (quad-with-page-size? q)
|
||||
(parse-page-size q)))))
|
||||
|
Loading…
Reference in New Issue