151 lines
4.0 KiB
Racket
151 lines
4.0 KiB
Racket
#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)))
|