speedy

quad/experimental.rkt

@@ -3,58 +3,56 @@
 (require "samples.rkt" "quads.rkt" "utils.rkt")
 
 (define ti (block '(measure 54 leading 18) "Meg is " (box '(foo 42)) " ally."))
+(define tib (block '(measure 240 font "Equity Text B" leading 16 size 13.5 x-align justify x-align-last-line left)  (block #f (block '(weight bold font "Equity Caps B") "Hello") (block-break) (box '(width 15)))))
 
 ;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)
+  (define-values (all-tokens all-attrs _)
     (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))]
+        [(empty? (quad-list current-quad)); no subelements, so treat this quad as single token
+         (let ([current-quad-attrs (quad-attrs current-quad)]
+               [ending-tidx (add1 starting-tidx)])
+           (values (quad (quad-name current-quad) #f empty)
+                   (if current-quad-attrs
+                       (cons (vector current-quad-attrs starting-tidx ending-tidx) attr-acc)
+                       attr-acc)
+                   ending-tidx))]
         [else ; replace quad with its tokens, exploded
-         (define-values (tokens-from-fold subattrs-from-fold last-tidx-from-fold)
+         (define-values (tokens-from-fold subattrs-from-fold ending-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))])))
+               [else ; item is a string of length > 0 (quad contract guarantees this)
+                (define-values (exploded-chars last-idx-of-exploded-chars)
+                  (for/fold ([chars empty][last-idx #f])([(c i) (in-indexed item)])
+                    (values (cons c chars) i))) ; fold manually to get reversed items & length at same time
+                (values (cons exploded-chars token-acc) subattr-acc (+ tidx (add1 last-idx-of-exploded-chars)))])))
          (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))))
+                 (let ([current-quad-attrs (quad-attrs current-quad)])
+                   (if current-quad-attrs
+                       (cons (vector current-quad-attrs starting-tidx ending-tidx-from-fold) subattrs-from-fold)
+                       subattrs-from-fold))
+                 ending-tidx-from-fold)])))
+  (values (list->vector (reverse (flatten all-tokens))) (flatten all-attrs)))
+
+
+(define-values (tokens attrs) (time (tokenize-quad (ti5))))
+(define current-tokens (make-parameter tokens))
+(define current-token-attrs (make-parameter attrs))
+
+;(filter (λ(idx) (box? (vector-ref tokens idx))) (range (vector-length tokens)))
+
+(define (attr-ref-hash a) (vector-ref a 0))
+(define (attr-ref-start a) (vector-ref a 1))
+(define (attr-ref-end a) (vector-ref a 2))
 
+(define (calc-attrs tref)
+  (map attr-ref-hash (filter (λ(attr) (<= (attr-ref-start attr) tref (sub1 (attr-ref-end attr)))) (current-token-attrs))))
 
-(define-values (tokens attrs) (tokenize-quad (ti2)))
-tokens
-attrs
-(filter (λ(idx) (box? (vector-ref tokens idx))) (range (vector-length tokens)))
+(vector-ref tokens 4)
+(time (calc-attrs 4))

quad/quads.rkt

@@ -55,7 +55,7 @@
 (define (quad-name? x) (symbol? x))
 (define (hashable-list? x) (and (list? x) (even? (length x))))
 (define (quad-attrs? x) (or (false? x) (hash? x)))
-(define (quad-list? x) (and (list? x) (andmap (λ(xi) (or (quad? xi) (string? xi))) x)))
+(define (quad-list? x) (and (list? x) (andmap (λ(xi) (or (quad? xi) (and (string? xi) (< 0 (string-length xi))))) x)))
 (define (quads? x) (and (list? x) (andmap quad? x)))
 (define (lists-of-quads? x) (and (list? x) (andmap quads? x)))
 

quad/samples.rkt

