#lang racket/base ;; Dimension sizing, based loosely on TeX's boxes-and-glue model. (provide (struct-out fill) (struct-out sizing) (struct-out box-size) (struct-out rectangle) weak-fill zero-sizing weak-fill-sizing zero-box-size weak-fill-box-size zero-rectangle fill+ fill-max fill-min fill-scale fill-weaken sizing-contains? sizing-min sizing-max sizing-overlap? sizing-scale sizing-weaken sizing-pad sizing-adjust-ideal sizing-sum box-size-weaken) (require racket/match) ;;--------------------------------------------------------------------------- ;; A Fill is one of ;; - a Nat, a fixed amount of space ;; - a (fill Nat Nat), a potentially infinite amount of space (struct fill (weight rank) #:transparent) ;; A Sizing is a (sizing Nat Fill Fill) (struct sizing (ideal stretch shrink) #:transparent) ;; A BoxSize is a (box-size Sizing Sizing) (struct box-size (horizontal vertical) #:transparent) ;; A Rectangle is a (rectangle Nat Nat BoxSize) (struct rectangle (left top width height) #:transparent) ;;--------------------------------------------------------------------------- ;; A very weak fill. (define weak-fill (fill 1 -1)) (define zero-sizing (sizing 0 0 0)) (define weak-fill-sizing (sizing 0 weak-fill 0)) (define zero-box-size (box-size zero-sizing zero-sizing)) (define weak-fill-box-size (box-size weak-fill-sizing weak-fill-sizing)) (define zero-rectangle (rectangle 0 0 0 0)) ;;--------------------------------------------------------------------------- ;; (Nat Nat -> Nat) -> (Fill Fill -> Fill) (define ((fill-binop op) a b) (match* (a b) [((? number?) (? number?)) (op a b)] [((? number?) (? fill?)) b] [((? fill?) (? number?)) a] [((fill w1 r1) (fill w2 r2)) (cond [(= r1 r2) (fill (op w1 w2) r1)] [(> r1 r2) (fill w1 r1)] [(< r1 r2) (fill w2 r2)])])) ;; Fill Fill -> Fill (define fill+ (fill-binop +)) (define fill-max (fill-binop max)) (define (fill-min a b) (if (and (number? a) (number? b)) (min a b) 0)) (define (fill-scale f scale) (if (number? f) (* f scale) f)) (define (fill-weaken f w r) (if (fill? f) (fill w r) f)) (define (sizing-contains? s v) (match-define (sizing x x+ x-) s) (cond [(>= v x) (if (number? x+) (<= v (+ x x+)) #t)] [(<= v x) (if (number? x-) (>= v (- x x-)) #t)])) (define (sizing-min s) (match (sizing-shrink s) [(? number? n) (- (sizing-ideal s) n)] [(? fill?) -inf.0])) (define (sizing-max s) (match (sizing-stretch s) [(? number? n) (+ (sizing-ideal s) n)] [(? fill?) +inf.0])) (define (sizing-overlap? x y) (define largest-min (max (sizing-min x) (sizing-min y))) (define smallest-max (min (sizing-max x) (sizing-max y))) (< largest-min smallest-max)) (define (sizing-scale s scale) (match-define (sizing x x+ x-) s) (sizing (* x scale) (fill-scale x+ scale) (fill-scale x- scale))) (define (sizing-weaken s [stretch-weight 1] [stretch-rank 0] [shrink-weight stretch-weight] [shrink-rank stretch-rank]) (match-define (sizing x x+ x-) s) (sizing x (fill-weaken x+ stretch-weight stretch-rank) (fill-weaken x- shrink-weight shrink-rank))) (define (sizing-pad s amount) (match-define (sizing x x+ x-) s) (sizing (+ x amount) x+ x-)) (define (sizing-adjust-ideal s i) (match-define (sizing x x+ x-) s) (sizing i (if (fill? x+) x+ (+ x+ (- x i))) (if (fill? x-) x- (- x- (- x i))))) (define (sizing-sum sizings) (sizing (foldl + 0 (map sizing-ideal sizings)) (foldl fill+ 0 (map sizing-stretch sizings)) (foldl fill+ 0 (map sizing-shrink sizings)))) (define (box-size-weaken bs [weight 1] [rank 0]) (match-define (box-size h v) bs) (box-size (sizing-weaken h weight rank) (sizing-weaken v weight rank)))