You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/quad/experimental.rkt

61 lines
2.6 KiB
Racket

10 years ago
#lang racket/base
(require racket/list sugar)
(require "samples.rkt" "quads.rkt" "utils.rkt")
(define ti (block '(measure 54 leading 18) "Meg is " (box '(foo 42)) " ally."))
;ti
(define (tokenize-quad0 q)
(define-values (all-tokens last-tidx)
(let loop ([q q][starting-tidx 0])
(for/fold ([token-list empty][tidx starting-tidx])
([item (in-list (quad-list q))])
(cond
[(quad? item)
(define-values (sub-token-list sub-last-tidx) (loop item tidx))
(values (cons sub-token-list token-list) sub-last-tidx)]
[(string? item)
(define atoms (regexp-match* #rx"." item))
(values (cons atoms token-list) (+ tidx (length atoms)))]
[else (values (cons item token-list) (+ tidx 1))]))))
(values (list->vector (flatten (reverse all-tokens))) last-tidx))
(define (tokenize-quad quad-in)
(define-values (all-tokens all-attrs last-tidx)
(let loop ([current-quad quad-in][attr-acc empty][starting-tidx 0])
(cond
[(empty? (quad-list current-quad)) ; no subelements, so treat this quad as single token
(values (quad (quad-name current-quad) #f empty)
(if (quad-attrs current-quad)
(cons (vector (quad-attrs current-quad) starting-tidx (add1 starting-tidx)) attr-acc)
attr-acc)
(add1 starting-tidx))]
[else ; replace quad with its tokens, exploded
(define-values (tokens-from-fold subattrs-from-fold last-tidx-from-fold)
(for/fold ([token-acc empty][subattr-acc empty][tidx starting-tidx])
([item (in-list (quad-list current-quad))])
(cond
[(quad? item)
(define-values (sub-tokens sub-attrs sub-last-tidx) (loop item attr-acc tidx))
(values (cons sub-tokens token-acc) (cons sub-attrs subattr-acc) sub-last-tidx)]
[(string? item)
(define atoms (regexp-match* #rx"." item))
(values (cons atoms token-acc) subattr-acc (+ tidx (length atoms)))]
[else
(values (cons item token-acc) subattr-acc (+ tidx 1))])))
(values tokens-from-fold
(if (quad-attrs current-quad)
(cons (vector (quad-attrs current-quad) starting-tidx last-tidx-from-fold) subattrs-from-fold)
subattrs-from-fold)
last-tidx-from-fold)])))
(values (list->vector (flatten (reverse all-tokens))) (flatten (reverse all-attrs))))
(define-values (tokens attrs) (tokenize-quad (ti2)))
tokens
attrs
(filter (λ(idx) (box? (vector-ref tokens idx))) (range (vector-length tokens)))