diff --git a/quad/main.rkt b/quad/main.rkt index d3d09084..42969916 100644 --- a/quad/main.rkt +++ b/quad/main.rkt @@ -194,7 +194,7 @@ (coerce/input? . -> . doc?) (cond [(input? x) (load-text-cache-file) - (define multipages (input->multipages x)) ; 125 = timings for jude0 + (define multipages (time (input->multipages x))) ; 125 = timings for jude0 (define pages (append-map typeset multipages)) ; 1446 (define doc (typeset pages)) ; 250 (update-text-cache-file) diff --git a/quad/measure.rkt b/quad/measure.rkt index d9889d01..0a65b0fe 100644 --- a/quad/measure.rkt +++ b/quad/measure.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require math/flonum racket/draw racket/class racket/contract sugar/debug sugar/list racket/list sugar/cache racket/serialize racket/file) +(require math/flonum racket/draw racket/class sugar/debug sugar/list racket/list sugar/cache racket/serialize racket/file) (provide measure-text measure-ascent round-float update-text-cache-file load-text-cache-file) (define precision 4.0) @@ -10,7 +10,7 @@ (define dc (new record-dc%)) -(define max-size 1000.0) +(define max-size 1024) ; use fixnum to trigger faster bitshift division (define/caching (make-font/caching font weight style) (make-font #:size max-size #:style style #:weight weight #:face font)) @@ -26,8 +26,8 @@ (define (load-text-cache-file) (define cache-file-path (get-cache-file-path)) (current-text-cache (if (file-exists? cache-file-path) - (deserialize (file->value cache-file-path)) - (make-hash)))) + (deserialize (file->value cache-file-path)) + (make-hash)))) (define current-text-cache (make-parameter (make-hash))) (define current-text-cache-changed? (make-parameter #f)) @@ -36,32 +36,32 @@ (define/caching (measure-max-size text font [weight 'normal] [style 'normal]) ;((string? string?) (symbol? symbol?) . ->* . number?) (define font-instance (hash-ref! (current-font-cache) (list font weight style) (λ() (make-font #:size max-size #:style style #:weight weight #:face font)))) - ;; combine boolean only makes a difference for two or more chars + ;; 'combine' boolean only makes a difference for two or more chars (hash-ref! (current-text-cache) (list text font weight style) (λ() (current-text-cache-changed? #t) (values->list (send dc get-text-extent text font-instance (>= (string-length text) 1)))))) -(define (width x) (first x)) -(define (height x) (second x)) -(define (descent x) (third x)) -(define (extra x) (fourth x)) +(define-syntax-rule (width x) (first x)) +(define-syntax-rule (height x) (second x)) +(define-syntax-rule (descent x) (third x)) +(define-syntax-rule (extra x) (fourth x)) -(define (measure-text-max-size text font [weight 'normal] [style 'normal]) +(define-syntax-rule (measure-text-max-size text font weight style) (width (measure-max-size text font weight style))) -(define/contract (measure-text text size font [weight 'normal] [style 'normal]) - ((string? flonum? string?) (symbol? symbol?) . ->* . flonum?) +(define (measure-text text size font [weight 'normal] [style 'normal]) + ; ((string? flonum? string?) (symbol? symbol?) . ->* . flonum?) ;; Native function only accepts integers, so get max-size and scale down to size needed. (define raw-measure (measure-text-max-size text font weight style)) - (round-float (fl/ (fl* (fl raw-measure) size) max-size))) + (round-float (/ (* (exact->inexact raw-measure) (exact->inexact size)) max-size))) -(define (measure-ascent-max-size text font [weight 'normal] [style 'normal]) - (define result-list (measure-max-size text font weight style)) - (- (height result-list) (descent result-list))) +(define-syntax-rule (measure-ascent-max-size text font weight style) + (let ([result-list (measure-max-size text font weight style)]) + (- (height result-list) (descent result-list)))) -(define/contract (measure-ascent text size font [weight 'normal] [style 'normal]) - ((string? flonum? string?) (symbol? symbol?) . ->* . flonum?) +(define (measure-ascent text size font [weight 'normal] [style 'normal]) + ; ((string? flonum? string?) (symbol? symbol?) . ->* . flonum?) ;; Native function only accepts integers, so get max-size and scale down to size needed. (define raw-baseline-distance (measure-ascent-max-size text font weight style)) - (round-float (fl/ (fl* (fl raw-baseline-distance) size) max-size))) + (round-float (/ (* (exact->inexact raw-baseline-distance) (exact->inexact size)) max-size))) diff --git a/quad/utils.rkt b/quad/utils.rkt index d481ca84..509259dc 100644 --- a/quad/utils.rkt +++ b/quad/utils.rkt @@ -96,8 +96,7 @@ ;; 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 -(provide split-quad) -(define-syntax-rule (split-quad q) +(define+provide (split-quad q) ;(quad? . -> . quads?) (letrec ([do-explode (λ(x [parent #f]) (cond @@ -105,9 +104,11 @@ (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 - [(string? x) (map (λ(xc) (quad 'word (quad-attrs parent) (list xc))) (regexp-match* #px"." x))]))]) + [else (map (λ(xc) (quad 'word (quad-attrs parent) (list xc))) (regexp-match* #px"." x))]))]) (flatten (map do-explode (flatten-quad q))))) + + ;; merge chars into words (and boxes), leave the rest ;; if two quads are mergeable types, and have the same attributes, ;; they get merged. diff --git a/quad/world.rkt b/quad/world.rkt index f9866932..40e09a83 100644 --- a/quad/world.rkt +++ b/quad/world.rkt @@ -94,4 +94,4 @@ (define min-last-lines 2) (define default-lines-per-column 36) -(define-parameter logging-level 'debug) \ No newline at end of file +(define-parameter logging-level 'info) \ No newline at end of file