@@ -10,7 +10,7 @@
 (define (ti4) (block '(measure 300 x-align justify x-align-last-line right leading 18) "In this Madagascarian hoo-ha, Racket isn’t exactly a language at all"))
 
 
-(define (ti5) (block '(measure 240 font "Equity Text B" leading 16 size 13.5 x-align justify x-align-last-line left) (box '(width 15)) (block #f (block '(weight bold font "Equity Caps B") "Hotdogs, My Fellow Americans.") " This " (block '(no-break #t) "is some truly") " bullshit generated from my typesetting system, which is called Quad. I’m writing this in a source file in DrRacket. When I click [Run], a PDF pops out. Not bad\u200a—\u200aand no LaTeX needed. Quad, however, does use the fancy linebreaking algorithm developed for TeX. (It also includes a faster linebreaking algorithm for when speed is more important than quality.) Of course, it can also handle " (block '(font "Triplicate C4") "different fonts,") (block '(style italic) " styles, ") (word '(size 14 weight bold) "and sizes-") " within the same line. As you can see, it can also justify paragraphs." (block-break) (box '(width 15)) (block #f "“Each horizontal row represents an OS-level thread, and the colored dots represent important events in the execution of the program (they are color-coded to distinguish one event type from another). The upper-left blue dot in the timeline represents the future’s creation. The future executes for a brief period (represented by a green bar in the second line) on thread 1, and then pauses to allow the runtime thread to perform a future-unsafe operation.") (block-break)  (box '(width 15))(block #f "In the Racket implementation, future-unsafe operations fall into one of two categories. A blocking operation halts the evaluation of the future, and will not allow it to continue until it is touched. After the operation completes within touch, the remainder of the future’s work will be evaluated sequentially by the runtime thread. A synchronized operation also halts the future, but the runtime thread may perform the operation at any time and, once completed, the future may continue running in parallel. Memory allocation and JIT compilation are two common examples of synchronized operations."))))
+(define (ti5) (block '(measure 240 font "Equity Text B" leading 16 size 13.5 x-align justify x-align-last-line left) (box '(width 15)) (block #f (block '(weight bold font "Equity Caps B") "Hot" (word '(size 22) "Z") "ogs, My Fellow Americans.") " This " (block '(no-break #t) "is some truly") " bullshit generated from my typesetting system, which is called Quad. I’m writing this in a source file in DrRacket. When I click [Run], a PDF pops out. Not bad\u200a—\u200aand no LaTeX needed. Quad, however, does use the fancy linebreaking algorithm developed for TeX. (It also includes a faster linebreaking algorithm for when speed is more important than quality.) Of course, it can also handle " (block '(font "Triplicate C4") "different fonts,") (block '(style italic) " styles, ") (word '(size 14 weight bold) "and sizes-") " within the same line. As you can see, it can also justify paragraphs." (block-break) (box '(width 15)) (block #f "“Each horizontal row represents an OS-level thread, and the colored dots represent important events in the execution of the program (they are color-coded to distinguish one event type from another). The upper-left blue dot in the timeline represents the future’s creation. The future executes for a brief period (represented by a green bar in the second line) on thread 1, and then pauses to allow the runtime thread to perform a future-unsafe operation.") (block-break)  (box '(width 15))(block #f "In the Racket implementation, future-unsafe operations fall into one of two categories. A blocking operation halts the evaluation of the future, and will not allow it to continue until it is touched. After the operation completes within touch, the remainder of the future’s work will be evaluated sequentially by the runtime thread. A synchronized operation also halts the future, but the runtime thread may perform the operation at any time and, once completed, the future may continue running in parallel. Memory allocation and JIT compilation are two common examples of synchronized operations."))))
 
 (define (ti6) (block '(font "Equity Text B" measure 210 leading 14 size 20 x-align justify x-align-last-line left)
                    "Firstlinerhere" (column-break) "Secondlinerhere" (column-break) "Thirdlinerhere"))
@@ -22,7 +22,7 @@
                               (string-join (take lines (min line-limit (length lines))) "\n"))
                             (file->string jude-text)))
   (define jude-blocks (map (λ(s) (regexp-replace* #rx"\n" s " ")) (string-split sample-string "\n\n")))
-  (apply block '(font "Equity Text B" measure 360 leading 14 column-count 1 column-gutter 10 size 11.5 x-align justify x-align-last-line left) (add-between (map (λ(jb) (block #f (box '(width 10)) (optical-kern) jb)) jude-blocks) (block-break))))
+  (apply block '(font "Equity Text B" measure 360 leading 14 column-count 1 column-gutter 10 size 11.5 x-align justify x-align-last-line left) (add-between (map (λ(jb) (block #f (box '(width 10)) (optical-kern) jb)) (filter (λ(jb) (< 0 (string-length jb))) jude-blocks)) (block-break))))
 
 (define (jude) (make-sample "texts/jude.txt"))
 (define (jude0) (make-sample "texts/jude0.txt"))