slideshow/pict: fix `text' angle and superscript/subscript modes

This commit is contained in:
Matthew Flatt 2013-05-12 07:04:26 -06:00
parent b08ff186e2
commit c9cfaa2d36

View File

@ -234,12 +234,14 @@
dc dc
(lambda () (lambda ()
(send dc get-text-extent string s-font combine?)))]) (send dc get-text-extent string s-font combine?)))])
(define (make-draw adj-x adj-y) (define (make-draw adj-x adj-y angle)
(define p (define p
(and outline? (and outline?
(let ([p (new dc-path%)]) (let ([p (new dc-path%)])
(send p text-outline (send p text-outline
font string 0 0 combine?) s-font string 0 0 combine?)
(unless (zero? angle)
(send p rotate angle))
p))) p)))
(lambda (dc x y) (lambda (dc x y)
(let ([f (send dc get-font)]) (let ([f (send dc get-font)])
@ -257,7 +259,7 @@
(send dc set-font s-font) (send dc set-font s-font)
(send dc draw-text string (send dc draw-text string
dest-x dest-y dest-x dest-y
combine?) combine? 0 angle)
(when fg (send dc set-text-foreground fg)) (when fg (send dc set-text-foreground fg))
(send dc set-font f)])))) (send dc set-font f)]))))
(if (or sub? sup?) (if (or sub? sup?)
@ -269,12 +271,14 @@
(lambda (x) x) (lambda (x) x)
(lambda (y) (if sub? (lambda (y) (if sub?
(+ y (- wh h)) (+ y (- wh h))
y))) y))
0)
w wh (- wh wd) wd)) w wh (- wh wd) wd))
(if (zero? angle) (if (zero? angle)
;; Normal case: no rotation ;; Normal case: no rotation
(prog-picture (make-draw (lambda (x) x) (prog-picture (make-draw (lambda (x) x)
(lambda (y) y)) (lambda (y) y)
0)
w h (- h d) d) w h (- h d) d)
;; Rotation case. Need to find the bounding box. ;; Rotation case. Need to find the bounding box.
;; Calculate the four corners, relative to top left as origin: ;; Calculate the four corners, relative to top left as origin:
@ -305,7 +309,8 @@
[(negative? sa) (- (* h ca))] [(negative? sa) (- (* h ca))]
[else (+ (- (* h ca)) (* w sa))])]) [else (+ (- (* h ca)) (* w sa))])])
(prog-picture (make-draw (lambda (x) (+ x dx)) (prog-picture (make-draw (lambda (x) (+ x dx))
(lambda (y) (+ y dy))) (lambda (y) (+ y dy))
angle)
pw ph ph 0))))))))) pw ph ph 0)))))))))
(define caps-text (define caps-text