make quads printable

main
Matthew Butterick 6 years ago committed by Matthew Butterick
parent 17bba2fa45
commit a5cdc5aab8

@ -0,0 +1,27 @@
#lang br
(require quad pict)
(provide (all-defined-out))
(define (quad->pict q)
(match-define (list xmin ymin xmax ymax) (bounding-box q))
(define scaling-factor 3)
(define stroke-width 0.5)
(define margin 3)
(unsafe-dc
(λ (dc dx dy)
(send dc scale scaling-factor scaling-factor)
(send dc translate (+ (- xmin) stroke-width margin) (+ (- ymin) stroke-width margin))
(let loop ([q q][idx 0])
;; outer edge
(send dc set-pen "slategray" stroke-width 'solid)
(send dc set-brush "white" 'solid)
(define args (append (quad-origin q) (quad-size q)))
(send dc draw-rectangle . args)
;; join pt
(send dc set-pen "slategray" 0 'solid)
(send dc set-brush (if (zero? idx) "black" "red") 'solid)
(define pt-args (append (map sub1 (to-point q)) (list 2 2)))
(send dc draw-rectangle . pt-args)
(map (λ (qe) (loop qe (add1 idx))) (quad-elems q))))
(* scaling-factor (+ (- xmax xmin) (* stroke-width 2) (* margin 2)))
(* scaling-factor (+ (- ymax ymin) (* stroke-width 2) (* margin 2)))))

@ -126,12 +126,18 @@
(define (bounding-box . qs-in)
;; size of box that holds q and all subqs, based on reported origin and size
;; does not know anything about drawing (which may go outside the box)
(define qs (flatten-quad (position (make-quad #:elems qs-in))))
(define qs (flatten-quad (make-quad #:elems qs-in)))
(define (outer-pt q) (pt+ (quad-origin q) (quad-size q)))
(define max-outer-pt (apply map max (cons '(0 0) (map outer-pt qs))))
(define min-origin (apply map min (cons '(0 0) (map quad-origin qs))))
(pt- max-outer-pt min-origin))
(append min-origin max-outer-pt))
(define (attach-to from-q from-pt to-q to-pt)
(struct-copy quad from-q
[elems (cons (struct-copy quad to-q
[from-parent from-pt]
[to to-pt])
(quad-elems from-q))]))
(module+ test
(require rackunit)
@ -140,23 +146,11 @@
"bounding boxes"
(define q10 (make-quad #:size '(10 10)))
(define q20 (make-quad #:size '(20 20)))
(check-equal? (bounding-box q10) '(10 10))
(check-equal? (bounding-box q10 q10) '(20 10))
(check-equal? (bounding-box q20) '(20 20))
(check-equal? (bounding-box q10 q20) '(30 20))
(check-equal? (bounding-box q10 q20 q20) '(50 20))
(define q1 (make-quad #:size '(20 20)))
(define p (make-quad #:size '(35 35)
#:elems (list q1)))
(let ([p (position p)])
(println (quad-origin p))
(println (quad-origin (car (quad-elems p)))))
(let ([p p])
(println (quad-origin p))
(println (quad-origin (car (quad-elems p)))))
(check-equal? (bounding-box (position p)) (bounding-box p)))
(check-equal? (bounding-box q10) '(0 0 10 10))
(check-equal? (bounding-box (position (make-quad #:elems (list q10 q10)))) '(0 0 20 10))
(check-equal? (bounding-box q20) '(0 0 20 20))
(check-equal? (bounding-box (position (make-quad #:elems (list q10 q20)))) '(0 0 30 20))
(check-equal? (bounding-box (position (make-quad #:elems (list q10 q20 q20)))) '(0 0 50 20)))
(test-case
"origins"

@ -1,35 +0,0 @@
#lang br
(require quad racket/draw pict pict/convert)
(provide (all-defined-out))
(verbose-quad-printing? #t)
(define (quad->pict q)
(match-define (list bbox-x bbox-y) (bounding-box q))
(define scaling-factor 3)
(define stroke-width 0.5)
(unsafe-dc
(λ (dc dx dy)
(send dc scale scaling-factor scaling-factor)
(send dc translate stroke-width stroke-width)
(send dc set-pen
(new pen% [width stroke-width] [color "slategray"]))
(let loop ([q q])
(define args (append (quad-origin q) (quad-size q)))
(send dc draw-rectangle . args)
(map loop (quad-elems q))))
(* scaling-factor (+ bbox-x (* stroke-width 2)))
(* scaling-factor (+ bbox-y (* stroke-width 2)))))
(struct quad-pict quad ()
#:property prop:pict-convertible quad->pict)
(define make-quad (make-quad-constructor quad-pict))
(define q1 (make-quad #:size '(20 20)))
(define q2 (make-quad #:size '(15 15)))
(define p (make-quad #:size '(35 35)
#:elems (list q1)))
;; todo: make these equal
(bounding-box (position p))
(bounding-box p)

@ -1,19 +1,11 @@
#lang scribble/manual
@(require racket/runtime-path scribble/eval (for-label txexpr (except-in pollen #%module-begin) xml racket/base racket/draw)
pollen/scribblings/mb-tools quad/repl)
@(require racket/runtime-path scribble/example (for-label txexpr (except-in pollen #%module-begin) xml racket/base racket/draw)
pollen/scribblings/mb-tools quad/pict)
@(define my-eval (make-base-eval))
@(my-eval `(require quad quad/repl pict))
@examples[#:eval my-eval
(define q1 (make-quad #:size '(20 20)))
(define q2 (make-quad
#:from 'bo
#:to 'bi
#:size '(15 15)))
(d (position (list q1 q2)))
]
@(my-eval `(require quad quad/pict))
@title[#:style 'toc]{Quad: document processor}
@ -530,5 +522,66 @@ Part of the idea of @racket[quad] is to make typographic layout & PDF generation
In letterpress printing, a @italic{quad} was a piece of metal used as spacing material within a line.
@section{Quad life}
As mentioned above, The @racket[quad] library itself knows as little as it can about typography and fonts and pictures. Nor does it even assert a document model like Scribble. Rather, it offers a generic geometric represntation of layout elements. In turn, these elements can be combined into more useful pieces (e.g., @racket[quadwriter]).
@subsection{Data model: the quad}
The eponymous @racket[quad] is a structure type that represents a rectangular layout area. This rectangle is used for layout purposes only. It is not enforced during the rendering phase. Meaning, once positioned, a quad's drawing function can access this rectangle, but does not need to stay within it.
Each quad has nested @deftech{elements}, which is a (possibly empty) list of subquads. Given a certain element, the quad containing it is called its @deftech{parent} quad.
Quads can be freely nested. There are no rules about what kind of quad can be nested in another.
@subsection{Wrapping}
Wrapping is a optional phase where lists of quads are broken into sublists of a certain size. In @racket[quadwriter], the list of words is wrapped to produce a list of lines of a certain horizontal width. In turn, the list of lines is wrapped to produce a list of pages of a certain vertical height.
@subsection{Layout}
The heart of Quad's layout logic is its system of @deftech{anchor points}. A quad is positioned in a layout by aligning its anchor point to an anchor point on the previous quad.
Each quad has a set of 11 anchor points on its perimeter.
Eight points are named for the compass directions: @racket['n] (= top center) @racket['e] (= right center) @racket['s] (= bottom center) @racket['w] (= left ceter) @racket['ne] (= upper right) @racket['se] (= lower right) @racket['sw] (= lower left) @racket['nw] (= upper left).
The center of the quad is @racket['c].
The other two anchor points are @racket['baseline-in] and @racket['baseline-out] or just @racket['bi] and @racket['bo]. These points are also on the quad perimieter. They allow quads containing type to be aligned according to adjacent baselines. The exact location of these points depends on the direction of the script. For instance, in left-to-right languages, @racket['baseline-in] is on the left edge, and @racket['baseline-out] is on the right. The vertical position of these points depends on the font associated with the quad. If no font is specified, the @racket['bi] and @racket['bo] points are vertically positioned at the southern edge.
By default, each subquad will ultimately be positioned relative to the immediately preceding subquad (or, if it's the first subquad, the parent). Optionally, a subquad can attach to the parent.
How does a quad know which anchor points to use? Each quad specifies a @deftech{to anchor} on its own perimeter, and a @deftech{from anchor} on the previous quad's perimeter. The quad is positioned by moving it until its @deftech{to anchor} matches the position of the (already positioned) @deftech{from anchor}. Think of it like two tiny magnets clicking together.
A key benefit of the anchor-point system is that it gets rid of notions of ``horizontal'', ``vertical'', ``up'', ``down'', etc. Quads flow in whatever direction is implied by their anchor points.
@examples[#:label #f #:eval my-eval
(define q1 (make-quad #:size '(25 25)))
(define q2 (make-quad #:size '(15 15)))
(quad->pict (position (attach-to q1 'e q2 'w)))
(quad->pict (position (attach-to q1 'nw q2 'se)))
(quad->pict (position (attach-to q1 'e q2 'w)))
(quad->pict (position (attach-to q1 's q2 'n)))
(quad->pict (position (attach-to q1 'e q2 'n)))
]
``Wait a minute — why is the new quad specifying @emph{both} anchor points? Shouldn't the from anchor be specified by the previous quad?'' It could, but it would make the layout system less flexible, because all the subquads hanging onto a certain quad would have to emanate from a single point. This way, every subquad can attach to its neighbor (or the parent) in whatever way it prefers.
@subsection{Rendering}
Once the quads have been positioned, they are passed to the renderer, which recursively visits each quad and calls its drawing function.
Though every quad has a size field, this is just the size used during layout and positioning. Quad doesn't know (or care) about whether the drawing stays within those bounds.
@(linebreak)
@(linebreak)
@(linebreak)
@italic{``A way of doing something original is by trying something
so painstaking that nobody else has ever bothered with it.'' — Brian Eno}
Loading…
Cancel
Save