150 lines
6.0 KiB
Racket
150 lines
6.0 KiB
Racket
#|
|
|
This code computes the sizes for the rectangles in the space using the on dimension
|
|
off dimension method of referencing sizes. This means for example instead of saying
|
|
width we say off dimension for vertical alignment. Inorder to consume and return
|
|
the values in terms of width and height manipulation had to be done. I chose to create
|
|
a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect
|
|
stucts on to them. This code is a bit long but more readable than the other two options
|
|
I came up with.
|
|
1) define all functions to be letrec bound functions inside align. align then take
|
|
accessors for the rect struct. The caller of align swaps the order of ondimension
|
|
and off dimension accessors for vertical or horizontal code. This method does not
|
|
allow the use of the readable, short, consis pattern matching code. As some of the
|
|
matching code is easily removed this may be a good option but a large letrec
|
|
is harder to write tests for.
|
|
2) define a pattern matcher syntax that will match the struct rect but swap the fields
|
|
based on which on is the on or off dimension. This would have been shorter but much
|
|
more confusing.
|
|
The current implementation requires align to map over the rects and allocate new stucts
|
|
for each one on both passing into and returning from stretch-to-fit; This is not a bottle
|
|
neck and it is the most readable solution.
|
|
|#
|
|
|
|
(module alignment mzscheme
|
|
|
|
(require
|
|
mzlib/match
|
|
mzlib/contract
|
|
mzlib/etc
|
|
mzlib/list)
|
|
|
|
(define-struct rect (x y) (make-inspector))
|
|
(define-struct abs-rect (ondim offdim) (make-inspector))
|
|
(define-struct dim (pos size stretchable?) (make-inspector))
|
|
|
|
(define (nonnegative? n)
|
|
(and (number? n)
|
|
(or (positive? n)
|
|
(zero? n))))
|
|
|
|
(provide/contract
|
|
(struct rect ((x dim?) (y dim?)))
|
|
(struct abs-rect ((ondim dim?) (offdim dim?)))
|
|
(struct dim ((pos nonnegative?) (size nonnegative?) (stretchable? boolean?)))
|
|
(align ((symbols 'horizontal 'vertical)
|
|
nonnegative? nonnegative? (listof rect?)
|
|
. -> . (listof rect?))))
|
|
|
|
;; align the rectangles within the given space
|
|
(define (align type width height rects)
|
|
(cond
|
|
[(symbol=? type 'horizontal)
|
|
(map abs->horiz (stretch-to-fit width height (map horiz->abs rects)))]
|
|
[(symbol=? type 'vertical)
|
|
(map abs->vert (stretch-to-fit height width (map vert->abs rects)))]))
|
|
|
|
#;(abs-rect? . -> . rect?)
|
|
;; convert an abstract rect to a horizontal rect
|
|
(define abs->horiz
|
|
(match-lambda
|
|
[($ abs-rect ondim offdim)
|
|
(make-rect ondim offdim)]))
|
|
|
|
#;(abs-rect? . -> . rect?)
|
|
;; convert an abstract rect to a vertical rect
|
|
(define abs->vert
|
|
(match-lambda
|
|
[($ abs-rect ondim offdim)
|
|
(make-rect offdim ondim)]))
|
|
|
|
#;(rect? . -> . abs-rect?)
|
|
;; convert a horizontal rect to an abstract rect
|
|
(define horiz->abs
|
|
(match-lambda
|
|
[($ rect x y)
|
|
(make-abs-rect x y)]))
|
|
|
|
#;(rect? . -> . abs-rect?)
|
|
;; convert a vertical rect to an abstract rect
|
|
(define vert->abs
|
|
(match-lambda
|
|
[($ rect x y)
|
|
(make-abs-rect y x)]))
|
|
|
|
#;(positive? positive? (listof abs-rect?) . -> . (listof abs-rect?))
|
|
;; stretch the rectangles to fit with the given space
|
|
(define (stretch-to-fit onsize offsize rects)
|
|
(let-values ([(total-unstretchable-size stretchable-sizes)
|
|
(get-onsizes rects)])
|
|
(let-values ([(extra-div extra-mod)
|
|
(get-extra/rect (- onsize total-unstretchable-size)
|
|
(sort stretchable-sizes >))])
|
|
(allocate-evenly/position extra-div extra-mod offsize rects))))
|
|
|
|
#;(((listof rect?)) . ->* . (nonnegative? (listof nonnegative?)))
|
|
;; gets the unstretchable total size and a list of the stretchable sizes
|
|
(define (get-onsizes init-rects)
|
|
(let loop ([extra 0]
|
|
[stretchables empty]
|
|
[rects init-rects])
|
|
(match rects
|
|
[() (values extra stretchables)]
|
|
[(($ abs-rect ($ dim _ onsize #f) _) rest-rects ...)
|
|
(loop (+ onsize extra) stretchables rest-rects)]
|
|
[(($ abs-rect ($ dim _ onsize #t) _) rest-rects ...)
|
|
(loop extra (cons onsize stretchables) rest-rects)])))
|
|
|
|
#;((nonnegative? (listof nonnegative?)) . ->* . (nonnegative? nonnegative?))
|
|
;; get the space that each stretchable snip will have
|
|
(define (get-extra/rect init-extra init-sizes)
|
|
(let loop ([sizes init-sizes]
|
|
[extra init-extra]
|
|
[count (length init-sizes)])
|
|
(cond
|
|
[(empty? sizes) (values 0 0)]
|
|
[else
|
|
(let ([extra/rect (quotient (floor extra) count)]
|
|
[onsize (first sizes)])
|
|
(if (> onsize extra/rect)
|
|
(loop (rest sizes) (- extra onsize) (sub1 count))
|
|
(values extra/rect (modulo (floor extra) count))))])))
|
|
|
|
#;((cons/p nonnegative? nonnegative?) positive? (listof abs-rect?) . -> . (listof abs->rect?))
|
|
;; allocate the extra per rectangle to the stretchable rects and move them to their positions
|
|
(define (allocate-evenly/position extra-div extra-mod offsize init-rects)
|
|
(let ([mod (waner extra-mod)])
|
|
(let loop ([rects init-rects]
|
|
[onpos 0])
|
|
(match rects
|
|
[() empty]
|
|
[(($ abs-rect ($ dim _ min-onsize onstretch?)
|
|
($ dim _ min-offsize offstretch?)) rest-rects ...)
|
|
(let ([onsize (if (and onstretch?
|
|
(< min-onsize extra-div))
|
|
(+ extra-div (mod)) min-onsize)]
|
|
[offsize (if offstretch? offsize min-offsize)])
|
|
(cons (make-abs-rect (make-dim onpos onsize onstretch?)
|
|
(make-dim 0 offsize offstretch?))
|
|
(loop rest-rects (+ onpos onsize))))]))))
|
|
|
|
#;(natural-number? . -> . (-> (union 1 0)))
|
|
;; makes a thunk that returns 1 for its first n applications, zero otherwise
|
|
(define (waner n)
|
|
(lambda ()
|
|
(if (zero? n)
|
|
0
|
|
(begin
|
|
(set! n (sub1 n))
|
|
1))))
|
|
)
|