fix problems with `record-dc%' and composition
Recorded clipping, transformations, and alpha didn't compose with the target DC's existing clipping, transformations, and alpha. original commit: f79e2b4ee0bbe6a7302f658e78155b11d9dd7db8
This commit is contained in:
parent
9f45143c24
commit
286e0527e7
|
@ -232,6 +232,7 @@
|
|||
[save-file-format #f]
|
||||
[clip 'none]
|
||||
[current-alpha 1.0]
|
||||
[current-c-alpha 1.0]
|
||||
[current-rotation 0.0]
|
||||
[current-skew? #f])
|
||||
(send hp0 stretchable-height #f)
|
||||
|
@ -251,19 +252,26 @@
|
|||
(define pixel-copy? #f)
|
||||
(define kern? #f)
|
||||
(define clip-pre-scale? #f)
|
||||
(define c-clip? #f)
|
||||
(define mask-ex-mode 'mred)
|
||||
(define xscale 1)
|
||||
(define yscale 1)
|
||||
(define offset 0)
|
||||
(define c-xscale 1)
|
||||
(define c-yscale 1)
|
||||
(define c-offset 0)
|
||||
(public*
|
||||
[set-bitmaps (lambda (on?) (set! no-bitmaps? (not on?)) (refresh))]
|
||||
[set-stipples (lambda (on?) (set! no-stipples? (not on?)) (refresh))]
|
||||
[set-pixel-copy (lambda (on?) (set! pixel-copy? on?) (refresh))]
|
||||
[set-kern (lambda (on?) (set! kern? on?) (refresh))]
|
||||
[set-clip-pre-scale (lambda (on?) (set! clip-pre-scale? on?) (refresh))]
|
||||
[set-canvas-clip (lambda (on?) (set! c-clip? on?) (refresh))]
|
||||
[set-mask-ex-mode (lambda (mode) (set! mask-ex-mode mode) (refresh))]
|
||||
[set-canvas-scale (lambda (xs ys) (set! c-xscale xs) (set! c-yscale ys) (refresh))]
|
||||
[set-scale (lambda (xs ys) (set! xscale xs) (set! yscale ys) (refresh))]
|
||||
[set-offset (lambda (o) (set! offset o) (refresh))])
|
||||
[set-offset (lambda (o) (set! offset o) (refresh))]
|
||||
[set-canvas-offset (lambda (o) (set! c-offset o) (refresh))])
|
||||
(override*
|
||||
[on-paint
|
||||
(case-lambda
|
||||
|
@ -1003,20 +1011,30 @@
|
|||
(send dc draw-rectangle 187 310 20 20)
|
||||
(send dc set-pen p)))
|
||||
|
||||
(when (and last? use-record?)
|
||||
(if serialize-record?
|
||||
(let ()
|
||||
(define-values (i o) (make-pipe))
|
||||
(pretty-print (send dc get-recorded-datum))
|
||||
(write (send dc get-recorded-datum) o)
|
||||
((recorded-datum->procedure (read i)) can-dc))
|
||||
((send dc get-recorded-procedure) can-dc)))
|
||||
(when (and last?
|
||||
(or (and (not (or kind (eq? dc can-dc)))
|
||||
(send mem-dc get-bitmap))
|
||||
use-record?))
|
||||
(send can-dc set-origin c-offset c-offset)
|
||||
(send can-dc set-scale c-xscale c-yscale)
|
||||
(send can-dc set-alpha current-c-alpha)
|
||||
(when c-clip?
|
||||
(define r (new region%))
|
||||
(send r set-rectangle 0 0 200 200)
|
||||
(send can-dc set-clipping-region r))
|
||||
(if use-record?
|
||||
(if serialize-record?
|
||||
(let ()
|
||||
(define-values (i o) (make-pipe))
|
||||
(write (send dc get-recorded-datum) o)
|
||||
((recorded-datum->procedure (read i)) can-dc))
|
||||
((send dc get-recorded-procedure) can-dc))
|
||||
(send can-dc draw-bitmap (send mem-dc get-bitmap) 0 0 'opaque))
|
||||
(send can-dc set-origin 0 0)
|
||||
(send can-dc set-scale 1 1)
|
||||
(send can-dc set-alpha 1.0)
|
||||
(send can-dc set-clipping-region #f)))
|
||||
|
||||
(when (and last?
|
||||
(not (or kind (eq? dc can-dc)))
|
||||
(send mem-dc get-bitmap))
|
||||
(send can-dc draw-bitmap (send mem-dc get-bitmap) 0 0 'opaque)))
|
||||
|
||||
'done)])
|
||||
|
||||
(send (get-dc) set-scale 1 1)
|
||||
|
@ -1286,14 +1304,6 @@
|
|||
(set! save-filename f)
|
||||
(set! save-file-format format)
|
||||
(send canvas refresh))))))
|
||||
(make-object choice% #f '("1" "*2" "/2" "1,*2" "*2,1") hp
|
||||
(lambda (self event)
|
||||
(send canvas set-scale
|
||||
(list-ref '(1 2 1/2 1 2) (send self get-selection))
|
||||
(list-ref '(1 2 1/2 2 1) (send self get-selection)))))
|
||||
(make-object check-box% "+10" hp
|
||||
(lambda (self event)
|
||||
(send canvas set-offset (if (send self get-value) 10 0))))
|
||||
(make-object check-box% "Cyan" hp
|
||||
(lambda (self event)
|
||||
(set! cyan? (send self get-value))
|
||||
|
@ -1330,6 +1340,22 @@
|
|||
(make-object check-box% "Kern" hp2.5
|
||||
(lambda (self event)
|
||||
(send canvas set-kern (send self get-value))))
|
||||
(make-object choice% #f '("1" "*2" "/2" "1,*2" "*2,1") hp3
|
||||
(lambda (self event)
|
||||
(send canvas set-scale
|
||||
(list-ref '(1 2 1/2 1 2) (send self get-selection))
|
||||
(list-ref '(1 2 1/2 2 1) (send self get-selection)))))
|
||||
(make-object check-box% "+10" hp3
|
||||
(lambda (self event)
|
||||
(send canvas set-offset (if (send self get-value) 10 0))))
|
||||
(make-object choice% #f '("Cvs 1" "Cvs *2" "Cvs /2" "Cvs 1,*2" "Cvs *2,1") hp3
|
||||
(lambda (self event)
|
||||
(send canvas set-canvas-scale
|
||||
(list-ref '(1 2 1/2 1 2) (send self get-selection))
|
||||
(list-ref '(1 2 1/2 2 1) (send self get-selection)))))
|
||||
(make-object check-box% "Cvs +10" hp3
|
||||
(lambda (self event)
|
||||
(send canvas set-canvas-offset (if (send self get-value) 10 0))))
|
||||
(make-object choice% "Clip"
|
||||
'("None" "Rectangle" "Rectangle2" "Octagon"
|
||||
"Circle" "Wedge" "Round Rectangle" "Lambda" "A"
|
||||
|
@ -1347,6 +1373,9 @@
|
|||
(make-object check-box% "Clip Pre-Scale" hp3
|
||||
(lambda (self event)
|
||||
(send canvas set-clip-pre-scale (send self get-value))))
|
||||
(make-object check-box% "Cvs Clip" hp3
|
||||
(lambda (self event)
|
||||
(send canvas set-canvas-clip (send self get-value))))
|
||||
(let ([clock (lambda (clip?)
|
||||
(thread (lambda ()
|
||||
(set! clock-clip? clip?)
|
||||
|
@ -1378,6 +1407,10 @@
|
|||
(set! current-alpha a)
|
||||
(send canvas refresh))))
|
||||
10 '(horizontal plain))
|
||||
(make-object check-box% "Cvs Fade" hp4
|
||||
(lambda (c e)
|
||||
(set! current-c-alpha (if (send c get-value) 0.5 1.0))
|
||||
(send canvas refresh)))
|
||||
(make-object slider% "Rotation" 0 100 hp4
|
||||
(lambda (s e)
|
||||
(let ([a (* pi 1/4 (/ (send s get-value) 100.0))])
|
||||
|
@ -1391,9 +1424,3 @@
|
|||
(send canvas refresh)))))
|
||||
|
||||
(send f show #t))
|
||||
|
||||
; Canvas, Pixmaps, and Bitmaps:
|
||||
; get-pixel
|
||||
; begin-set-pixel
|
||||
; end-set-pixel
|
||||
; set-pixel
|
||||
|
|
Loading…
Reference in New Issue
Block a user