148 lines
6.2 KiB
Scheme
148 lines
6.2 KiB
Scheme
;;note: This code computes the sizees for the rectangles in the space using the on dimention
|
|
;; off dimention method of referencing sizes. This means for example instead of saying
|
|
;; width we say off dimention 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 ondimention
|
|
;; and off dimention accessors for vertical or horizontal code. This method does not
|
|
;; allow the use of the readable, sort, 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 wich on is the on or off dimention. 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
|
|
(lib "match.ss")
|
|
(lib "contracts.ss")
|
|
(lib "etc.ss")
|
|
(lib "list.ss"))
|
|
|
|
(define-struct rect (x y))
|
|
(define-struct abs-rect (ondim offdim))
|
|
(define-struct dim (pos size stretchable?))
|
|
;; make-rect (dim? dim? . -> . rect?)
|
|
;; make-abs-rect (dim? dim? . -> . rect?)
|
|
;; make-dim (nonnegative? nonnegative? boolean? . -> . dim?)
|
|
|
|
(provide
|
|
(struct rect (x y))
|
|
(struct dim (pos size stretchable?)))
|
|
|
|
(provide/contract
|
|
(align ((symbols 'horizontal 'vertical)
|
|
positive? positive? (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->horiz (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->vert (abs-rect? . -> . rect?)
|
|
;; convert an abstract rect to a vertical rect
|
|
(define abs->vert
|
|
(match-lambda
|
|
[($ abs-rect ondim offdim)
|
|
(make-rect offdim ondim)]))
|
|
|
|
;; horiz->abs (rect? . -> . abs-rect?)
|
|
;; convert a horizontal rect to an abstract rect
|
|
(define horiz->abs
|
|
(match-lambda
|
|
[($ rect x y)
|
|
(make-abs-rect x y)]))
|
|
|
|
;; vert->abs (rect? . -> . abs-rect?)
|
|
;; convert a vertical rect to an abstract rect
|
|
(define vert->abs
|
|
(match-lambda
|
|
[($ rect x y)
|
|
(make-abs-rect y x)]))
|
|
|
|
;; stretch-to-fit (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)
|
|
(quicksort stretchable-sizes >))])
|
|
(allocate-evenly/position extra-div extra-mod offsize rects))))
|
|
|
|
;; get-onsizes (((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)])))
|
|
|
|
;; get-extra/rect ((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))))])))
|
|
|
|
;; allocate-evenly/position ((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))))]))))
|
|
|
|
;; waner (nonnegative? . -> . (-> (union 1 0)))
|
|
;; makes a thunk that returns 1 for it's first n applications, zero otherwise
|
|
(define (waner n)
|
|
(lambda ()
|
|
(if (zero? n)
|
|
0
|
|
(begin
|
|
(set! n (sub1 n))
|
|
1))))
|
|
) |