suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

support general transformation matrix

Browse Source
This commit is contained in:
Matthew Flatt 2010-07-28 06:43:38 -05:00
parent 0723c4f647
commit d7289c253f
3 changed files with 58 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/racket/draw/cairo.rkt
View File

@ -41,7 +41,7 @@
[yy _double*]
[x0 _double*]
[y0 _double*]))
(provide make-cairo_matrix_t)
(provide (struct-out cairo_matrix_t))
(define-cstruct _cairo_glyph_t ([index _long] [x _double*] [y _double*]))
(provide make-cairo_glyph_t)
@ -94,8 +94,11 @@
(define-cairo cairo_scale (_fun _cairo_t _double* _double* -> _void))
(define-cairo cairo_rotate (_fun _cairo_t _double* -> _void))
(define-cairo cairo_identity_matrix (_fun _cairo_t -> _void))
(define-cairo cairo_set_matrix (_fun _cairo_t _cairo_matrix_t-pointer -> _void))
(define-cairo cairo_matrix_init_translate (_fun _cairo_matrix_t-pointer _double* _double* -> _void))
(define-cairo cairo_matrix_init (_fun _cairo_matrix_t-pointer _double* _double* _double* _double* _double* _double* -> _void))
;; Stroke & Fill
(define-cairo cairo_set_source_rgb (_fun _cairo_t _double* _double* _double* -> _void))

38
collects/racket/draw/dc.rkt
View File

@ -38,6 +38,12 @@
(define -bitmap-dc% #f)
(define (install-bitmap-dc-class! v) (set! -bitmap-dc% v))
(define (matrix-vector? m)
(and (vector? m)
(= 6 (vector-length m))
(for/and ([e (in-vector m)])
(real? e))))
;; dc-backend : interface
;;
;; This is the interface that the backend specific code must implement
@ -196,10 +202,12 @@
(def/public (get-font) font)
(define matrix (make-cairo_matrix_t 1 0 0 1 0 0))
(define origin-x 0.0)
(define origin-y 0.0)
(define scale-x 1.0)
(define scale-y 1.0)
(define rotation 0.0)
(def/public (set-scale [real? sx] [real? sy])
(unless (and (equal? scale-x sx)
@ -218,14 +226,38 @@
(reset-matrix)))
(def/public (get-origin) (values origin-x origin-y))
(def/public (set-rotation [real? th])
(unless (and (equal? rotation th))
(set! rotation th)
(reset-matrix)))
(def/public (get-rotation) rotation)
(def/public (set-initial-matrix [matrix-vector? m])
(set! matrix (make-cairo_matrix_t (vector-ref m 0)
(vector-ref m 1)
(vector-ref m 2)
(vector-ref m 3)
(vector-ref m 4)
(vector-ref m 5)))
(reset-matrix))
(def/public (get-initial-matrix)
(let ([m matrix])
(vector-immutable (cairo_matrix_t-xx m)
(cairo_matrix_t-yx m)
(cairo_matrix_t-xy m)
(cairo_matrix_t-yy m)
(cairo_matrix_t-x0 m)
(cairo_matrix_t-y0 m))))
(define/private (reset-matrix)
(with-cr
(void)
cr
(cairo_identity_matrix cr)
(init-cr-matrix cr)
(cairo_set_matrix cr matrix)
(cairo_translate cr origin-x origin-y)
(cairo_scale cr scale-x scale-y)))
(cairo_scale cr scale-x scale-y)
(cairo_rotate cr rotation)))
(inherit get-font-metrics-key)
(define/public (cache-font-metrics-key)

21
collects/tests/gracket/draw.rkt
View File

@ -226,7 +226,9 @@
[save-filename #f]
[save-file-format #f]
[clip 'none]
[current-alpha 1.0])
[current-alpha 1.0]
[current-rotation 0.0]
[current-skew? #f])
(send hp0 stretchable-height #f)
(send hp stretchable-height #f)
(send hp2.5 stretchable-height #f)
@ -965,6 +967,10 @@
(send dc start-page)
(send dc set-alpha current-alpha)
(send dc set-rotation current-rotation)
(send dc set-initial-matrix (if current-skew?
(vector 1 0 0.2 1 3 0)
(vector 1 0 0 1 0 0)))
(if clip-pre-scale?
(begin
@ -1243,7 +1249,18 @@
(unless (= a current-alpha)
(set! current-alpha a)
(send canvas refresh))))
10 '(horizontal plain))))
10 '(horizontal plain))
(make-object slider% "Rotation" 0 100 hp4
(lambda (s e)
(let ([a (* pi 1/4 (/ (send s get-value) 100.0))])
(unless (= a current-rotation)
(set! current-rotation a)
(send canvas refresh))))
0 '(horizontal plain))
(make-object check-box% "Skew" hp4
(lambda (c e)
(set! current-skew? (send c get-value))
(send canvas refresh)))))
(send f show #t))