From 52d33803de983fc5ed9bb501b6c4170ba18ccd9f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 13 May 2022 14:41:53 -0700 Subject: [PATCH] setup first page --- quad2/draw.rkt | 36 +++++++++++++++++++----------------- quad2/linearize.rkt | 13 ++++++++++++- quad2/main.rkt | 14 +++++++------- quad2/quad.rkt | 18 +++++++++++------- quad2/render.rkt | 11 ++++++----- quad2/struct.rkt | 6 ++++-- 6 files changed, 59 insertions(+), 39 deletions(-) diff --git a/quad2/draw.rkt b/quad2/draw.rkt index 03be8b5c..00a391d6 100644 --- a/quad2/draw.rkt +++ b/quad2/draw.rkt @@ -13,23 +13,25 @@ (define-pass (make-drawing-insts qs) #:pre (list-of has-position?) #:post (list-of $drawing-inst?) - (flatten - (list ($doc 'start) ($page 'start) + (apply append (let ([current-font #false]) (for/list ([q (in-list qs)]) - (append - (match (quad-ref q :font-path) - [(== current-font) null] - [font-path - (set! current-font font-path) - (list ($font font-path))]) - (cond - [(quad? q) + (cond + [(eq? boq q) (list ($doc-start))] + [(eq? eoq q) (list ($doc-end))] + [(bop-quad? q) (list ($page-start (quad-ref q :page-width) (quad-ref q :page-height)))] + [(eop-quad? q) (list ($page-end))] + [(quad? q) + (append + (match (quad-ref q :font-path) + [(== current-font) null] + [font-path + (set! current-font font-path) + (list ($font font-path))]) (if (pair? (quad-elems q)) (list ($move (quad-posn q)) ($text (char->integer (car (string->list (car (quad-elems q))))))) - null)] - [else (error 'render-unknown-thing)])))) - ($page 'end) ($doc 'end)))) + null))] + [else (error 'render-unknown-thing)]))))) (define valid-tokens '(doc-start doc-end page-start page-end text move set-font)) @@ -45,8 +47,8 @@ [($move ($point x y)) (list y x 'move)] [($text charint) (list charint 'text)] [($font path-string) (list path-string 'set-font)] - [($doc 'start) '(doc-start)] - [($doc 'end) '(doc-end)] - [($page 'start) (list ymax xmax 'page-start)] - [($page 'end) '(page-end)] + [($doc-start) '(doc-start)] + [($doc-end) '(doc-end)] + [($page-start width height) (list height width 'page-start)] + [($page-end) '(page-end)] [_ (error 'unknown-drawing-inst)])) " ")) "\n")) \ No newline at end of file diff --git a/quad2/linearize.rkt b/quad2/linearize.rkt index e5922f1a..93892ea9 100644 --- a/quad2/linearize.rkt +++ b/quad2/linearize.rkt @@ -103,10 +103,21 @@ (module+ test (mark-text-runs smlqs)) +(define-pass (append-bop-and-eop qs) + ;; force document to have one page + #:pre (list-of simple-quad?) + #:post (λ (qs) (match qs + [(list (? bop-quad?) (? simple-quad?) ... (? eop-quad?)) #true] + [_ #false])) + (define bop (bop-quad #f (quad-attrs (first qs)) null #f)) + (define eop (eop-quad #f (quad-attrs (last qs)) null #f)) + (append (list bop) qs (list eop))) + (define-pass (append-boq-and-eoq qs) + ;; attach the boq and eoq signals #:pre (list-of simple-quad?) #:post (λ (qs) (match qs - [(list (? boq-quad?) (? simple-quad?) ... (? eoq-quad?)) #true] + [(list (== boq) (? simple-quad?) ... (== eoq)) #true] [_ #false])) (set-quad-attrs! boq (quad-attrs (first qs))) (set-quad-attrs! eoq (quad-attrs (last qs))) diff --git a/quad2/main.rkt b/quad2/main.rkt index 1555d3f5..fcf88b3c 100644 --- a/quad2/main.rkt +++ b/quad2/main.rkt @@ -48,10 +48,8 @@ ;; (e.g., cascading font sizes) ;; because once we linearize, that information is gone. linearize - (print-pass append-boq-and-eoq) - - ;; post-linearization resolutions & parsings ============= - + + ;; post-linearization resolutions & parsings ============= mark-text-runs merge-adjacent-strings split-whitespace @@ -59,8 +57,10 @@ fill-missing-font-path remove-font-without-char insert-fallback-font + append-bop-and-eop + append-boq-and-eoq layout - (print-pass make-drawing-insts) + make-drawing-insts stackify)) (module+ main @@ -79,8 +79,8 @@ (match (test-compile "X") [(? string? insts) (displayln insts) - (render insts #:using text-renderer) - (render insts #:using drr-renderer) + #;(render insts #:using text-renderer) + #;(render insts #:using drr-renderer) (render insts #:using (html-renderer (build-path (find-system-path 'desk-dir) "test.html"))) #;(render-to-pdf drawing-insts) ])) diff --git a/quad2/quad.rkt b/quad2/quad.rkt index 9db14475..76df388a 100644 --- a/quad2/quad.rkt +++ b/quad2/quad.rkt @@ -52,7 +52,9 @@ [else attrs]))]) (quad-constructor tag attrs elems #false))) -(define (quad-ref q-or-qs key [default-val #false] #:set-default-if-missing [set-default-if-missing? #false]) +(define (quad-ref q-or-qs key + [default-val (λ () (error (format "quad-ref: no value for key ~a" key)))] + #:set-default-if-missing [set-default-if-missing? #false]) (unless (attr-key? key) (raise-argument-error 'quad-ref "attr-key?" key)) (define hash-reffer (if set-default-if-missing? hash-ref! hash-ref)) @@ -110,9 +112,11 @@ (module+ test (define q (make-quad #:tag 'div #:attrs (make-hasheq '((hello . "world"))) #:elems (list "fine")))) - - -(struct boq-quad quad ()) -(define boq (boq-quad #f (make-hasheq) null #f)) -(struct eoq-quad quad ()) -(define eoq (eoq-quad #f (make-hasheq) null #f)) \ No newline at end of file +(define boq (let () + (struct boq-quad quad ()) + (boq-quad #f (make-hasheq) null #f))) +(define eoq (let () + (struct eoq-quad quad ()) + (eoq-quad #f (make-hasheq) null #f))) +(struct bop-quad quad ()) +(struct eop-quad quad ()) diff --git a/quad2/render.rkt b/quad2/render.rkt index 38aabdc7..dc764a1e 100644 --- a/quad2/render.rkt +++ b/quad2/render.rkt @@ -42,8 +42,8 @@ void (λ (x y) (set! current-loc (make-rectangular x y))) (λ () - (unless (pair? results) - (error 'text-renderer-failed)) + #;(unless (pair? results) + (error 'text-renderer-failed)) (for-each displayln results))))) (require racket/gui) @@ -70,7 +70,8 @@ (send dc set-text-foreground "black"))) void (λ (charint) - (send dc draw-text (string (integer->char charint)) (real-part current-loc) (imag-part current-loc))) + (when dc + (send dc draw-text (string (integer->char charint)) (real-part current-loc) (imag-part current-loc)))) (λ (ps) ;; racket/draw can't load arbitrary user fonts from a path ;; https://github.com/racket/racket/issues/1348 @@ -100,12 +101,12 @@ (set! ymax height)) (λ () (set! pages (cons `(div ((class "page") - (style ,(format "position: relative;width:~apx;height:~apx;border:1px solid black;background:white" (* xmax em-scale) (* ymax em-scale)))) ,@(reverse page-quads)) pages)) + (style ,(format "position: relative;width:~apx;height:~apx;border:1px solid black;background:white" xmax ymax))) ,@(reverse page-quads)) pages)) (set! page-quads null)) (λ (charint) (set! page-quads (cons `(div ((style ,(format "position: absolute;left:~apx;top:~apx;font-family:~a" (* em-scale (real-part current-loc)) (* em-scale (imag-part current-loc)) current-font))) - ,(string (integer->char charint))) page-quads))) + ,(string (integer->char charint))) page-quads))) (λ (ps) (set! current-font (hash-ref! fonts ps (λ () (gensym 'font))))) (λ (x y) (set! current-loc (make-rectangular x y))) diff --git a/quad2/struct.rkt b/quad2/struct.rkt index ccb0b736..a5ea2107 100644 --- a/quad2/struct.rkt +++ b/quad2/struct.rkt @@ -7,8 +7,10 @@ (struct $move $drawing-inst (posn) #:transparent) ; an absolute location in coordinate system (not relative to last loc) (struct $text $drawing-inst (charint) #:transparent) (struct $font $drawing-inst (path-string) #:transparent) -(struct $doc $drawing-inst (inst) #:transparent) -(struct $page $drawing-inst (inst) #:transparent) +(struct $doc-start $drawing-inst () #:transparent) +(struct $doc-end $drawing-inst () #:transparent) +(struct $page-start $drawing-inst (x y) #:transparent) +(struct $page-end $drawing-inst () #:transparent) (struct attr-key (name mandatory? default) #:transparent #:methods gen:custom-write