|
|
|
@ -1,7 +1,9 @@
|
|
|
|
|
#lang debug racket/base
|
|
|
|
|
(require "pipeline.rkt"
|
|
|
|
|
"draw.rkt"
|
|
|
|
|
"layout.rkt")
|
|
|
|
|
"layout.rkt"
|
|
|
|
|
"log.rkt"
|
|
|
|
|
"glyphrun.rkt")
|
|
|
|
|
(provide (all-defined-out))
|
|
|
|
|
|
|
|
|
|
(struct $renderer (doc-start-func
|
|
|
|
@ -10,9 +12,10 @@
|
|
|
|
|
page-end-func
|
|
|
|
|
text-func
|
|
|
|
|
move-func
|
|
|
|
|
return-func) #:transparent)
|
|
|
|
|
return-func
|
|
|
|
|
set-font-func) #:transparent)
|
|
|
|
|
|
|
|
|
|
(define current-renderer (make-parameter ($renderer void void void void void void void)))
|
|
|
|
|
(define current-renderer (make-parameter ($renderer void void void void void void void void)))
|
|
|
|
|
|
|
|
|
|
(define text-renderer
|
|
|
|
|
;; scan over the instructions and record where the chars want to go
|
|
|
|
@ -41,7 +44,8 @@
|
|
|
|
|
(λ ()
|
|
|
|
|
(unless (pair? results)
|
|
|
|
|
(error 'text-renderer-failed))
|
|
|
|
|
(for-each displayln results)))))
|
|
|
|
|
(for-each displayln results))
|
|
|
|
|
void)))
|
|
|
|
|
|
|
|
|
|
(require racket/gui)
|
|
|
|
|
|
|
|
|
@ -49,7 +53,8 @@
|
|
|
|
|
;; scan over the instructions and record where the chars want to go
|
|
|
|
|
(let ([targets null]
|
|
|
|
|
[dc #f]
|
|
|
|
|
[current-loc 0+0i])
|
|
|
|
|
[current-loc 0+0i]
|
|
|
|
|
[current-font #false])
|
|
|
|
|
($renderer
|
|
|
|
|
void
|
|
|
|
|
void
|
|
|
|
@ -68,7 +73,15 @@
|
|
|
|
|
(λ (charint)
|
|
|
|
|
(send dc draw-text (string (integer->char charint)) (real-part current-loc) (imag-part current-loc)))
|
|
|
|
|
(λ (x y) (set! current-loc (make-rectangular x y)))
|
|
|
|
|
(λ () (for-each displayln (map (λ (target) (make-object image-snip% target)) targets))))))
|
|
|
|
|
(λ () (for-each displayln (map (λ (target) (make-object image-snip% target)) targets)))
|
|
|
|
|
(λ (ps)
|
|
|
|
|
;; racket/draw can't load arbitrary user fonts from a path
|
|
|
|
|
;; https://github.com/racket/racket/issues/1348
|
|
|
|
|
;; TODO: font substitution? but this would require
|
|
|
|
|
;; holding & propagating Panose-like metadata about the font
|
|
|
|
|
;; but it would allow slightly more accurate rendering for contexts
|
|
|
|
|
;; that don't support fonts by path
|
|
|
|
|
(log-quad2-warning (format "can't load font ~a" ps))))))
|
|
|
|
|
|
|
|
|
|
(define (render inst-str #:using [renderer (current-renderer)])
|
|
|
|
|
(let/ec exit
|
|
|
|
@ -84,6 +97,7 @@
|
|
|
|
|
[(list* 'page-start x y rest) (($renderer-page-start-func renderer) x y) rest]
|
|
|
|
|
[(list* 'page-end rest) (($renderer-page-end-func renderer)) rest]
|
|
|
|
|
[(list* 'text charint rest) (($renderer-text-func renderer) charint) rest]
|
|
|
|
|
[(list* 'set-font path-string rest) (($renderer-set-font-func renderer) (symbol->string path-string)) rest]
|
|
|
|
|
[(list* 'move x y rest) (($renderer-move-func renderer) x y) rest]
|
|
|
|
|
[_ next-stack])]
|
|
|
|
|
[else next-stack])))
|
|
|
|
|