sick burns

quad/quad/foo2.rkt

@@ -1,3 +1,3 @@
 #lang quad
 
-Hello @block-break[] world @block-break[] galaxy
+match-select specifies the collected results. The default of car means that the result is the list of matches without returning parenthesized sub-patterns. It can be given as a ‘selector’ function which chooses an item from a list, or it can choose a list of items. For example, you can use cdr to get a list of lists of parenthesized sub-patterns matches, or values (as an identity function) to get the full matches as well. (Note that the selector must choose an element of its input list or a list of elements, but it must not inspect its input as they can be either a list of strings or a list of position pairs. Furthermore, the selector must be consistent in its choice(s).)

quad/quad/lang/buttons.rkt

@@ -27,11 +27,16 @@ http://pkg-build.racket-lang.org/doc/tools/drracket_module-language-tools.html#%
                     (define pdfn (path-replace-suffix fn #".pdf"))
                     (define fn-out (parameterize ([current-namespace (make-base-namespace)])
                                      (namespace-attach-module (namespace-anchor->namespace cache-module-ns) 'quad)
-                                     (dynamic-require fn 'out)))
+                                     (dynamic-require `(submod ,fn outy) 'out)))
                     (when fn-out
                       (define-values (fn-dir name dir?) (split-path fn))
                       (parameterize ([current-directory fn-dir])
-                        (send (new pdf-renderer%) render-to-file (typeset fn-out) pdfn))
+                        (local-require "../render.rkt" racket/class profile sugar/debug quad/logger quad/world)
+                        (activate-logger quad-logger)
+                        (parameterize ([world:quality-default world:max-quality]
+                                       [world:paper-width-default 600]
+                                       [world:paper-height-default 700])
+                          (send (new pdf-renderer%) render-to-file (typeset fn-out) pdfn)))
                       (parameterize ([current-input-port (open-input-string "")])
                         (system (format "open \"~a\"" (path->string pdfn))))))]
         [number 99])

quad/quad/lang/quad.rkt

@@ -9,7 +9,10 @@
     [(_ expr ...)
      (replace-context #'(expr ...)
                       #'(#%module-begin
-                         
-                         (define out (block '(measure 200.0 font "Times New Roman" leading 16.0 vmeasure 300.0 size 13.5) expr ...))
-                           (provide out)))]))
-
+                         (module outy racket/base
+                           (require quad/quads)
+                           (define out (block '(font "Times New Roman" measure 360.0 leading 14.0 column-count 1 column-gutter 10.0 size 11.5 x-align justify x-align-last-line left) expr ...))
+                           (provide out))
+                         (require 'outy)
+                         (provide (all-from-out 'outy))
+                         (displayln out)))]))

quad/quad/lang/zam.rkt

@@ -0,0 +1 @@
+#lang racket

quad/quad/main.rkt

@@ -2,12 +2,12 @@
 (require racket/list sugar racket/contract racket/function math/flonum)
 (require "quads.rkt" "utils.rkt" "wrap.rkt" "measure.rkt" "world.rkt" "logger.rkt")
 (provide typeset)
-
+(require sugar/debug)
 (define (input->nested-blocks i)
   (define-syntax-rule (cons-reverse x y) (cons (reverse x) y))
   (define-values (mps mcs bs b)
     (for/fold ([multipages empty][multicolumns empty][blocks empty][block-acc empty])
-              ([q (in-list (split-quad i))])
+              ([q (in-list (report (split-quad i)))])
       (cond
         [(page-break? q) (values (cons-reverse (cons-reverse (cons-reverse block-acc blocks) multicolumns) multipages) empty empty empty)]
         [(column-break? q) (values multipages (cons-reverse (cons-reverse block-acc blocks) multicolumns) empty empty)]
@@ -33,10 +33,10 @@
 (define (log-debug-lines lines)
   (log-quad-debug "line report:")
   (for/list ([(line idx) (in-indexed lines)])
-    (format "~a/~a: ~v ~a" idx
-            (length lines) 
-            (quad->string line)
-            (quad-attr-ref line world:line-looseness-key))))
+            (format "~a/~a: ~v ~a" idx
+                    (length lines) 
+                    (quad->string line)
+                    (quad-attr-ref line world:line-looseness-key))))
 
 
 (require racket/trace)
@@ -71,13 +71,13 @@
   (log-quad-debug "final looseness = ~a" (average-looseness wrapped-lines))
   (map insert-spacers-in-line
        (for/list ([line-idx (in-naturals)][line (in-list wrapped-lines)])
-         (quad-attr-set* line 'line-idx line-idx 'lines (length wrapped-lines)))))
+                 (quad-attr-set* line 'line-idx line-idx 'lines (length wrapped-lines)))))
 
 
 (define+provide (number-pages ps)
   (pages? . -> . pages?)
   (for/list ([i (in-naturals)][p (in-list ps)])
-    (quad (quad-name p) (merge-attrs (quad-attrs p) `(page ,i)) (quad-list p))))
+            (quad (quad-name p) (merge-attrs (quad-attrs p) `(page ,i)) (quad-list p))))
 
 (define+provide (pages->doc ps)
   (pages? . -> . doc?)  
@@ -172,10 +172,10 @@
   (define result-pages
     (map (λ(cols) (quads->page cols)) 
          (for/list ([page-cols (in-list (slice-at cols columns-per-page))])
-           (define-values (last-x cols)
-             (for/fold ([current-x (/ (- (world:paper-width-default) width-of-printed-area) 2)][cols empty]) ([col (in-list page-cols)][idx (in-naturals)])
-               (values (+ current-x column-width column-gutter) (cons (quad-attr-set* col 'x current-x 'y 40 world:column-index-key idx) cols))))
-           (reverse cols))))
+                   (define-values (last-x cols)
+                     (for/fold ([current-x (/ (- (world:paper-width-default) width-of-printed-area) 2)][cols empty]) ([col (in-list page-cols)][idx (in-naturals)])
+                       (values (+ current-x column-width column-gutter) (cons (quad-attr-set* col 'x current-x 'y 40 world:column-index-key idx) cols))))
+                   (reverse cols))))
   result-pages)
 
 (define current-eof (make-parameter (gensym)))
@@ -190,21 +190,24 @@
   (coerce/input? . -> . doc?)  
   (load-text-cache-file)
   (define pages (append* (for/list ([multipage (in-list (input->nested-blocks x))])
-                           (columns->pages (append* (for/list ([multicolumn (in-list multipage)])
-                                                      (lines->columns (append* (for/list ([block-quads (in-list multicolumn)])
-                                                                                 (block-quads->lines block-quads))))))))))
+                                   (columns->pages (append* (for/list ([multicolumn (in-list multipage)])
+                                                                      (lines->columns (append* (for/list ([block-quads (in-list multicolumn)])
+                                                                                                         (block-quads->lines block-quads))))))))))
   (define doc (pages->doc pages))
   (update-text-cache-file)
   doc)
 
 
-#;(module+ main
+(module+ main
   (require "render.rkt" racket/class profile sugar/debug)
   (require "samples.rkt")
   (activate-logger quad-logger)
   (parameterize ([world:quality-default world:draft-quality]
                  [world:paper-width-default 600]
                  [world:paper-height-default 700])
-    (define sample (jude0))
-    (define to (begin (time (typeset sample))))
-    (time (send (new pdf-renderer%) render-to-file to "foo.pdf"))))
+    #;(define sample (block '(measure 54.0 leading 18.0) "\n" "\n" "Meg is an ally."))
+    (let ([toa (begin (time (typeset (dynamic-require "foo2.rkt" 'out))))]
+          [tob (typeset (block '(measure 54.0 leading 18.0) "Meg \nis an ally."))])
+      (report* toa tob (equal? toa tob))
+      (time (send (new pdf-renderer%) render-to-file toa "foo-a.pdf"))
+      (time (send (new pdf-renderer%) render-to-file tob "foo-b.pdf")))))

quad/quad/render.rkt

@@ -49,6 +49,7 @@
 (define-syntax-rule (map/send method xs)
   (map (λ(x) (method x)) xs))
 
+
 (define pdf-renderer%
   (class abstract-renderer%
     (super-new)
@@ -70,7 +71,7 @@
     
     (define/caching (make-font/caching font size style weight)
       (make-font #:face font #:size size #:style style #:weight weight))
-    
+
     (define/override-final (render-word w)
       (define word-font (quad-attr-ref/parameter w world:font-name-key))
       (define word-size (quad-attr-ref/parameter w world:font-size-key))

quad/quad/utils.rkt

@@ -78,7 +78,6 @@
 ;; pushes attributes down from parent quads to children, 
 ;; resulting in a flat list of quads.
 (provide flatten-quad)
-(require sugar/debug)
 (define (flatten-quad q)
   ;  (quad? . -> . quads?)
   (flatten
@@ -93,9 +92,10 @@
               (map (λ(xi) (loop xi x-with-parent-attrs)) (quad-list x))))] ; replace quad with its elements
        [(string? x) (quad (quad-name parent) (quad-attrs parent) (list x))]))))
 
+(require sugar/debug)
 ;; flatten quad as above, 
 ;; then dissolve it into individual character quads while copying attributes
-;; input is often large, so macro allows us to avoid allocation
+
 (define+provide (split-quad q)
   ;(quad? . -> . quads?)
   (letrec ([do-explode (λ(x [parent #f])
@@ -104,7 +104,8 @@
                             (if (empty? (quad-list x))
                                 x ; no subelements, so stop here
                                 (map (λ(xi) (do-explode xi x)) (quad-list x)))] ; replace quad with its elements, exploded
-                           [else (map (λ(xc) (quad 'word (quad-attrs parent) (list xc))) (regexp-match* #px"." x))]))])
+                           ;; todo: figure out why newlines foul up the input stream. Does it suffice to ignore them? 
+                           [else (map (λ(xc) (quad 'word (quad-attrs parent) (list xc))) (report (regexp-match* #px"[^\r\n]" x)))]))])
     (flatten (map do-explode (flatten-quad q)))))