unstable/gui/ppict: added abs-x, abs-y placer args, changed grid to 1-based
This commit is contained in:
parent
d246a0bcc1
commit
1f7165df16
|
@ -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
|
||||||
|
|
|
@ -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])))))
|
||||||
|
|
||||||
;; ----
|
;; ----
|
||||||
|
|
|
@ -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?]{
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user