suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

a bunch of fixes to the diagram:

Browse Source 
- added some color (mostly to try to disambiguate the lines)

- several of the things named '*-element' actually belong under content, not element.

- element has 'content', not the substructs.

- convertible?s are content's.

- the 'content' field in an element is not a list, but simply a content.

- there are a bunch of things under target-element.

- image-element was missing fields

- collect-element was missing the collect field

original commit: 411aeb99b845823aa5f9bcaebe6b686ad478ab75
This commit is contained in:
Robby Findler 2012-06-19 17:38:25 -05:00
parent 87197b53ca
commit ed8baf5d79
3 changed files with 210 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
collects/scribblings/scribble/class-diagrams.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base #lang racket/base
(require (prefix-in etc: mzlib/etc) (require (prefix-in etc: mzlib/etc)
texpict/mrpict texpict/mrpict
texpict/utils (only-in slideshow/pict pin-line pin-arrow-line)
(except-in texpict/utils pin-line pin-arrow-line)
racket/class racket/class
racket/runtime-path racket/runtime-path
racket/draw racket/draw
@ -20,6 +21,9 @@
(define field-arrowhead-size 10) (define field-arrowhead-size 10)
(define hierarchy-color "navy")
(define type-link-color "firebrick")
#| #|
(define font-family "Palatino") (define font-family "Palatino")
(define-runtime-path afm "afm") (define-runtime-path afm "afm")
@ -108,13 +112,21 @@
[else (user-type-font str)])) [else (user-type-font str)]))
;; class-name : string -> pict ;; class-name : string -> pict
(define (class-name txt) (define (class-name txt #:spacing-word [spacing-word txt])
(apply vl-append (map var-font (regexp-split #rx"\n" txt)))) (define p (colorize (lt-superimpose (ghost (var-font spacing-word))
(apply vl-append (map var-font (regexp-split #rx"\n" txt))))
"white"))
(refocus (cc-superimpose (colorize (filled-rectangle (+ class-box-margin class-box-margin (pict-width p))
(+ class-box-margin class-box-margin (pict-height p)))
"black")
p)
p))
(define class-box-margin 4)
;; class-box : pict (or/c #f (listof pict)) (or/c #f (listof pict)) -> pict ;; class-box : pict (or/c #f (listof pict)) (or/c #f (listof pict)) -> pict
(define (class-box name fields methods) (define (class-box name fields methods)
(let* ([spacing 4] (let* ([mk-blank (λ () (blank 0 (+ class-box-margin class-box-margin)))])
[mk-blank (λ () (blank 0 spacing))])
(cond (cond
[(and methods fields) [(and methods fields)
(let* ([top-spacer (mk-blank)] (let* ([top-spacer (mk-blank)]
@ -129,7 +141,7 @@
(blank 0 4) (blank 0 4)
(apply vl-append methods)))]) (apply vl-append methods)))])
(add-hline (add-hline
(add-hline (frame (inset main spacing)) (add-hline (frame (inset main class-box-margin))
top-spacer) top-spacer)
bottom-spacer))] bottom-spacer))]
[fields [fields
@ -139,10 +151,10 @@
(if (null? fields) (if (null? fields)
(blank) (blank)
(apply vl-append fields)))]) (apply vl-append fields)))])
(add-hline (frame (inset main spacing)) (add-hline (frame (inset main class-box-margin))
top-spacer))] top-spacer))]
[methods (class-box name methods fields)] [methods (class-box name methods fields)]
[else (frame (inset name spacing))]))) [else (frame (inset name class-box-margin))])))
(define (add-hline main sub) (define (add-hline main sub)
(let-values ([(x y) (cc-find main sub)]) (let-values ([(x y) (cc-find main sub)])
@ -159,13 +171,14 @@
(error 'hierarchy "expected supers to be on top of subs, supers bottom is at ~a, and subs tops is at ~a" (error 'hierarchy "expected supers to be on top of subs, supers bottom is at ~a, and subs tops is at ~a"
supers-bottoms supers-bottoms
subs-tops)) subs-tops))
(let* ([main-line-y (/ (+ supers-bottoms subs-tops) 2)] (let* ([main-line-y (max (- subs-tops 20) (/ (+ supers-bottoms subs-tops) 2))]
[main-line-start-x (center-x main (car sorted-subs))] [main-line-start-x (center-x main (car sorted-subs))]
[main-line-end-x (center-x main (last sorted-subs))] [main-line-end-x (center-x main (last sorted-subs))]
[w/main-line [w/main-line
(pin-line main (pin-line main
main (λ (_1 _2) (values main-line-start-x main-line-y)) main (λ (_1 _2) (values main-line-start-x main-line-y))
main (λ (_1 _2) (values main-line-end-x main-line-y)))] main (λ (_1 _2) (values main-line-end-x main-line-y))
#:color hierarchy-color)]
[super-lines [super-lines
(map (λ (super) (map (λ (super)
(let-values ([(x y) (cb-find main super)]) (let-values ([(x y) (cb-find main super)])
@ -183,7 +196,8 @@
(let-values ([(x y) (ct-find main sub)]) (let-values ([(x y) (ct-find main sub)])
(pin-line (ghost main) (pin-line (ghost main)
sub ct-find sub ct-find
main (λ (_1 _2) (values x main-line-y))))) main (λ (_1 _2) (values x main-line-y))
#:color hierarchy-color)))
subs)]) subs)])
(apply cc-superimpose (apply cc-superimpose
w/main-line w/main-line
@ -196,13 +210,15 @@
(let ([points (list (make-object point% (/ triangle-width 2) 0) (let ([points (list (make-object point% (/ triangle-width 2) 0)
(make-object point% 0 triangle-height) (make-object point% 0 triangle-height)
(make-object point% triangle-width triangle-height))]) (make-object point% triangle-width triangle-height))])
(dc (λ (dc dx dy) (colorize
(let ([brush (send dc get-brush)]) (dc (λ (dc dx dy)
(send dc set-brush (send brush get-color) 'solid) (let ([brush (send dc get-brush)])
(send dc draw-polygon points dx dy) (send dc set-brush (send brush get-color) 'solid)
(send dc set-brush brush))) (send dc draw-polygon points dx dy)
triangle-width (send dc set-brush brush)))
triangle-height))) triangle-width
triangle-height)
hierarchy-color)))
(define (center-x main pict) (define (center-x main pict)
(let-values ([(x y) (cc-find main pict)]) (let-values ([(x y) (cc-find main pict)])
@ -271,11 +287,12 @@
(pin-arrow-line field-arrowhead-size pict (pin-arrow-line field-arrowhead-size pict
dot1 cc-find dot1 cc-find
dot2 cc-find dot2 cc-find
#f #f #f #f #:hide-arrowhead? (not show-arrowhead?)
#:hide-arrowhead? (not show-arrowhead?)) #:color type-link-color)
(pin-line pict (pin-line pict
dot1 cc-find dot1 cc-find
dot2 cc-find))) dot2 cc-find
#:color type-link-color)))
(define (hierarchy/layout tops bottoms (define (hierarchy/layout tops bottoms
#:every-other-space [every-other-space 0] #:every-other-space [every-other-space 0]
@ -423,9 +440,10 @@
(define connect-dots-contract (->* (boolean? pict? pict?) () #:rest (listof pict?) (values pict?))) (define connect-dots-contract (->* (boolean? pict? pict?) () #:rest (listof pict?) (values pict?)))
(provide type-link-color)
(provide/contract (provide/contract
[field-spec (->* ((or/c #f string?) string?) (string? #:default string?) pict?)] [field-spec (->* ((or/c #f string?) string?) (string? #:default string?) pict?)]
[class-name (-> string? pict?)] [class-name (->* (string?) (#:spacing-word string?) pict?)]
[class-box (-> pict? (or/c false/c (listof pict?)) (or/c false/c (listof pict?)) pict?)] [class-box (-> pict? (or/c false/c (listof pict?)) (or/c false/c (listof pict?)) pict?)]
[hierarchy/layout [hierarchy/layout
(->* ((cons/c pict? (listof pict?)) (cons/c pict? (listof pict?))) (->* ((cons/c pict? (listof pict?)) (cons/c pict? (listof pict?)))

17
collects/scribblings/scribble/core.scrbl
View File

@ -56,10 +56,14 @@ None of the passes mutate the document representation. Instead, the
This diagram shows the large-scale structure of the This diagram shows the large-scale structure of the
type hierarchy for Scribble documents. A box represents type hierarchy for Scribble documents. A box represents
a struct; for example @racket[part] is a struct. The substruct relationship a struct or a built-in Racket type; for example @racket[part] is a struct.
is shown vertically with lines connected by a triangle; The bottom portion of a box shows the fields; for example
@racket[part] has three fields, @racket[title], @racket[blocks],
and @racket[subparts].
The substruct relationship
is shown vertically with navy blue lines connected by a triangle;
for example, a @racket[compound-paragraph] is a @racket[block]. for example, a @racket[compound-paragraph] is a @racket[block].
The types of values on fields are shown via lines in the diagram. The types of values on fields are shown via dark red lines in the diagram.
Doubled lines represent lists and tripled lines represent lists Doubled lines represent lists and tripled lines represent lists
of lists; for example, the @racket[blocks] field of of lists; for example, the @racket[blocks] field of
@racket[compound-paragraph] is a list of @racket[blocks]. @racket[compound-paragraph] is a list of @racket[blocks].
@ -69,9 +73,10 @@ a @racket[traverse-block] struct is a function that
computes a @racket[block]. computes a @racket[block].
The diagram is not completely The diagram is not completely
accurate; a few fields are omitted and sometimes the types accurate: a @racket[table] may have @racket['cont]
are simplified (e.g., a @racket[table] may have @racket['cont] in place of a block in its @racket[cells] field, and
in place of a block). the types of fields are only shown if they are other structs
in the diagram.
A prose description with more detail follows the diagram. A prose description with more detail follows the diagram.
@(mk-diagram) @(mk-diagram)

289
collects/scribblings/scribble/struct-hierarchy.rkt
View File

@ -1,8 +1,9 @@
#lang racket/base #lang racket/base
(require "class-diagrams.rkt" (require "class-diagrams.rkt"
(only-in slideshow/pict pin-arrow-line)
texpict/mrpict texpict/mrpict
texpict/utils (except-in texpict/utils pin-arrow-line)
racket/system racket/system
racket/class racket/class
racket/draw) racket/draw)
@ -15,7 +16,7 @@
(define (mk-diagram) (define (mk-diagram)
(define part-name (class-name "part")) (define part-name (class-name "part" #:spacing-word "subparts"))
(define part-blocks-field (field-spec #f "blocks")) (define part-blocks-field (field-spec #f "blocks"))
(define part-subparts-field (field-spec #f "subparts")) (define part-subparts-field (field-spec #f "subparts"))
(define part-title-field (field-spec #f "title")) (define part-title-field (field-spec #f "title"))
@ -60,10 +61,6 @@
(define content-name (class-name "content")) (define content-name (class-name "content"))
(define content-box (class-box content-name #f #f)) (define content-box (class-box content-name #f #f))
(define element-name (class-name "element"))
(define element-style (field-spec #f "style"))
(define element-box (class-box element-name (list element-style) #f))
(define string-name (class-name "string")) (define string-name (class-name "string"))
(define string-box (class-box string-name #f #f)) (define string-box (class-box string-name #f #f))
@ -73,58 +70,83 @@
(define pict-name (class-name "pict")) (define pict-name (class-name "pict"))
(define pict-box (class-box pict-name #f #f)) (define pict-box (class-box pict-name #f #f))
(define convertible-name (class-name "convertible"))
(define convertible-box (class-box convertible-name #f #f))
(define list-name (class-name "list")) (define list-name (class-name "list"))
(define list-box (class-box list-name #f #f)) (define list-box (class-box list-name #f #f))
(define target-element-name (class-name "target-\nelement")) (define delayed-element-name (class-name "delayed-\nelement"))
(define target-tag (field-spec #f "tag")) (define delayed-element-content (field-spec #f "content"))
(define target-content (field-spec #f "content")) (define delayed-element-box (class-box delayed-element-name (list delayed-element-content) #f))
(define target-element-box (class-box target-element-name
(list target-tag target-content) (define render-element-name (class-name "render-\nelement"))
#f)) (define render-element-content (field-spec #f "content"))
(define render-element-box (class-box render-element-name (list render-element-content) #f))
(define traverse-element-name (class-name "traverse-\nelement"))
(define traverse-element-content (field-spec #f "content"))
(define traverse-element-box (class-box traverse-element-name (list traverse-element-content) #f))
(define part-relative-element-name (class-name "part-\nrelative-\nelement"))
(define part-relative-element-resolve (field-spec #f "resolve"))
(define part-relative-element-box (class-box part-relative-element-name (list part-relative-element-resolve) #f))
(define element-name (class-name "element"))
(define element-style (field-spec #f "style"))
(define element-content (field-spec #f "content"))
(define element-box (class-box element-name (list element-style element-content) #f))
(define link-element-name (class-name "link-\nelement")) (define link-element-name (class-name "link-\nelement"))
(define link-tag (field-spec #f "tag")) (define link-tag (field-spec #f "tag"))
(define link-content (field-spec #f "content"))
(define link-element-box (class-box link-element-name (define link-element-box (class-box link-element-name
(list link-tag link-content) (list link-tag)
#f)) #f))
(define delayed-element-name (class-name "delayed-\nelement"))
(define delayed-content (field-spec #f "content"))
(define delayed-element-box (class-box delayed-element-name (list delayed-content) #f))
(define render-element-name (class-name "render-\nelement"))
(define render-content (field-spec #f "content"))
(define render-element-box (class-box render-element-name (list render-content) #f))
(define traverse-element-name (class-name "traverse-\nelement"))
(define traverse-content (field-spec #f "content"))
(define traverse-element-box (class-box traverse-element-name (list traverse-content) #f))
(define collect-element-name (class-name "collect-\nelement")) (define collect-element-name (class-name "collect-\nelement"))
(define collect-content (field-spec #f "content")) (define collect-element-collect (field-spec #f "collect"))
(define collect-element-box (class-box collect-element-name (list collect-content) #f)) (define collect-element-box (class-box collect-element-name (list collect-element-collect) #f))
(define index-element-name (class-name "index-\nelement")) (define index-element-name (class-name "index-\nelement" #:spacing-word "keywords"))
(define index-element-tag (field-spec #f "tag")) (define index-element-tag (field-spec #f "tag"))
(define index-element-keywords (field-spec #f "keywords")) (define index-element-keywords (field-spec #f "keywords"))
(define index-element-content (field-spec #f "content"))
(define index-element-box (class-box index-element-name (define index-element-box (class-box index-element-name
(list index-element-tag index-element-keywords index-element-content) (list index-element-tag index-element-keywords)
#f)) #f))
(define image-element-name (class-name "image-\nelement")) (define image-element-name (class-name "image-\nelement" #:spacing-word "suffixes"))
(define image-element-box (class-box image-element-name (list) #f)) (define image-element-path (field-spec #f "path"))
(define image-element-suffixes (field-spec #f "suffixes"))
(define image-element-scale (field-spec #f "scale"))
(define image-element-box (class-box image-element-name
(list image-element-path
image-element-suffixes
image-element-scale)
#f))
(define multi-arg-element-name (class-name "multi-arg-\nelement")) (define multi-arg-element-name (class-name "multi-arg-\nelement"))
(define multi-arg-element-tag (field-spec #f "tag")) (define multi-arg-element-tag (field-spec #f "tag"))
(define multi-arg-element-content (field-spec #f "content")) (define multi-arg-element-box (class-box multi-arg-element-name (list multi-arg-element-tag) #f))
(define multi-arg-element-box (class-box multi-arg-element-name (list multi-arg-element-tag multi-arg-element-content) #f))
(define target-element-name (class-name "target-\nelement"))
(define target-tag (field-spec #f "tag"))
(define target-element-box (class-box target-element-name
(list target-tag)
#f))
(define redirect-target-element-name (class-name "redirect-target-\nelement"))
(define redirect-target-alt-path (field-spec #f "alt-path"))
(define redirect-target-alt-anchor (field-spec #f "alt-anchor"))
(define redirect-target-element-box (class-box redirect-target-element-name
(list redirect-target-alt-path redirect-target-alt-anchor)
#f))
(define toc-target-element-name (class-name "toc-target-\nelement"))
(define toc-target-element-box (class-box toc-target-element-name (list) #f))
(define page-target-element-name (class-name "page-target-\nelement"))
(define page-target-element-box (class-box page-target-element-name (list) #f))
(define part-relative-element-name (class-name "part-relative-\nelement"))
(define part-relative-element-resolve (field-spec #f "resolve"))
(define part-relative-element-box (class-box part-relative-element-name (list part-relative-element-resolve) #f))
(define block-hierarchy (define block-hierarchy
(hierarchy (hierarchy
@ -151,73 +173,87 @@
delayed-block-box delayed-block-box
traverse-block-box))) traverse-block-box)))
(define target-element-parent-link (blank)) (define target-element-hierarchy
(define render-element-parent-link (blank)) (hierarchy
(define delayed-element-parent-link (blank)) (vc-append target-element-box
(define part-relative-element-parent-link (blank)) (blank 0 50)
(define traverse-element-parent-link (blank)) (ht-append 20
toc-target-element-box
page-target-element-box
redirect-target-element-box))
(list target-element-box)
(list toc-target-element-box
page-target-element-box
redirect-target-element-box)))
(define element-hierarchy (define element-hierarchy
(hierarchy (hierarchy
(vc-append element-box (vc-append element-box
(blank 0 50) (blank 0 50)
(ht-append 20 (inset (ht-append 20
(hc-append collect-element-box (blank 30 0)) collect-element-box
(vc-append (blank 0 10) multi-arg-element-box) multi-arg-element-box
(vc-append (blank 0 20) index-element-box) (refocus target-element-hierarchy target-element-box)
(vc-append (blank 0 10) image-element-box) link-element-box
link-element-box) image-element-box
(blank 0 20) index-element-box)
(ht-append 10 0 0 -400 0))
(rt-superimpose target-element-box
(ht-append target-element-parent-link
(blank 8 0)))
(lt-superimpose render-element-box
(ht-append (blank 8 0)
render-element-parent-link))
(blank 250 0))
(ht-append 10
(blank 130 0)
(vc-append (blank 0 60)
(rt-superimpose delayed-element-box
(ht-append delayed-element-parent-link
(blank 15 0))))
(vc-append (blank 0 30)
(ct-superimpose part-relative-element-box
(ht-append (blank 20 0)
part-relative-element-parent-link)))
(ct-superimpose traverse-element-box
(ht-append traverse-element-parent-link
(blank 30 0)))))
(list element-box) (list element-box)
(list collect-element-box (list collect-element-box
index-element-box index-element-box
image-element-box image-element-box
target-element-parent-link target-element-box
multi-arg-element-box multi-arg-element-box
link-element-box link-element-box
delayed-element-parent-link )))
traverse-element-parent-link
part-relative-element-parent-link (define render-element-parent-link (blank))
render-element-parent-link (define delayed-element-parent-link (blank))
link-element-box))) (define part-relative-element-parent-link (blank))
(define traverse-element-parent-link (blank))
(define element-parent-link (blank))
(define (drop-and-link box parent-link i)
(vc-append
(blank 0 (+ 40 (* i 20)))
(refocus (ct-superimpose box parent-link)
parent-link)))
(define content-hierarchy (define content-hierarchy
(hierarchy (hierarchy
(vc-append content-box (vc-append content-box
(blank 0 50) (blank 0 50)
(ht-append (ht-append 20 (ht-append 15
string-box (drop-and-link (refocus element-hierarchy element-box)
symbol-box) element-parent-link
(inset element-hierarchy -130 0) 4)
(ht-append 20 convertible-box
pict-box (drop-and-link render-element-box
list-box))) render-element-parent-link
4)
pict-box
(drop-and-link delayed-element-box
delayed-element-parent-link
3)
symbol-box
(drop-and-link part-relative-element-box
part-relative-element-parent-link
1)
string-box
(drop-and-link traverse-element-box
traverse-element-parent-link
0)
list-box))
(list content-box) (list content-box)
(list string-box (list element-box
string-box
symbol-box symbol-box
convertible-box
pict-box pict-box
element-box traverse-element-parent-link
part-relative-element-parent-link
delayed-element-parent-link
render-element-parent-link
list-box))) list-box)))
(define raw (define raw
@ -232,44 +268,31 @@
right-right-reference right-right-reference
(double (double
left-left-reference left-left-reference
(double (triple
left-left-reference right-right-reference
(double (triple
left-left-reference right-right-reference
(double (double
right-right-reference left-left-reference
(double (double
left-left-reference left-left-reference
(double (double
left-left-reference right-right-reference
(triple (double
right-right-reference left-left-reference
(triple (double
right-right-reference left-left-reference
(double (left-left-reference
left-left-reference raw
(double element-box element-content content-box content-name 1 #:dot-delta -1)
left-left-reference part-box part-title-field content-box content-name 21)
(double part-box part-blocks-field block-box block-name)
right-right-reference part-box part-subparts-field part-box part-name 2)
(double para-box para-content content-box content-name 2)
left-left-reference compound-para-box compound-para-blocks block-box block-name 3)
(double table-box table-cells block-box block-name 2)
left-left-reference itemization-box itemization-items block-box block-name 10)
raw nested-flow-box nested-flow-blocks block-box block-name 1)
part-box part-title-field content-box content-name 21)
part-box part-blocks-field block-box block-name)
part-box part-subparts-field part-box part-name 2)
para-box para-content content-box content-name 2)
compound-para-box compound-para-blocks block-box block-name 3)
table-box table-cells block-box block-name 2)
itemization-box itemization-items block-box block-name 10)
nested-flow-box nested-flow-blocks block-box block-name 1)
target-element-box target-content content-box content-name 8)
link-element-box link-content content-box content-name)
multi-arg-element-box multi-arg-element-content content-box content-name 14)
index-element-box index-element-content content-box content-name 26)
collect-element-box collect-content content-box content-name 1)
list-box list-box content-box content-name)) list-box list-box content-box content-name))
(define w/delayed-connections (define w/delayed-connections
@ -280,12 +303,12 @@
(dotted-right-right-reference (dotted-right-right-reference
(dotted-right-right-reference (dotted-right-right-reference
w/connections w/connections
render-element-box render-content content-box content-name 31) render-element-box render-element-content content-box content-name 30)
traverse-block-box traverse-block-block block-box block-name 1) traverse-block-box traverse-block-block block-box block-name 1)
delayed-block-box delayed-block-block block-box block-name 17) delayed-block-box delayed-block-block block-box block-name 17)
traverse-element-box traverse-content content-box content-name 5) traverse-element-box traverse-element-content content-box content-name 3)
delayed-element-box delayed-content content-box content-name 27) delayed-element-box delayed-element-content content-box content-name 22)
part-relative-element-box part-relative-element-resolve content-box content-name 14)) part-relative-element-box part-relative-element-resolve content-box content-name 12))
;; one extra pixel on the right so we get the ;; one extra pixel on the right so we get the
;; line drawn to the outermost turning point ;; line drawn to the outermost turning point
@ -331,7 +354,7 @@
(λ (dc dx dy) (λ (dc dx dy)
(let ([pen (send dc get-pen)]) (let ([pen (send dc get-pen)])
(send dc set-pen (send dc set-pen
(send pen get-color) type-link-color ;(send pen get-color)
(if (is-a? dc post-script-dc%) (if (is-a? dc post-script-dc%)
4 4
2) 2)
@ -350,7 +373,7 @@
(let-values ([(x y) (cc-find pict dot2)]) (let-values ([(x y) (cc-find pict dot2)])
(values (+ x 2) y))) (values (+ x 2) y)))
dot2 cc-find dot2 cc-find
#f #f #f #f) #:color type-link-color)
base))) base)))
(define (dotted-right-right-reference p0 a b c d [count 1]) (define (dotted-right-right-reference p0 a b c d [count 1])
@ -358,7 +381,13 @@
(module+ slideshow (module+ slideshow
(require slideshow) (require slideshow)
(define p (mk-diagram)) (define p (inset (mk-diagram) 0 0 0 1))
(slide (scale p (define c (blank client-w client-h))
(min (/ client-w (pict-width p)) (slide (lt-superimpose (t "top") (clip (refocus (ct-superimpose p c) c))))
(/ client-h (pict-height p)))))) (slide (lt-superimpose (t "bottom") (clip (refocus (cb-superimpose p c) c))))
(slide (lt-superimpose (t "all")
(ct-superimpose
c
(scale p
(min (/ client-w (pict-width p))
(/ client-h (pict-height p))))))))