remove casts

main
Matthew Butterick 10 years ago
parent ec319b8ecf
commit ec92c53db7

@ -27,7 +27,8 @@
(Any . -> . Boolean)
(cond
[(string? x) (or (visible-breakable? x) (invisible-breakable? x))]
[(word? x) (breakable? (word-string (cast x Quad)))]
;; word? should have a filter that returns a Quad type, then the Quad? check will be unnecessary
[(and (Quad? x) (word? x)) (breakable? (word-string x))]
[else #f]))
;; used by insert-spacers to determine which characters
@ -124,8 +125,8 @@
(define/typed (ascent q)
(Quad . -> . Float)
(define ascent-value-or-false (quad-attr-ref q world:ascent-key #f))
(if ascent-value-or-false
(cast ascent-value-or-false Float)
(if (and ascent-value-or-false (flonum? ascent-value-or-false))
ascent-value-or-false
(cond
[(ormap (λ([pred : (Any . -> . Boolean)]) (pred q)) (list char? run? word? word-break?))
(apply measure-ascent (word-string q) (font-attributes-with-defaults q))]
@ -296,13 +297,16 @@
;; handle optical kerns here to avoid resplitting and rejoining later.
(define rendered-pieces (render-pieces ps))
(define split-pieces (map quad-list rendered-pieces))
(define line-quads (cast (append* split-pieces) (Listof Quad)))
(define line-quads (let ([result (append* split-pieces)])
(if (andmap Quad? result)
result
(error 'line-quads "bad result"))))
(define line-quads-maybe-with-opticals
(if world:use-optical-kerns?
(render-optical-kerns
(let ([my-ok (list (optical-kern (quad-attrs (car line-quads))))]) ; take attrs from line, incl measure
(append my-ok line-quads my-ok)))
line-quads))
(if (and world:use-optical-kerns? (> (length line-quads) 0))
(render-optical-kerns
(let ([my-ok (list (optical-kern (quad-attrs (car line-quads))))]) ; take attrs from line, incl measure
(append my-ok line-quads my-ok)))
line-quads))
(define merged-quads (join-quads line-quads-maybe-with-opticals))
(define merged-quad-widths (map measure-quad-proc merged-quads)) ; 10% of function time
@ -312,12 +316,15 @@
(when (not (quad-has-attr? (first line-quads) world:measure-key))
(error 'pieces->line "quad has no measure key: ~a" (first line-quads)))
(define measure (cast (quad-attr-ref (first merged-quads) world:measure-key) Float))
(define looseness (calc-looseness (fl (apply + merged-quad-widths)) measure))
(define measure (let ([val (quad-attr-ref (first merged-quads) world:measure-key)])
(if (flonum? val)
val
(error "got bad value for measure"))))
(define looseness (calc-looseness (foldl fl+ 0.0 merged-quad-widths) measure))
;; quads->line function hoists common attributes into the line
(let* ([new-line-quads (map embed-width merged-quads merged-quad-widths)] ; 15% of time
[new-line-quads (map record-ascent new-line-quads)] ; 35% of time
(let* ([new-line-quads (map embed-width merged-quads merged-quad-widths)]
[new-line-quads (map record-ascent new-line-quads)]
[new-line (quads->line new-line-quads)]
[new-line (quad-attr-set new-line world:line-looseness-key looseness)])
new-line))
@ -356,11 +363,11 @@
qs
((inst map Quad Quad) (λ(q) (quad-attr-set q world:measure-key measure)) qs))])
(log-quad-debug "wrapping on measure = ~a" measure)
(define pieces : (Listof Quad) (make-pieces-proc qs)) ; 5%
(define bps : (Listof Nonnegative-Integer) (find-breakpoints-proc (list->vector pieces) measure)) ; 50%
(define broken-pieces : (Listof (Listof Quad)) (break-at pieces bps)) ; 5%
(define pieces : (Listof Quad) (make-pieces-proc qs))
(define bps : (Listof Nonnegative-Integer) (find-breakpoints-proc (list->vector pieces) measure))
(define broken-pieces : (Listof (Listof Quad)) (break-at pieces bps))
#; (define-type Compose-Line-Type ((Listof Quad) (Quad . -> . Float) . -> . Quad))
((inst map Quad (Listof Quad)) (λ(broken-piece) (compose-line-proc broken-piece measure-quad-proc)) broken-pieces)))) ; 50%
(map (λ([broken-piece : (Listof Quad)]) (compose-line-proc broken-piece measure-quad-proc)) broken-pieces)))) ; 80% of runtime
(define width? flonum?)
(define measure? flonum?)

Loading…
Cancel
Save