add make-platform-bitmap

also: use it in pict's rendering and
remove redex's platform-specific font choice
(going back to using 'modern on all platforms)

closes PR 12554

original commit: 1945ff270962679e13f66131c5b3eb91cc1edb2f
This commit is contained in:
Robby Findler 2012-02-15 21:20:02 -06:00
parent 6e8c3e072b
commit 94be0ced5e
7 changed files with 27 additions and 39 deletions

View File

@ -5,13 +5,13 @@
racket/draw
racket/draw/private/gl-context
racket/draw/private/color
racket/draw/private/bitmap
"pool.rkt"
"utils.rkt"
"const.rkt"
"types.rkt"
"window.rkt"
"dc.rkt"
"bitmap.rkt"
"cg.rkt"
"queue.rkt"
"item.rkt"

View File

@ -8,7 +8,6 @@
racket/draw/private/gl-context
"types.rkt"
"utils.rkt"
"bitmap.rkt"
"window.rkt"
"../../lock.rkt"
"../common/queue.rkt"

View File

@ -5,11 +5,11 @@
racket/draw/unsafe/cairo
racket/draw/private/local
racket/draw/unsafe/bstr
racket/draw/private/bitmap
"utils.rkt"
"types.rkt"
"const.rkt"
"cg.rkt"
"bitmap.rkt"
"../../lock.rkt"
(only-in '#%foreign ffi-callback))

View File

@ -13,7 +13,6 @@
"../../lock.rkt"
"dc.rkt"
"frame.rkt"
"bitmap.rkt"
"cg.rkt"
"utils.rkt"
"types.rkt")

View File

@ -2,6 +2,7 @@
(require "../../syntax.rkt"
racket/class
racket/draw
racket/draw/private/bitmap
ffi/unsafe
ffi/unsafe/objc
"utils.rkt"
@ -12,7 +13,6 @@
"filedialog.rkt"
"colordialog.rkt"
"dc.rkt"
"bitmap.rkt"
"printer-dc.rkt"
"menu-bar.rkt"
"agl.rkt"

View File

@ -23,46 +23,33 @@
(define-gdi32 SelectClipRgn (_wfun _pointer _pointer -> _int))
(define win32-bitmap%
(class bitmap%
(init w h hwnd [gl-config #f])
(super-make-object (make-alternate-bitmap-kind w h))
(define hwnd-param (make-parameter #f))
(define s
(let ([s
(if (not hwnd)
(cairo_win32_surface_create_with_dib CAIRO_FORMAT_RGB24 w h)
(define win32-bitmap%
(class win32-no-hwnd-bitmap%
(init w h hwnd [gl-config #f])
(inherit get-cairo-surface)
(parameterize ([hwnd-param hwnd])
(super-new [w w] [h h]))
(define/override (build-cairo-surface w h)
(define hwnd (hwnd-param))
(if hwnd
(atomically
(let ([hdc (GetDC hwnd)])
(begin0
(cairo_win32_surface_create_with_ddb hdc
CAIRO_FORMAT_RGB24 w h)
(ReleaseDC hwnd hdc)))))])
;; initialize bitmap to white:
(let ([cr (cairo_create s)])
(cairo_set_source_rgba cr 1.0 1.0 1.0 1.0)
(cairo_paint cr)
(cairo_destroy cr))
s))
(ReleaseDC hwnd hdc))))
(super build-cairo-surface)))
(define gl (and gl-config
(let ([hdc (cairo_win32_surface_get_dc s)])
(let ([hdc (cairo_win32_surface_get_dc (get-cairo-surface))])
(set-cpointer-tag! hdc 'HDC)
(create-gl-context hdc
gl-config
#t))))
(define/override (get-bitmap-gl-context) gl)
(define/override (ok?) #t)
(define/override (is-color?) #t)
(define/override (has-alpha-channel?) #f)
(define/override (get-cairo-surface) s)
(define/override (release-bitmap-storage)
(atomically
(cairo_surface_destroy s)
(set! s #f)))))
(define/override (get-bitmap-gl-context) gl)))
(define dc%
(class backing-dc%

View File

@ -253,7 +253,10 @@ Creates a bitmap that draws in a way that is the same as drawing to a
canvas in its default configuration.
A normal @racket[bitmap%] draws in a more platform-independent way and
may use fewer constrained resources, particularly on Windows.}
may use fewer constrained resources, particularly on Windows.
See also @racket[make-platform-bitmap].
}
@defproc[(play-sound [filename path-string?]