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))))

60
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
;; - (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

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

@ -1,59 +1,89 @@
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
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.
The drawing and GUI libraries have also changed in further small ways.
Bitmaps
-------
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 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.
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.
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.
Only bitmaps created with the new `make-gl-bitmap' function support
OpenGL drawing.
A newly created `bitmap%' has an empty content (i.e., white with
zero alpha), insteda of unspecified content.
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).
Images can be read into a `bitmap%' from from input ports, instead
of requiring a file path.
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.
* 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.
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.
Canvases
--------
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.
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.
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.
Drawing-Context Transformations
-------------------------------
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
@ -62,35 +92,39 @@ Changes:
backward-compatibile. Methods like `get-translation',
`set-translation', `scale', etc. help hide the reundancy.
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'.
Others Drawing-Context Changes
------------------------------
* 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 alpha value of a `dc<%>' (as set by `set-alpha') is used for all
drawing operations, including drawing a bitmap.
* The old 'xor mode for pens and brushes is no longer available
(since it is not supported by Cairo).
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'.
* The `draw-caret' argument to a `snip%' or `editor<%>' `draw' or
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.
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.
OpenG drawing to a bitmap requires a bitmap created with
`make-gl-bitmap'.
Removed Functions
-----------------
* The `write-resource, `get-reource', and `send-event' functions have
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.