unstable/gui/ppict: added abs-x, abs-y placer args, changed grid to 1-based

This commit is contained in:
Ryan Culpepper 2011-07-04 06:55:52 -06:00
parent d246a0bcc1
commit 1f7165df16
3 changed files with 32 additions and 18 deletions

View File

@ -46,12 +46,16 @@
[coord [coord
(->* (real? real?) (->* (real? real?)
(align/c (align/c
#:abs-x real?
#:abs-y real?
#:compose procedure?) #:compose procedure?)
placer?)] placer?)]
[grid [grid
(->* (exact-positive-integer? exact-positive-integer? (->* (exact-positive-integer? exact-positive-integer?
exact-nonnegative-integer? exact-nonnegative-integer?) exact-integer? exact-integer?)
(align/c (align/c
#:abs-x real?
#:abs-y real?
#:compose procedure?) #:compose procedure?)
placer?)] placer?)]
[cascade [cascade

View File

@ -66,7 +66,7 @@ In a placer function's arguments:
(define valign (align->v align)) (define valign (align->v align))
(define xfrac (/ (+ (sub1 col) (align->frac halign)) cols)) (define xfrac (/ (+ (sub1 col) (align->frac halign)) cols))
(define yfrac (/ (+ (sub1 row) (align->frac valign)) rows)) (define yfrac (/ (+ (sub1 row) (align->frac valign)) rows))
(refpoint* xfrac yfrac abs-x abs-y halign valign compose sep)) (refpoint* xfrac yfrac abs-x abs-y halign valign compose sep #f))
(define (coord xfrac yfrac [align 'cc] (define (coord xfrac yfrac [align 'cc]
#:abs-x [abs-x 0] #:abs-x [abs-x 0]
@ -76,10 +76,10 @@ In a placer function's arguments:
#:internal:skip [skip #f]) #:internal:skip [skip #f])
(define halign (align->h align)) (define halign (align->h align))
(define valign (align->v align)) (define valign (align->v align))
(refpoint* xfrac yfrac abs-x abs-y halign valign compose sep)) (refpoint* xfrac yfrac abs-x abs-y halign valign compose sep #f))
(define (refpoint* xfrac yfrac dxabs dyabs (define (refpoint* xfrac yfrac dxabs dyabs
halign valign compose sep) halign valign compose sep continued?)
(placer (placer
(lambda (scene picts) (lambda (scene picts)
(define scene-w (pict-width scene)) (define scene-w (pict-width scene))
@ -87,7 +87,7 @@ In a placer function's arguments:
(define dx (+ (* scene-w xfrac) dxabs)) (define dx (+ (* scene-w xfrac) dxabs))
(define dy (+ (* scene-h yfrac) dyabs)) (define dy (+ (* scene-h yfrac) dyabs))
(define-values (newpict newsep) (define-values (newpict newsep)
(apply-compose compose sep picts)) (apply-compose compose sep (cons (and continued? (blank 0)) picts)))
(define newpict-w (pict-width newpict)) (define newpict-w (pict-width newpict))
(define newpict-h (pict-height newpict)) (define newpict-h (pict-height newpict))
(define newscene (define newscene
@ -98,11 +98,13 @@ In a placer function's arguments:
(cond [(and (eq? valign 't) (eq? compose (halign->vcompose halign))) (cond [(and (eq? valign 't) (eq? compose (halign->vcompose halign)))
;; ie, going top-down and compose is the natural compose for this align ;; ie, going top-down and compose is the natural compose for this align
(mk-ppict result-pict (mk-ppict result-pict
(refpoint* 0 0 dx (+ dy newpict-h) halign valign compose newsep))] (refpoint* 0 0 dx (+ dy newpict-h)
halign valign compose newsep #t))]
[(and (eq? halign 'l) (eq? compose (valign->hcompose valign))) [(and (eq? halign 'l) (eq? compose (valign->hcompose valign)))
;; ie, going left-right and compose is the natural compose ... ;; ie, going left-right and compose is the natural compose ...
(mk-ppict result-pict (mk-ppict result-pict
(refpoint* 0 0 (+ dx newpict-w) dy halign valign compose newsep))] (refpoint* 0 0 (+ dx newpict-w) dy
halign valign compose newsep #t))]
[else result-pict]))))) [else result-pict])))))
;; ---- ;; ----

View File

@ -132,16 +132,20 @@ around it.
Returns @racket[#t] if @racket[x] is a placer, @racket[#f] otherwise. Returns @racket[#t] if @racket[x] is a placer, @racket[#f] otherwise.
} }
@defproc[(coord [relx real?] [rely real?] @defproc[(coord [rel-x real?]
[rel-y real?]
[align (or/c 'lt 'ct 'rt 'lc 'cc 'rc 'lb 'cb 'rb) 'cc] [align (or/c 'lt 'ct 'rt 'lc 'cc 'rc 'lb 'cb 'rb) 'cc]
[#:abs-x abs-x real? 0]
[#:abs-y abs-y real? 0]
[#:compose composer procedure? #, @elem{computed from @racket[align]}]) [#:compose composer procedure? #, @elem{computed from @racket[align]}])
placer?]{ placer?]{
Returns a placer that places picts according to a reference point Returns a placer that places picts according to @racket[rel-x] and
determined by @racket[relx] and @racket[rely], which are interpeted as @racket[rel-y], which are interpeted as fractions of the width and
fractions of the width and height of the base @tech{progressive height of the base @tech{progressive pict}. That is, @racket[0],
pict}. That is, @racket[0], @racket[0] is the top left corner of the @racket[0] is the top left corner of the base's bounding box, and
base's bounding box, and @racket[1], @racket[1] is the bottom right. @racket[1], @racket[1] is the bottom right. Then @racket[abs-x] and
@racket[abs-y] offsets are added to get the final reference point.
Additions are aligned according to @racket[align], a symbol whose name Additions are aligned according to @racket[align], a symbol whose name
consists of a horizontal alignment character followed by a vertical consists of a horizontal alignment character followed by a vertical
@ -165,10 +169,12 @@ another progressive pict only if
@examples[#:eval the-eval @examples[#:eval the-eval
(ppict-do base (ppict-do base
#:go (coord 1/3 3/4 'cc) #:go (coord 1/2 1/2 'rb)
(circle 20)) (colorize (circle 20) "red")
#:go (coord 1/2 1/2 'lt)
(colorize (circle 20) "darkgreen"))
(ppict-do base (ppict-do base
#:go (coord 1 0 'rt) #:go (coord 1 0 'rt #:abs-x -5 #:abs-y 10)
50 (code:comment "change spacing") 50 (code:comment "change spacing")
(text "abc") (text "abc")
(text "12345") (text "12345")
@ -184,9 +190,11 @@ another progressive pict only if
@defproc[(grid [cols exact-positive-integer?] @defproc[(grid [cols exact-positive-integer?]
[rows exact-positive-integer?] [rows exact-positive-integer?]
[col exact-nonnegative-integer?] [col exact-integer?]
[row exact-nonnegative-integer?] [row exact-integer?]
[align (or/c 'lt 'ct 'rt 'lc 'cc 'rc 'lb 'cb 'rb) 'cc] [align (or/c 'lt 'ct 'rt 'lc 'cc 'rc 'lb 'cb 'rb) 'cc]
[#:abs-x abs-x real? 0]
[#:abs-y abs-y real? 0]
[#:compose composer procedure? #, @elem{computed from @racket[align]}]) [#:compose composer procedure? #, @elem{computed from @racket[align]}])
placer?]{ placer?]{