syndicate-gui-2017/layout/sizing.rkt

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)))