wrap-typed works

main
Matthew Butterick 10 years ago
parent 70d44ce963
commit 6c5d629a1a

@ -33,7 +33,7 @@
(define-syntax-rule (vector-append-item xs value)
((inst vector-append Any) xs (vector value)))
(define-syntax-rule (vector-append-value xs value)
(define-syntax-rule (vector-append-entry xs value)
((inst vector-append Entry-Type) xs (vector value)))
(define-syntax-rule (vector-append-index xs value)
@ -248,7 +248,7 @@
(for ([col (in-vector cols)])
(cond
[(>= col (vector-length ($ocm-min-entrys ocm)))
(set-$ocm-min-entrys! ocm (vector-append-value ($ocm-min-entrys ocm) (@ (cast (@ minima col) (HashTable Symbol Value-Type)) 'value)))
(set-$ocm-min-entrys! ocm (vector-append-entry ($ocm-min-entrys ocm) (@ (cast (@ minima col) (HashTable Symbol Entry-Type)) 'value)))
(set-$ocm-min-row-indices! ocm (vector-append-index ($ocm-min-row-indices ocm) (@ (cast (@ minima col) (HashTable Symbol Index-Type)) 'row-idx)))]
[(< (($ocm-entry->value ocm) (@ (cast (@ minima col) HashTableTop) 'value)) (($ocm-entry->value ocm) (vector-ref ($ocm-min-entrys ocm) col)))
(set-$ocm-min-entrys! ocm ((inst vector-set Entry-Type) ($ocm-min-entrys ocm) col (cast (@ (cast (@ minima col) HashTableTop) 'value) Value-Type)))

@ -1,7 +1,8 @@
#lang typed/racket/base
(require (for-syntax typed/racket/base racket/syntax racket/string))
(require/typed racket/list [empty? (All (A) ((Listof A) -> Boolean))]
[last ((Listof Any) . -> . Any)])
[last ((Listof Any) . -> . Any)]
[flatten ((Listof Any) . -> . (Listof Any))])
(require/typed sugar/list [trimf (All (A) ((Listof A) (A . -> . Boolean) -> (Listof A)))]
[filter-split (All (A) ((Listof A) (A . -> . Boolean) -> (Listof (Listof A))))])
(require/typed racket/string [string-append* ((Listof String) . -> . String)])
@ -98,7 +99,7 @@
[else ""])))
(provide gather-common-attrs)
(: gather-common-attrs ((Listof Quad) . -> . (U False (Listof QuadAttrPair))))
(: gather-common-attrs ((Listof Quad) . -> . (U False HashableList)))
(define (gather-common-attrs qs)
(: check-cap (QuadAttrPair . -> . Boolean))
(define (check-cap cap)
@ -113,7 +114,8 @@
null)])
(cond
[(null? common-attr-pairs) #f]
[(null? qs) common-attr-pairs]
[(null? qs) (cast (flatten common-attr-pairs) HashableList)] ;; flatten + cast needed because this output gets used by quadattrs
;; todo: reconsider type interface between output of this function and input to quadattrs
[else (loop (cdr qs) (filter check-cap common-attr-pairs))])))
@ -219,6 +221,3 @@
(define-break-type block)
(define-break-type line)
;; todo next: debug this test case
(define qas (quadattrs '(measure 36.0)))
(quads->line (list (word qas "Meg")))

@ -143,7 +143,7 @@
;; only needs it if the appearance of the piece changes based on location.
;; so words are likely to have a word-break item; boxes not.
;; the word break item contains the different characters needed to finish the piece.
(define the-word-break (cast (quad-attr-ref p world:word-break-key #f) Quad))
(define the-word-break (cast (quad-attr-ref p world:word-break-key #f) (Option Quad)))
(let ([p (quad-attr-remove p world:word-break-key)]) ; so it doesn't propagate into subquads
(if the-word-break
(quad (quad-name p) (quad-attrs p)
@ -475,7 +475,7 @@
(define last-piece-to-test (vector-ref pieces (sub1 j)))
(define new-hyphen?
(and (quad-has-attr? last-piece-to-test world:word-break-key)
(equal? (cast (quad-attr-ref (cast (quad-attr-ref last-piece-to-test world:word-break-key) Quad) world:before-break-key) Quad) "-")))
(equal? (cast (quad-attr-ref (cast (quad-attr-ref last-piece-to-test world:word-break-key) Quad) world:before-break-key) String) "-")))
(define cumulative-hyphens (if (not new-hyphen?)
0
(add1 ($penalty-hyphens penalty-up-to-i))))
@ -535,7 +535,7 @@
make-pieces
quad-width
pieces->line
(λ(x y) (adaptive-fit-proc (cast x (Vectorof Quad)) (cast y Flonum) #t #f))))
(λ(x y) (adaptive-fit-proc (cast x (Vectorof Quad)) (cast y Flonum) #f #t))))
(provide wrap-adaptive)
(define wrap-adaptive (make-wrap-proc
@ -587,6 +587,8 @@
;(define eqs (split-quad (block '(x-align center font "Equity Text B" size 10) "Foo-d" (word '(size 13) "og ") "and " (box) " Zu" (word-break '(nb "c" bb "k-")) "kerman's. Instead of a circle, the result is a picture of the code that, if it were used as an expression, would produce a circle. In other words, code is not a function, but instead a new syntactic form for creating pictures; the bit between the opening parenthesis with code is not an expression, but instead manipulated by the code syntactic form. This helps explain what we meant in the previous section when we said that racket provides require and the function-calling syntax. Libraries are not restricted to exporting values, such as functions; they can also define new syntactic forms. In this sense, Racket isnt exactly a language at all; its more of an idea for how to structure a language so that you can extend it or create entirely " (word '(font "Courier" size 5) "lang."))))
(define megs (split-quad (block '(size 10 font "Courier") "Meg is an ally.")))
(activate-logger quad-logger)
(define megs (split-quad (block '(size 15) "Meg is an ally.")))
(wrap-first megs 36.0)
(define measure 40.0)
(map quad->string (wrap-first megs measure))
(map quad->string (wrap-best megs measure))

@ -542,10 +542,12 @@
(module+ main
(define eqs (split-quad (block '(x-align center font "Equity Text B" size 10) "Foo-d" (word '(size 13) "og ") "and " (box) " Zu" (word-break '(nb "c" bb "k-")) "kerman's. Instead of a circle, the result is a picture of the code that, if it were used as an expression, would produce a circle. In other words, code is not a function, but instead a new syntactic form for creating pictures; the bit between the opening parenthesis with code is not an expression, but instead manipulated by the code syntactic form. This helps explain what we meant in the previous section when we said that racket provides require and the function-calling syntax. Libraries are not restricted to exporting values, such as functions; they can also define new syntactic forms. In this sense, Racket isnt exactly a language at all; its more of an idea for how to structure a language so that you can extend it or create entirely " (word '(font "Courier" size 5) "lang."))))
;(define megs (split-quad (block '(size 15) "Meg is an ally.")))
;(activate-logger quad-logger)
; (wrap-first megs 36)
#|
(define megs (split-quad (block '(size 10 font "Courier") "Meg is an ally.")))
(activate-logger quad-logger)
(define measure 40.0)
(map quad->string (wrap-first megs measure))
(map quad->string (wrap-best megs measure))
#|
(define trials 1)
(time-repeat trials (let () (wrap-first megs 36) (void)))
(time-repeat trials (let ([measure 36]) (wrap-best megs measure) (void)))

Loading…
Cancel
Save