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

v5.4.99.1, executable-yield-handler', and make-bitmap' etc.

Browse Source 
original commit: 05cfffdf9e13b6868a19384e88bcb9331f9631f1
This commit is contained in:
Matthew Flatt 2010-10-27 07:54:33 -06:00
parent c14bee176f
commit da874c1c04
9 changed files with 182 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/mred/mred-sig.rkt
View File

@ -118,11 +118,13 @@ label->plain-label
labelled-menu-item<%>
list-box%
list-control<%>
make-bitmap
make-eventspace
make-gl-bitmap
make-gui-empty-namespace
make-gui-namespace
make-monochrome-bitmap
make-screen-bitmap
make-gl-bitmap
map-command-as-meta-key
menu%
menu-bar%
@ -156,6 +158,7 @@ put-file
queue-callback
radio-box%
readable-snip<%>
read-bitmap
read-editor-global-footer
read-editor-global-header
read-editor-version

3
collects/mred/mred.rkt
View File

@ -102,6 +102,9 @@
begin-busy-cursor
bell
bitmap%
make-bitmap
read-bitmap
make-monochrome-bitmap
brush%
brush-list%
editor-data%

3
collects/mred/private/gdi.rkt
View File

@ -8,7 +8,8 @@
"wx.ss"
"te.rkt"
"mrtop.ss"
"mrcanvas.ss")
"mrcanvas.ss"
"syntax.rkt")
(provide register-collecting-blit
unregister-collecting-blit

16
collects/mred/private/wx/cocoa/queue.rkt
View File

@ -54,9 +54,23 @@
(tellv app finishLaunching)
;; In case we were started in an executable without a bundle,
;; explicitly register with the dock so the application can receive
;; keyboard events.
;; This technique is not sanctioned by Apple --- I found the code in SDL.
(define-cstruct _CPSProcessSerNum ([lo _uint32] [hi _uint32]))
(define-appserv CPSGetCurrentProcess (_fun _CPSProcessSerNum-pointer -> _int)
#:fail (lambda () (lambda args 1)))
(define-appserv CPSEnableForegroundOperation (_fun _CPSProcessSerNum-pointer _int _int _int _int -> _int)
#:fail (lambda () #f))
(let ([psn (make-CPSProcessSerNum 0 0)])
(when (zero? (CPSGetCurrentProcess psn))
(void (CPSEnableForegroundOperation psn #x03 #x3C #x2C #x1103))))
(define app-delegate (tell (tell MyApplicationDelegate alloc) init))
(tellv app setDelegate: app-delegate)
(tellv app activateIgnoringOtherApps: #:type _BOOL #t)
(unless (scheme_register_process_global "Racket-GUI-no-front" #f)
(tellv app activateIgnoringOtherApps: #:type _BOOL #t))
;; For some reason, nextEventMatchingMask:... gets stuck if the
;; display changes, and it doesn't even send the

9
collects/mred/private/wx/common/queue.rkt
View File

@ -498,3 +498,12 @@
(send e set-wait-cursor-mode #f))))))
(define (is-busy?) (positive? (eventspace-wait-cursor-count (current-eventspace))))
;; ----------------------------------------
;; Before exiting, wait until frames are closed, etc.:
(executable-yield-handler
(let ([old-eyh (executable-yield-handler)])
(lambda (v)
(yield main-eventspace)
(old-eyh v))))

62
collects/mrlib/image-core.rkt
View File

@ -117,10 +117,10 @@ has been moved out).
;; - flip
;; a bitmap is:
;; - (make-bitmap (is-a?/c bitmap%) angle positive-real
;; hash[(list boolean[flip] number[x-scale] number[y-scale] number[angle]) -o> (cons (is-a?/c bitmap%) (is-a?/c bitmap%)])
;; - (make-ibitmap (is-a?/c bitmap%) angle positive-real
;; hash[(list boolean[flip] number[x-scale] number[y-scale] number[angle]) -o> (cons (is-a?/c bitmap%) (is-a?/c bitmap%)])
;; NOTE: bitmap copying needs to happen in 'write' and 'read' methods
(define-struct/reg-mk bitmap (raw-bitmap raw-mask angle x-scale y-scale cache)
(define-struct/reg-mk ibitmap #:reflect-id bitmap (raw-bitmap raw-mask angle x-scale y-scale cache)
#:omit-define-syntaxes #:transparent
#:property prop:custom-write (λ (x y z) (bitmap-write x y z)))
@ -404,7 +404,7 @@ has been moved out).
(or (polygon? shape)
(line-segment? shape)
(curve-segment? shape)
(bitmap? shape)
(ibitmap? shape)
(np-atomic-shape? shape)))
(define (np-atomic-shape? shape)
@ -412,7 +412,7 @@ has been moved out).
(text? shape)
(and (flip? shape)
(boolean? (flip-flipped? shape))
(bitmap? (flip-shape shape)))))
(ibitmap? (flip-shape shape)))))
;; normalize-shape : shape -> normalized-shape
;; normalizes 'shape', calling 'f' on each atomic shape in the normalized shape.
@ -490,8 +490,8 @@ has been moved out).
(if bottom
(make-overlay bottom this-one)
this-one))]
[(or (bitmap? shape) (np-atomic-shape? shape))
(let ([shape (if (bitmap? shape)
[(or (ibitmap? shape) (np-atomic-shape? shape))
(let ([shape (if (ibitmap? shape)
(make-flip #f shape)
shape)])
(let ([this-one
@ -532,12 +532,12 @@ has been moved out).
[else
(let ([bitmap (flip-shape shape)])
(make-flip (flip-flipped? shape)
(make-bitmap (bitmap-raw-bitmap bitmap)
(bitmap-raw-mask bitmap)
(bitmap-angle bitmap)
(* x-scale (bitmap-x-scale bitmap))
(* y-scale (bitmap-y-scale bitmap))
(bitmap-cache bitmap))))])]))
(make-ibitmap (ibitmap-raw-bitmap bitmap)
(ibitmap-raw-mask bitmap)
(ibitmap-angle bitmap)
(* x-scale (ibitmap-x-scale bitmap))
(* y-scale (ibitmap-y-scale bitmap))
(ibitmap-cache bitmap))))])]))
(define (scale-color color x-scale y-scale)
(cond
@ -875,34 +875,34 @@ the mask bitmap and the original bitmap are all together in a single bytes!
(define (get-rendered-bitmap flip-bitmap)
(let ([key (get-bitmap-cache-key flip-bitmap)])
(calc-rendered-bitmap flip-bitmap key)
(car (hash-ref (bitmap-cache (flip-shape flip-bitmap))
(car (hash-ref (ibitmap-cache (flip-shape flip-bitmap))
key))))
(define (get-rendered-mask flip-bitmap)
(let ([key (get-bitmap-cache-key flip-bitmap)])
(calc-rendered-bitmap flip-bitmap key)
(cdr (hash-ref (bitmap-cache (flip-shape flip-bitmap))
(cdr (hash-ref (ibitmap-cache (flip-shape flip-bitmap))
key))))
(define (get-bitmap-cache-key flip-bitmap)
(let ([bm (flip-shape flip-bitmap)])
(list (flip-flipped? flip-bitmap)
(bitmap-x-scale bm)
(bitmap-y-scale bm)
(bitmap-angle bm))))
(ibitmap-x-scale bm)
(ibitmap-y-scale bm)
(ibitmap-angle bm))))
(define (calc-rendered-bitmap flip-bitmap key)
(let ([bitmap (flip-shape flip-bitmap)])
(cond
[(hash-ref (bitmap-cache bitmap) key #f) => (λ (x) x)]
[(hash-ref (ibitmap-cache bitmap) key #f) => (λ (x) x)]
[else
(let ([flipped? (flip-flipped? flip-bitmap)])
(define-values (orig-bitmap-obj orig-mask-obj) (values (bitmap-raw-bitmap bitmap)
(bitmap-raw-mask bitmap)))
(define-values (orig-bitmap-obj orig-mask-obj) (values (ibitmap-raw-bitmap bitmap)
(ibitmap-raw-mask bitmap)))
(define-values (bitmap-obj mask-obj)
(cond
[(<= (* (bitmap-x-scale bitmap)
(bitmap-y-scale bitmap))
[(<= (* (ibitmap-x-scale bitmap)
(ibitmap-y-scale bitmap))
1)
;; since we prefer to rotate big things, we rotate first
(let-values ([(bitmap-obj mask-obj) (do-rotate bitmap orig-bitmap-obj orig-mask-obj flipped?)])
@ -912,16 +912,16 @@ the mask bitmap and the original bitmap are all together in a single bytes!
(let-values ([(bitmap-obj mask-obj) (do-scale bitmap orig-bitmap-obj orig-mask-obj)])
(do-rotate bitmap bitmap-obj mask-obj flipped?))]))
(define pair (cons bitmap-obj mask-obj))
(hash-set! (bitmap-cache bitmap) key pair)
(hash-set! (ibitmap-cache bitmap) key pair)
pair)])))
(define (do-rotate bitmap bitmap-obj mask-obj flip?)
(cond
[(and (not flip?) (zero? (bitmap-angle bitmap)))
[(and (not flip?) (zero? (ibitmap-angle bitmap)))
;; don't rotate anything in this case.
(values bitmap-obj mask-obj)]
[else
(let ([θ (degrees->radians (bitmap-angle bitmap))])
(let ([θ (degrees->radians (ibitmap-angle bitmap))])
(let-values ([(bytes w h) (bitmap->bytes bitmap-obj mask-obj)])
(let-values ([(rotated-bytes rotated-w rotated-h)
(rotate-bytes bytes w h θ)])
@ -933,8 +933,8 @@ the mask bitmap and the original bitmap are all together in a single bytes!
(values bm mask)))))]))
(define (do-scale bitmap orig-bm orig-mask)
(let ([x-scale (bitmap-x-scale bitmap)]
[y-scale (bitmap-y-scale bitmap)])
(let ([x-scale (ibitmap-x-scale bitmap)]
[y-scale (ibitmap-y-scale bitmap)])
(cond
[(and (= 1 x-scale) (= 1 y-scale))
;; no need to scale in this case
@ -1081,7 +1081,7 @@ the mask bitmap and the original bitmap are all together in a single bytes!
[h (send bm get-height)])
(make-image (make-translate (/ w 2)
(/ h 2)
(make-bitmap bm mask-bm 0 1 1 (make-hash)))
(make-ibitmap bm mask-bm 0 1 1 (make-hash)))
(make-bb w h h)
#f)))
@ -1125,8 +1125,8 @@ the mask bitmap and the original bitmap are all together in a single bytes!
curve-segment-color
make-pen pen? pen-color pen-width pen-style pen-cap pen-join pen
make-bitmap bitmap? bitmap-raw-bitmap bitmap-raw-mask bitmap-angle bitmap-x-scale bitmap-y-scale
bitmap-cache
make-ibitmap ibitmap? ibitmap-raw-bitmap ibitmap-raw-mask ibitmap-angle ibitmap-x-scale ibitmap-y-scale
ibitmap-cache
make-flip flip? flip-flipped? flip-shape

13
collects/mrlib/private/regmk.rkt
View File

@ -10,14 +10,15 @@
(define-syntax (define-struct/reg-mk stx)
(syntax-case stx ()
[(_ id . rest)
[(_ id #:reflect-id reflect-id rest ...)
(let ([build-name
(λ (fmt)
(datum->syntax #'id (string->symbol (format fmt (syntax->datum #'id)))))])
(λ (fmt id)
(datum->syntax id (string->symbol (format fmt (syntax->datum id)))))])
#`(begin
(define-struct id . rest)
(add-id-constructor-pair '#,(build-name "struct:~a")
#,(build-name "make-~a"))))]))
(define-struct id rest ... #:reflection-name 'reflect-id)
(add-id-constructor-pair '#,(build-name "struct:~a" #'reflect-id)
#,(build-name "make-~a" #'id))))]
[(_ id . rest) #'(define-struct/reg-mk id #:reflect-id id . rest)]))
(define (id->constructor id)
(let ([line (assoc id id-constructor-pairs)])

7
collects/scribblings/gui/gui.scrbl
View File

@ -7,14 +7,9 @@
@declare-exporting[racket/gui/base racket/gui #:use-sources (mred)]
This reference manual describes the GUI toolbox that is part of Racket
and whose core is implemented by the GRacket executable.
@defmodule*/no-declare[(racket/gui/base)]{The
@racketmodname[racket/gui/base] library provides all of the class,
interface, and procedure bindings defined in this manual. At run time,
this library needs primitive graphics support that the GRacket executable
provides; this library cannot run inside the Racket executable.}
interface, and procedure bindings defined in this manual.}
@defmodulelang*/no-declare[(racket/gui)]{The
@racketmodname[racket/gui] language combines all bindings of the

186
doc/release-notes/racket/Draw_and_GUI_5_5.txt
View File

@ -1,96 +1,130 @@
Changes:
GRacket, Racket, Drawing, and GUIs
----------------------------------
* The drawing portion of the old GUI toolbox is now available as a
separate layer: `racket/draw'. This layer can be used from plain
Racket independent of the `racket/gui' library, although
`racket/gui' re-exports `racket/draw'.
Version 5.5 includes two major changes to the Racket drawing and GUI
API:
The `racket/draw' library is built on top of the widely used Cairo
drawing library and Pango text-rendering library.
* The drawing portion of the GUI toolbox is now available as a
separate layer: `racket/draw'. This layer can be used independent
of the `racket/gui/base' library, although `racket/gui' re-exports
`racket/draw'.
* Drawing to a bitmap may not produce the same results as drawing to
a canvas. Use the `make-screen-bitmap' function (from `racket/gui')
or the `make-bitmap' method of `canvas%' to obtain a bitmap that
uses the same drawing algorithms as a canvas.
(The `racket/draw' library is built on top of the widely used Cairo
drawing library and Pango text-rendering library.)
Drawing to a canvas always draws into a bitmap that is kept
offscreen and periodically flushed onto the screen. The new
`suspend-flush' and `resume-flush' methods of `canvas%' provide
some control over the timing of the flushes, which in many cases
avoids the need for (additional) double buffering of canvas
content.
* The GRacket executable is no longer strictly necessary for running
GUI programs; the `racket/gui/base' library can be used from
Racket.
* A color bitmap can have an alpha channel, instead of just a mask
bitmap. When drawing a bitmap, alpha channels are used more
consistently and automatically than mask bitmaps. More
significantly, drawing into a bitmap with an alpha channel
preserves the drawn alphas; for example, drawing a line in the
middle of an empty bitmap produces an image with non-zero alpha
only at the drawn line.
The GRacket executable still offers some additional GUI-specific
functiontality however. Most notably, GRacket is a GUI application
under Windows (as opposed to a console application, which is
launched slightly differently by the OS), GRacket is a bundle under
Mac OS X (so the dock icon is the Racket logo, for example), and
GRacket manages single-instance mode for Windows and X.
Create a bitmap with an alpha channel by supplying #t as the new
`alpha?' argument to the `bitmap%' constructor, or by loading an
image with a type like 'unknown/alpha insteda of 'unknown or
'unknown/mask.
The drawing and GUI libraries have also changed in further small ways.
A newly created `bitmap%' has an empty content (i.e., white with
zero alpha), insteda of unspecified content.
Images can be read into a `bitmap%' from from input ports, instead
of requiring a file path.
Bitmaps
-------
* A `dc<%>' supports additional drawing transformations: a rotation
(via `set-rotation') and a general transformation matrix (via
`set-initial-matrix'). Scaling factors can be negative, which
corresponds to flipping the direction of drawing.
Drawing to a bitmap may not produce the same results as drawing to a
canvas. Use the `make-screen-bitmap' function (from `racket/gui') or
the `make-bitmap' method of `canvas%' to obtain a bitmap that uses the
same drawing algorithms as a canvas.
A transformation matrix has the form `(vector xx xy yx yy x0 y0)',
where a point (x1, y1) is transformed to a point (x2, y2) with x2 =
xx*x1 + yx*y1 + x0 and y2 = xy*x1 + yy*y1 + y0, which is the usual
convention.
A color bitmap can have an alpha channel, instead of just a mask
bitmap. When drawing a bitmap, alpha channels are used more
consistently and automatically than mask bitmaps. More significantly,
drawing into a bitmap with an alpha channel preserves the drawn
alphas; for example, drawing a line in the middle of an empty bitmap
produces an image with non-zero alpha only at the drawn line.
New methods `translate', `scale', `rotate', and `transform'
simplify adding a further translation, scaling, rotation, or
arbitrary matrix transformation on top of the current
transformation. The new `get-translation' and `set-translation'
methods help to capture and restore transformation settings.
Only bitmaps created with the new `make-gl-bitmap' function support
OpenGL drawing.
The old translation and scaling transformations apply after the
initial matrix. The new rotation transformation applies after the
other transformations. This layering is redundant, since all
transformations can be expressed in a single matrix, but it is
backward-compatibile. Methods like `get-translation',
`set-translation', `scale', etc. help hide the reundancy.
Use the new `make-bitmap', `read-bitmap', `make-monochrome-bitmap',
`make-screen-bitmap', and `make-gl-bitmap' functions to create
bitmaps, instead of using `make-object' with `bitmap%'. The new
constructors are less overloaded and provide more modern defaults
(such as alpha channels by default).
The alpha value of a `dc<%>' (as set by `set-alpha') is used for
all drawing operations, including drawing a bitmap.
Image formats can be read into a `bitmap%' from from input ports,
instead of requiring a file path. A newly created bitmap has an empty
content (i.e., white with zero alpha), instead of unspecified content.
The `draw-bitmap' and `draw-bitmap-section' methods now smooth
bitmaps while scaling, so the `draw-bitmap-section-smooth' method
of `bitmap-dc%' simply calls `draw-bitmap-section'.
* A `region%' can be created as independent of any `dc<%>', in which
cases it uses the drawing context's current transformation at the
time that it is installed as a clipping region.
Canvases
--------
* The old 'xor mode for pens and brushes is no longer available
(since it is not supported by Cairo).
Drawing to a canvas always draws into a bitmap that is kept offscreen
and periodically flushed onto the screen. The new `suspend-flush' and
`resume-flush' methods of `canvas%' provide some control over the
timing of the flushes, which in many cases avoids the need for
(additional) double buffering of canvas content.
* The `draw-caret' argument to a `snip%' or `editor<%>' `draw' or
`refresh' method can be a pair, which indicates that the caret is
owned by an enclosing display and the selection spans the snip or
editor. In that case, the snip or editor should refrain from
drawing a background for the selected region, and it should draw
the foreground in the color specified by
`get-highlight-text-color', if any.
OpenGL drawing in a canvas requires supplying 'gl as a style when
creating the `canvas%' instance. OpenGL and normal dc<%> drawing no
longer mix reliably in a canvas.
* OpenGL drawing in a canvas requires supplying 'gl as a style when
creating the `canvas%' instance. OpenGL and normal dc<%> drawing no
longer mix reliably in a canvas.
OpenG drawing to a bitmap requires a bitmap created with
`make-gl-bitmap'.
Drawing-Context Transformations
-------------------------------
* The `write-resource, `get-reource', and `send-event' functions have
been removed from `racket/gui/base'. If there is any demand for the
removed functionality, it will be implemented in a new library.
A `dc<%>' instance supports rotation (via `set-rotation'), negative
scaling factors for flipping, and a general transformation matrix (via
`set-initial-matrix'). A transformation matrix has the form `(vector
xx xy yx yy x0 y0)', where a point (x1, y1) is transformed to a point
(x2, y2) with x2 = xx*x1 + yx*y1 + x0 and y2 = xy*x1 + yy*y1 + y0,
which is the usual convention.
New methods `translate', `scale', `rotate', and `transform' simplify
adding a further translation, scaling, rotation, or arbitrary matrix
transformation on top of the current transformation. The new
`get-translation' and `set-translation' methods help to capture and
restore transformation settings.
The old translation and scaling transformations apply after the
initial matrix. The new rotation transformation applies after the
other transformations. This layering is redundant, since all
transformations can be expressed in a single matrix, but it is
backward-compatibile. Methods like `get-translation',
`set-translation', `scale', etc. help hide the reundancy.
Others Drawing-Context Changes
------------------------------
The alpha value of a `dc<%>' (as set by `set-alpha') is used for all
drawing operations, including drawing a bitmap.
The `draw-bitmap' and `draw-bitmap-section' methods now smooth bitmaps
while scaling, so the `draw-bitmap-section-smooth' method of
`bitmap-dc%' simply calls `draw-bitmap-section'.
A `region%' can be created as independent of any `dc<%>', in which
cases it uses the drawing context's current transformation at the time
that it is installed as a clipping region.
The old 'xor mode for pens and brushes is no longer available (since
it is not supported by Cairo).
Editor Changes
--------------
The `draw-caret' argument to a `snip%' or `editor<%>' `draw' or
`refresh' method can be a pair, which indicates that the caret is
owned by an enclosing display and the selection spans the snip or
editor. In that case, the snip or editor should refrain from drawing a
background for the selected region, and it should draw the foreground
in the color specified by `get-highlight-text-color', if any.
Removed Functions
-----------------
The `write-resource, `get-reource', and `send-event' functions have
been removed from `racket/gui/base'. If there is any demand for the
removed functionality, it will be implemented in a new library.