From 89c265957ab3e72cdb47fa27543e5c23eb82f2b3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 31 Mar 2015 23:20:42 -0700 Subject: [PATCH] next: import all of csp interface --- quad/main-typed.rkt | 45 ++++++++++++++++++++++---------------------- quad/utils-typed.rkt | 4 +--- 2 files changed, 24 insertions(+), 25 deletions(-) diff --git a/quad/main-typed.rkt b/quad/main-typed.rkt index 2d783160..1c5f87b5 100644 --- a/quad/main-typed.rkt +++ b/quad/main-typed.rkt @@ -56,7 +56,7 @@ (define/typed+provide (block->lines b) (BlockQuad . -> . (Listof LineQuad)) ;; 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 quality (assert (quad-attr-ref/parameter b world:quality-key) Index?)) (define/typed (wrap-quads qs) ((Listof Quad) . -> . (Listof LineQuad)) (define wrap-proc (cond @@ -101,9 +101,9 @@ (define/typed (columns-mapper page-in) (PageQuad . -> . PageQuad) (apply page (quad-attrs page-in) - (for/list : (Listof Quad) ([pq (in-list (quad-list page-in))]) - (add-vert-positions (for/list : (Listof Quad) ([x (in-list (quad-list pq))]) - (compute-line-height (add-horiz-positions (fill (cast x Quad))))))))) + (for/list : (Listof Quad) ([col (in-list (quad-list page-in))]) + (assert col ColumnQuad?) + (apply column (quad-attrs col) (map (λ([ln : Quad]) (assert ln LineQuad?) (compute-line-height (add-horiz-positions (fill ln)))) (quad-list col)))))) (define mapped-pages (map columns-mapper (number-pages ps))) (define doc (quads->doc mapped-pages)) doc) @@ -121,7 +121,7 @@ (define prob (new problem%)) (define max-column-lines world:default-lines-per-column) (define-values (columns ignored-return-value) - (for/fold ([columns : (Listof ColumnQuad) empty][lines-remaining : (Listof Quad) lines]) + (for/fold ([columns : (Listof ColumnQuad) empty][lines-remaining : (Listof LineQuad) lines]) ([col-idx : Nonnegative-Integer (stop-before (in-naturals) (λ(x) (empty? lines-remaining)))]) (log-quad-info "making column ~a" (add1 col-idx)) ;; domain constraint is best way to simplify csp, because it limits the search space. @@ -153,8 +153,8 @@ (define/typed (last-lines-constraint pl) (Index . -> . Boolean) (define last-line-of-page ((inst list-ref Quad) lines-remaining (sub1 pl))) - (define lines-in-this-paragraph (cast (quad-attr-ref last-line-of-page world:total-lines-key) Index)) - (define line-index-of-last-line (cast (quad-attr-ref last-line-of-page world:line-index-key) Index)) + (define lines-in-this-paragraph (assert (quad-attr-ref last-line-of-page world:total-lines-key) Index?)) + (define line-index-of-last-line (assert (quad-attr-ref last-line-of-page world:line-index-key) Index?)) (define (paragraph-too-short-to-meet-constraint?) (< lines-in-this-paragraph world:min-last-lines)) (or (paragraph-too-short-to-meet-constraint?) @@ -167,47 +167,48 @@ (define/typed (first-lines-constraint pl lines-remaining) (Index (Listof Quad) . -> . Boolean) (define last-line-of-page (list-ref lines-remaining (sub1 pl))) - (define lines-in-this-paragraph (cast (quad-attr-ref last-line-of-page world:total-lines-key) Integer)) - (define line-index-of-last-line (cast (quad-attr-ref last-line-of-page world:line-index-key) Integer)) + (define lines-in-this-paragraph (assert (quad-attr-ref last-line-of-page world:total-lines-key) integer?)) + (define line-index-of-last-line (assert (quad-attr-ref last-line-of-page world:line-index-key) integer?)) (define lines-that-will-remain (- lines-in-this-paragraph (add1 line-index-of-last-line))) (define (paragraph-too-short-to-meet-constraint?) (< lines-in-this-paragraph world:min-first-lines)) (or (paragraph-too-short-to-meet-constraint?) (= 0 lines-that-will-remain) ; ok to use all lines ... (>= lines-that-will-remain world:min-first-lines))) ; but if any remain, must be minimum number. - (send prob add-constraint (λ(x) (first-lines-constraint (cast x Index) lines-remaining)) '("column-lines")) + (send prob add-constraint (λ(x) (first-lines-constraint (assert x Index?) lines-remaining)) '("column-lines")) (log-quad-debug "viable number of lines after first-lines constraint =\n~a" ((inst map Integer (HashTable String Integer)) (λ(x) (hash-ref x "column-lines")) (send prob get-solutions))) (define s (send prob get-solution)) - (define how-many-lines-to-take (cast (hash-ref s "column-lines") Positive-Index)) + (define how-many-lines-to-take (assert (hash-ref s "column-lines") index?)) (define-values (lines-to-take lines-to-leave) (split-at lines-remaining how-many-lines-to-take)) (log-quad-debug "taking ~a lines for column ~a:" how-many-lines-to-take (add1 col-idx)) (map (λ([idx : Index] [line : LineQuad]) (log-quad-debug "~a:~a ~v" (add1 col-idx) (add1 idx) (quad->string line))) (range how-many-lines-to-take) lines-to-take) (send prob reset) - (values (cons (quad-attr-set (quads->column lines-to-take) world:column-index-key col-idx) columns) lines-to-leave))) + (define new-column (quads->column lines-to-take)) + (values (cons (apply column (attr-change (quad-attrs new-column) (list world:column-index-key col-idx)) (quad-list new-column)) columns) lines-to-leave))) (reverse columns)) (define/typed+provide (columns->pages cols) ((Listof ColumnQuad) . -> . (Listof PageQuad)) (define columns-per-page (cast (quad-attr-ref/parameter (car cols) world:column-count-key) Positive-Integer)) - (define column-gutter (cast (quad-attr-ref/parameter (car cols) world:column-gutter-key) Float)) + (define column-gutter (assert (quad-attr-ref/parameter (car cols) world:column-gutter-key) flonum?)) ;; don't use default value here. If the col doesn't have a measure key, ;; it deserves to be an error, because that means the line was composed incorrectly. (when (not (quad-has-attr? (car cols) world:measure-key)) (error 'columns->pages "column attrs contain no measure key: ~a ~a" (quad-attrs (car cols)) (quad-car (car cols)))) - (define column-width (cast (quad-attr-ref (car cols) world:measure-key) Float)) + (define column-width (assert (quad-attr-ref (car cols) world:measure-key) flonum?)) (define width-of-printed-area (+ (* columns-per-page column-width) (* (sub1 columns-per-page) column-gutter))) (define result-pages - ((inst map Quad (Listof Quad)) (λ(cols) (quads->page cols)) - (for/list : (Listof (Listof Quad)) ([page-cols (in-list (slice-at cols columns-per-page))]) - (define-values (last-x cols) - (for/fold ([current-x : Float (/ (- (world:paper-width-default) width-of-printed-area) 2.0)] - [cols : (Listof Quad) empty]) - ([col (in-list page-cols)][idx (in-naturals)]) - (values (+ current-x column-width column-gutter) (cons (cast (quad-attr-set* col 'x current-x 'y 40.0 world:column-index-key idx) Quad) cols)))) - (reverse cols)))) + ((inst map PageQuad (Listof Quad)) (λ(cols) (quads->page cols)) + (for/list : (Listof (Listof Quad)) ([page-cols (in-list (slice-at cols columns-per-page))]) + (define-values (last-x cols) + (for/fold ([current-x : Float (/ (- (world:paper-width-default) width-of-printed-area) 2.0)] + [cols : (Listof Quad) empty]) + ([col (in-list page-cols)][idx (in-naturals)]) + (values (foldl fl+ 0.0 (list current-x column-width column-gutter)) (cons (quad-attr-set* col (list 'x current-x 'y 40.0 world:column-index-key idx)) cols)))) + (reverse cols)))) result-pages) (define current-eof (make-parameter (gensym))) diff --git a/quad/utils-typed.rkt b/quad/utils-typed.rkt index 3fe22516..5df861e9 100644 --- a/quad/utils-typed.rkt +++ b/quad/utils-typed.rkt @@ -255,12 +255,10 @@ ;; use heights to compute vertical positions (define/typed+provide (add-vert-positions starting-quad) - (Quad . -> . Quad) + (GroupQuad . -> . GroupQuad) (define-values (new-quads final-height) (for/fold ([new-quads : (Listof Quad) empty][height-so-far : Float 0.0]) ([q (in-list (quad-list starting-quad))]) - (display 'foom2) - (assert q quad?) (values (cons (quad-attr-set q world:y-position-key height-so-far) new-quads) (round-float (+ height-so-far (quad-height q)))))) (quad (quad-name starting-quad) (quad-attrs starting-quad) (reverse new-quads)))