From a1e9bf4c536ba7330151b09d7c0b88a81906ba81 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 20 Jun 2016 21:45:40 -0700 Subject: [PATCH] add optional args to `typeset` --- quad/quad/main.rkt | 9 +++++---- quad/quad/typeset.rkt | 44 ++++++++++++++++++++++++------------------- 2 files changed, 30 insertions(+), 23 deletions(-) diff --git a/quad/quad/main.rkt b/quad/quad/main.rkt index 1a3b9931..067584ac 100644 --- a/quad/quad/main.rkt +++ b/quad/quad/main.rkt @@ -1,15 +1,16 @@ -#lang racket/base +#lang quad/dev (require "quads.rkt" "typeset.rkt" "atomize.rkt" "render.rkt" racket/list racket/string) -(provide (except-out (all-from-out racket/base "quads.rkt") #%module-begin) +(provide (except-out (all-from-out quad/dev "quads.rkt") #%module-begin) (rename-out [~module-begin #%module-begin])) (define-syntax-rule (~module-begin lang-line-config-arg . args) (#%module-begin (define main-quad (apply quad #f (add-between (list . args) "\n"))) ; at-reader splits lines, but we want one contiguous run ;; branch on config-arg to allow debug / inspection options on #lang line - (case (string-trim lang-line-config-arg) + (define config-pieces (string-split (string-trim lang-line-config-arg))) + (case (car config-pieces) [("#:atoms") (atomize main-quad)] - [("#:text") (time (debug-render (typeset-fit (atomize main-quad))))] + [("#:fit") (time (debug-render (apply typeset-fit (atomize main-quad) (map string->number (cdr config-pieces)))))] [else (typeset-fit (atomize main-quad))]))) (module reader syntax/module-reader diff --git a/quad/quad/typeset.rkt b/quad/quad/typeset.rkt index 0ddf9859..9a2d079c 100644 --- a/quad/quad/typeset.rkt +++ b/quad/quad/typeset.rkt @@ -2,7 +2,7 @@ (provide (all-defined-out)) (require "measure.rkt") -(define last-breakpoint-k #f) +(define last-breakpoint-k (λ _ (error 'typeset-fit "No breakpoint available. Increase line width"))) (define (set-breakpoint-k-here!) (let/cc k (set! last-breakpoint-k k) #f)) @@ -12,37 +12,43 @@ (define col-height (* 6 line-height)) ; 3 rows, each 12 pts high (define page-width (* 3 line-width)) ; meaning, two columns -(struct tp (page-horiz vert horiz)) +;; posn-page : horiz position of column within page +;; posn-col : vert position of line within column +;; posn-line : horiz position of char within line +(struct posn (page col line)) +(define (make-posn [page 0] [col 0] [line 0]) (posn page col line)) -(define page-start-position (tp 0 0 0)) +(define page-start-position (make-posn)) -(define (handle-break val [tpos #f]) - (caseq val ; test in order of frequency - [(line-break) (tp (tp-page-horiz tpos) (+ (tp-vert tpos) line-height) 0)] - [(column-break) (tp (+ (tp-page-horiz tpos) line-width) 0 0)] - [(page-break) page-start-position] - [else tpos])) - -(define (typeset-fit qs) - (for/fold ([tpos (handle-break 'page-break)]) +(define (typeset-fit qs [line-width line-width] [col-height col-height]) + + (define (handle-break val [current-posn #f]) + (caseq val ; test in order of frequency + [(line-break) (make-posn (posn-page current-posn) (+ (posn-col current-posn) line-height))] + [(column-break) (make-posn (+ (posn-page current-posn) line-width))] + [(page-break) page-start-position] + [else current-posn])) + + (for/fold ([current-posn (handle-break 'page-break)]) ([q (in-vector qs)]) (unless (quad-dim q) (measure! q)) (cond ;; hard may contain an imperative break. Test for this first because it makes the rest irrelevant. ;; todo: how to suppress spaces adjacent to imperative breaks? - [($hard? q) (handle-break (quad-dim q) tpos)] + [($hard? q) (handle-break (quad-dim q) current-posn)] ;; test for overset (before a new bp-k gets set). ;; order is precedence: test bigger breaks first + ;; send break type back through continuation ;; test page-horiz with >= because one column impliedly exists at the start ;; (we could also make this explicit with page-start-position but it seems clearer to use zeroes there) - [(>= (tp-page-horiz tpos) page-width) (last-breakpoint-k 'page-break)] + [(>= (posn-page current-posn) page-width) (last-breakpoint-k 'page-break)] ;; test tp-vert with >= because one column impliedly exists at the start - [(>= (tp-vert tpos) col-height) (last-breakpoint-k 'column-break)] + [(>= (posn-col current-posn) col-height) (last-breakpoint-k 'column-break)] ;; but test tp-horiz with > because no characters exist in the line at the start - [(> (tp-horiz tpos) line-width) (last-breakpoint-k 'line-break)] + [(> (posn-line current-posn) line-width) (last-breakpoint-k 'line-break)] ;; set a new bp-k, or resume after invoking a bp-k [(and ($soft? q) (set-breakpoint-k-here!)) @@ -50,11 +56,11 @@ (λ (breakpoint-k-result) ;; convert the white, thereby consuming it. todo: don't consume hyphens (quad-dim-set! q breakpoint-k-result) - (handle-break breakpoint-k-result tpos))] - [else (tp (tp-page-horiz tpos) (tp-vert tpos) (+ (tp-horiz tpos) (quad-dim q)))])) + (handle-break breakpoint-k-result current-posn))] + [else (posn (posn-page current-posn) (posn-col current-posn) (+ (posn-line current-posn) (quad-dim q)))])) qs) (module+ test (require "atomize.rkt" "render.rkt") - (define q (quad #f "One morning, when Gregor" (line-break) " and his old hizn himself")) + (define q (quad #f "One morning, when Gregor " (line-break) " and his old hizn himself")) (time (debug-render (typeset-fit (atomize q))))) \ No newline at end of file