setup first page

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"))

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)))

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)
      ]))

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))
+(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 ())

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)))

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