pause point: resume in main-typed-tests

quad/logger-typed.rkt

@@ -40,7 +40,8 @@
     (log-quad-debug "~a = ~a" 'x x)
     x))
 
-(define-syntax-rule (log-quad-debug* xs)
+(: log-quad-debug* ((Listof String) . -> . Void))
+(define (log-quad-debug* xs)
   (when (equal? (world:logging-level) 'debug)
-    (map (λ(x) (log-quad-debug x)) xs)))
+    ((inst for-each String) (λ(x) (log-quad-debug x)) xs)))
 

quad/main-typed-tests.rkt

@@ -19,4 +19,11 @@
 (check-equal? (average-looseness (list)) 0.0) ; default value for no lines
 (check-equal? (average-looseness (list al-test-line)) 0.0) ; default value for one line
 (check-equal? (average-looseness (list al-test-line al-test-line2)) 42.0) ; last line excluded by default
-(check-equal? (average-looseness (list al-test-line al-test-line2 al-test-line)) 36.0) ; last line excluded by default
+(check-equal? (average-looseness (list al-test-line al-test-line2 al-test-line)) 36.0) ; last line excluded by default
+
+
+(check-equal? (log-debug-lines (list (line (list world:line-looseness-key 42.0) (word #f "bar")))) '("0/1: \"bar\" 42.0"))
+
+
+;; todo next: debug this line
+(block->lines (block #f (word '(measure 50.0) "Meg is an ally.")))

quad/main-typed.rkt

@@ -45,3 +45,51 @@
       0.0
       (let ([lines-to-measure (drop-right lines 1)]) ; exclude last line from looseness calculation
         (round-float (/ (foldl fl+ 0.0 ((inst map Flonum Quad) (λ(line) (cast (quad-attr-ref line world:line-looseness-key 0.0) Flonum)) lines-to-measure)) (- (fl (length lines)) 1.0))))))
+
+
+(provide log-debug-lines)
+(define/typed (log-debug-lines lines)
+  ((Listof Quad) . -> . (Listof String)) 
+  (log-quad-debug "line report:")
+  (for/list : (Listof String) ([(line idx) (in-indexed lines)])
+    (format "~a/~a: ~v ~a" idx
+            (length lines) 
+            (quad->string line)
+            (quad-attr-ref line world:line-looseness-key))))
+
+
+(provide block->lines)
+(define/typed (block->lines b)
+  (Quad . -> . (Listof Quad)) ;; todo: introduce a Quad subtype where quad-list is guaranteed to be all Quads (no strings)
+  (define quality (cast (quad-attr-ref/parameter b world:quality-key) Real))
+  (define/typed (wrap-quads qs)
+    ((Listof Quad) . -> . (Listof Quad))
+    (define wrap-proc (cond
+                        [(>= quality world:max-quality) wrap-best] 
+                        [(<= quality world:draft-quality) wrap-first]
+                        [else wrap-adaptive])) 
+    (wrap-proc qs))
+  (log-quad-debug "wrapping lines")
+  (log-quad-debug "quality = ~a" quality)
+  (log-quad-debug "looseness tolerance = ~a" world:line-looseness-tolerance)
+  (define wrapped-lines-without-hyphens (wrap-quads (cast (quad-list b) (Listof Quad)))) ; 100/150
+  (log-quad-debug* (log-debug-lines wrapped-lines-without-hyphens))
+  (define avg-looseness (average-looseness wrapped-lines-without-hyphens))
+  (define gets-hyphenation? (and world:use-hyphenation?
+                                 (fl> avg-looseness world:line-looseness-tolerance)))
+  (log-quad-debug "average looseness = ~a" avg-looseness)
+  (log-quad-debug (if gets-hyphenation? "hyphenating" "no hyphenation needed"))
+  
+  (define wrapped-lines (if gets-hyphenation?
+                            (wrap-quads (split-quad (cast ((if world:allow-hyphenated-last-word-in-paragraph
+                                                         hyphenate-quad
+                                                         hyphenate-quad-except-last-word) (merge-adjacent-within b)) Quad)))
+                            wrapped-lines-without-hyphens))
+  
+  (when gets-hyphenation? (log-quad-debug* (log-debug-lines wrapped-lines)))
+  
+  
+  (log-quad-debug "final looseness = ~a" (average-looseness wrapped-lines))
+  (map insert-spacers-in-line
+       (for/list : (Listof Quad) ([line-idx (in-naturals)][line (in-list wrapped-lines)])
+         (quad-attr-set* line 'line-idx line-idx 'lines (length wrapped-lines)))))

quad/main.rkt

@@ -37,6 +37,8 @@
             (length lines) 
             (quad->string line)
             (quad-attr-ref line world:line-looseness-key))))
+
+
 (require racket/trace)
 (define (block->lines b)
   (define quality (quad-attr-ref/parameter b world:quality-key))

quad/world-typed.rkt

@@ -14,7 +14,7 @@
            (define name-key keyname)
            (define-parameter name-default val)))]))
 
-(define-key-and-parameter measure 'measure 300)
+(define-key-and-parameter measure 'measure 300.0)
 
 
 (define-key-and-parameter font-size 'size 13)

quad/wrap-typed.rkt

@@ -222,6 +222,7 @@
 ;; spacers are used to soak up extra space left over in a line.
 ;; depending on where the spacers are inserted, different formatting effects are achieved.
 ;; e.g., left / right / centered / justified.
+(provide insert-spacers-in-line)
 (define/typed (insert-spacers-in-line line [alignment-override #f])
   ((Quad) ((Option Symbol)) . ->* . Quad)
   ;; important principle: avoid peeking into quad-list to get attributes.