You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
64 lines
2.5 KiB
Racket
64 lines
2.5 KiB
Racket
3 years ago
|
#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)))))
|
||
|
|
|