undisturbed

main
Matthew Butterick 4 years ago
parent cd888b53f7
commit ec858a57f7

@ -26,7 +26,7 @@
(define debug-column-gap (make-parameter 36)))]
[else
'(begin
(define draw-debug? (make-parameter #true))
(define draw-debug? (make-parameter #false))
(define draw-debug-line? (make-parameter #true))
(define draw-debug-block? (make-parameter #true))
(define draw-debug-string? (make-parameter #true))

@ -1,6 +1,12 @@
#lang debug racket
(provide (all-defined-out))
(define current-doc (make-parameter #false))
(define current-section (make-parameter #false))
(define current-page (make-parameter #false))
(define current-column (make-parameter #false))
(define current-block (make-parameter #false))
(define current-line (make-parameter #false))
(define current-pdf (make-parameter #false))
(define current-line-wrap (make-parameter #f)) ; because kp is slow and maybe we want to disable for "draft" mode
(define section-pages-used (make-parameter 0))

@ -1,27 +1,43 @@
#lang debug racket
(require quad/base "struct.rkt")
(require quad/base "struct.rkt" "param.rkt")
(provide (all-defined-out))
(define (make-linear-index q)
(cons q (append* (for/list ([elem (in-list (quad-elems q))]
#:when (quad? elem))
(make-linear-index elem)))))
#:when (quad? elem))
(make-linear-index elem)))))
(define (string->pred str)
(define (string->key str #:this [this? #false])
(match str
["doc" doc-quad?]
[(or "section" "sec" "s") section-quad?]
[(or "page" "pg" "p") page-quad?]
[(or "column" "col" "c") column-quad?]
[(or "block" "b") block-quad?]
[(or "line" "ln" "l") line-quad?]))
["doc" 'doc]
[(or "section" "sec" "s") 'section]
[(or "page" "pg" "p") 'page]
[(or "column" "col" "c") 'column]
[(or "block" "b") 'block]
[(or "line" "ln" "l") 'line]))
(define preds (hasheq 'doc doc-quad?
'section section-quad?
'page page-quad?
'column column-quad?
'block block-quad?
'line line-quad?))
(define quad-params (hasheq 'doc current-doc
'section current-section
'page current-page
'column current-column
'block current-block
'line current-line))
(define (parse-query str)
(for/list ([piece (in-list (string-split str ":"))])
(match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
[#false (cons (string->pred piece) #false)]
[(list all name arg) (cons (string->pred name) (or (string->number arg)
(string->symbol arg)))])))
(match (regexp-match #px"^(.*)\\[(.*?)\\]$" piece)
[#false (cons (string->key piece) #false)]
[(list _ name "this") (cons (let ([quad-param-val ((hash-ref quad-params (string->key name)))])
(λ (q) (eq? q quad-param-val))) 1)]
[(list _ name arg) (cons (hash-ref preds (string->key name)) (or (string->number arg)
(string->symbol arg)))])))
(define (query quad-or-index query-str)
(for/fold ([qs (match quad-or-index
@ -45,12 +61,12 @@
(define-syntax-rule (factory type proc)
(make-quad #:type type
#:elems (for/list ([i (in-range 3)])
(set! counter (add1 counter))
(define new-q (proc))
(quad-update! new-q
[tag (format "~a[~a]-~a" 'proc counter (gensym))])
(hash-set! (quad-attrs new-q) 'count counter)
new-q)))
(set! counter (add1 counter))
(define new-q (proc))
(quad-update! new-q
[tag (format "~a[~a]-~a" 'proc counter (gensym))])
(hash-set! (quad-attrs new-q) 'count counter)
new-q)))
(define (line) (make-quad #:type line-quad))
(define (block) (factory block-quad line))

@ -403,6 +403,7 @@
(define (resolve-parents doc)
(define (wants-parent? x) (and (quad? x) (quad-ref x :anchor-parent)))
;; extract the quads that want parents
(define parent-wanter-acc null)
(let loop ([x doc])
(match x
@ -413,6 +414,7 @@
(quad-update! x [elems others]))
(map loop others)]
[_ x]))
;; then put them where they want to go
(define linearized-qs (make-linear-index doc))
(for* ([wp (in-list parent-wanter-acc)]
[query-str (in-value (quad-ref wp :anchor-parent))]

Loading…
Cancel
Save