From 92ac0418803e3008ffd4d676f718cee7b40a2c64 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 7 Mar 2015 09:10:50 -0800 Subject: [PATCH] start main-typed --- quad/main-typed-tests.rkt | 11 +++++++++++ quad/main-typed.rkt | 27 +++++++++++++++++++++++++++ 2 files changed, 38 insertions(+) create mode 100644 quad/main-typed-tests.rkt create mode 100644 quad/main-typed.rkt diff --git a/quad/main-typed-tests.rkt b/quad/main-typed-tests.rkt new file mode 100644 index 00000000..d29cf42a --- /dev/null +++ b/quad/main-typed-tests.rkt @@ -0,0 +1,11 @@ +#lang typed/racket/base +(require typed/rackunit) +(require "main-typed.rkt" "quads-typed.rkt") + + +(check-equal? (input->nested-blocks (input #f (block #f "1" (block-break) "2"))) + (list (list (list (list (quad 'word '#hash() '("1"))) (list (quad 'word '#hash() '("2"))))))) +(check-equal? (input->nested-blocks (input #f (block #f "1" (column-break) "2"))) + (list (list (list (list (quad 'word '#hash() '("1")))) (list (list (quad 'word '#hash() '("2"))))))) +(check-equal? (list (list (list (list (quad 'word '#hash() '("1"))))) (list (list (list (quad 'word '#hash() '("2")))))) +(input->nested-blocks (input #f (block #f "1" (page-break) "2")))) \ No newline at end of file diff --git a/quad/main-typed.rkt b/quad/main-typed.rkt new file mode 100644 index 00000000..0d874db3 --- /dev/null +++ b/quad/main-typed.rkt @@ -0,0 +1,27 @@ +#lang typed/racket/base +(require racket/list) +(require "quads-typed.rkt" "utils-typed.rkt" "wrap-typed.rkt" "measure-typed.rkt" "world-typed.rkt" "logger-typed.rkt") + +(define-type Block-Type (Listof Quad)) +(define-type Multicolumn-Type (Listof Block-Type)) +(define-type Multipage-Type (Listof Multicolumn-Type)) + +(define/typed (cons-reverse xs ys) + (All (A B) ((Listof A) (Listof B) -> (Pairof (Listof A) (Listof B)))) + ((inst cons (Listof A) (Listof B)) ((inst reverse A) xs) ys)) + +(provide input->nested-blocks) +(define/typed (input->nested-blocks i) + (Quad . -> . (Listof Multipage-Type)) + (define-values (mps mcs bs b) + (for/fold ([multipages : (Listof Multipage-Type) empty] + [multicolumns : (Listof Multicolumn-Type) empty] + [blocks : (Listof Block-Type) empty] + [block-acc : Block-Type empty]) + ([q (in-list (split-quad i))]) + (cond + [(page-break? q) (values (cons-reverse (cons-reverse (cons-reverse block-acc blocks) multicolumns) multipages) empty empty empty)] + [(column-break? q) (values multipages (cons-reverse (cons-reverse block-acc blocks) multicolumns) empty empty)] + [(block-break? q) (values multipages multicolumns (cons-reverse block-acc blocks) empty)] + [else (values multipages multicolumns blocks (cons q block-acc))]))) + (reverse (cons-reverse (cons-reverse ((inst cons-reverse Quad Block-Type) b bs) mcs) mps)))