You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/quad2/draw.rkt

52 lines
2.2 KiB
Racket

#lang debug racket/base
(require racket/list
racket/string
racket/format
racket/match
"quad.rkt"
"pipeline.rkt"
"struct.rkt"
"layout.rkt"
"constants.rkt")
(provide (all-defined-out))
(define-pass (make-drawing-insts qs)
#:pre (list-of has-position?)
#:post (list-of $drawing-inst?)
(flatten
(list ($doc 'start) ($page 'start)
(let ([current-font #false])
(for/list ([q (in-list qs)])
(append
(match (quad-ref q :font-path)
[(== current-font) (list)]
[font-path
(set! current-font font-path)
(list ($font font-path))])
(cond
[(quad? q)
(if (pair? (quad-elems q))
(list ($move (quad-posn q)) ($text (char->integer (car (string->list (car (quad-elems q)))))))
(list))]
[else (error 'render-unknown-thing)]))))
($page 'end) ($doc 'end))))
(define valid-tokens '(doc-start doc-end page-start page-end text move set-font))
(define-pass (stackify xs)
#:pre (list-of $drawing-inst?)
#:post string?
(define move-points (map $move-posn (filter $move? xs)))
(define xmax (if (pair? move-points) (add1 (apply max (map $point-x move-points))) 0))
(define ymax (if (pair? move-points) (add1 (apply max (map $point-y move-points))) 0))
(string-join
(for/list ([x (in-list xs)])
(string-join (map ~a (match x
[($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)]
[_ (error 'unknown-drawing-inst)])) " ")) "\n"))