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

`make-gl-bitmap' for cocoa and maybe gtk

Browse Source 
original commit: 0a47a81aba1c9e2f88984357b0d665700a360ee1
This commit is contained in:
Matthew Flatt 2010-10-13 20:49:27 -06:00
parent 8b11d03f69
commit c0429ba8db
15 changed files with 109 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -123,6 +123,7 @@ make-eventspace
make-gui-empty-namespace
make-gui-namespace
make-screen-bitmap
make-gl-bitmap
map-command-as-meta-key
menu%
menu-bar%

3
collects/mred/mred.rkt
View File

@ -191,7 +191,8 @@
the-brush-list
the-style-list
the-editor-wordbreak-map
make-screen-bitmap)
make-screen-bitmap
make-gl-bitmap)
(define the-clipboard (wx:get-the-clipboard))
(define the-x-selection-clipboard (wx:get-the-x-selection))

3
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -206,12 +206,11 @@
NSOpenGLPFADepthSize (send conf get-depth-size)
NSOpenGLPFAStencilSize (send conf get-stencil-size)
NSOpenGLPFAAccumSize (send conf get-accum-size))
#;
(let ([ms (send conf get-multisample-size)])
(if (zero? ms)
null
(list NSOpenGLPFAMultisample
NSOpenGLPFASampleBuffers
NSOpenGLPFASampleBuffers 1
NSOpenGLPFASamples ms)))
(list 0)))))

1
collects/mred/private/wx/cocoa/platform.rkt
View File

@ -85,4 +85,5 @@
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break))

7
collects/mred/private/wx/cocoa/procs.rkt
View File

@ -12,6 +12,7 @@
"filedialog.rkt"
"dc.rkt"
"menu-bar.rkt"
"agl.rkt"
"../../lock.rkt"
"../common/handlers.rkt")
@ -52,6 +53,7 @@
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break)
(import-class NSScreen NSCursor)
@ -113,6 +115,11 @@
[exact-positive-integer? h])
(make-object quartz-bitmap% w h))
(define/top (make-gl-bitmap [exact-positive-integer? w]
[exact-positive-integer? h]
[gl-config% c])
(create-gl-bitmap w h c))
;; ------------------------------------------------------------
;; Text & highlight color

8
collects/mred/private/wx/gtk/dc.rkt
View File

@ -37,6 +37,14 @@
w
h))
;; `get-gdk-pixmap' and `install-gl-context' are
;; localized in "gl-context.rkt"
(define/public (get-gdk-pixmap) pixmap)
(define/public (install-gl-context new-gl) (set! gl new-gl))
(define gl #f)
(define/override (get-bitmap-gl-context) gl)
(define/override (ok?) #t)
(define/override (is-color?) #t)
(define/override (has-alpha-channel?) #f)

50
collects/mred/private/wx/gtk/gl-context.rkt
View File

@ -2,13 +2,18 @@
(require racket/class
ffi/unsafe
ffi/unsafe/define
ffi/unsafe/alloc
(prefix-in draw: racket/draw/gl-context)
racket/draw/gl-config
"types.rkt"
"utils.rkt")
(provide prepare-widget-gl-context
create-widget-gl-context)
create-widget-gl-context
create-and-install-gl-context
get-gdk-pixmap
install-gl-context)
(define gdkglext-lib
(ffi-lib "libgdkglext-x11-1.0" '("0")))
@ -23,6 +28,8 @@
(define _GdkGLContext (_cpointer/null 'GdkGLContext))
(define _GdkGLDrawable (_cpointer 'GdkGLDrawable))
(define _GdkGLConfig (_cpointer 'GdkGLConfig))
(define _GdkGLPixmap _GdkGLDrawable)
(define _GdkPixmap _pointer)
(define-gdkglext gdk_gl_init (_fun (_ptr i _int)
(_ptr i _pointer)
@ -45,12 +52,26 @@
(define-gtkglext gtk_widget_get_gl_context (_fun _GtkWidget -> _GdkGLContext))
(define-gtkglext gtk_widget_get_gl_window (_fun _GtkWidget -> _GdkGLDrawable))
(define-gdkglext gdk_gl_context_destroy (_fun _GdkGLContext -> _void)
#:wrap (deallocator))
(define-gdkglext gdk_gl_context_new (_fun _GdkGLDrawable _GdkGLContext _gboolean _int
-> _GdkGLContext)
#:wrap (allocator gdk_gl_context_destroy))
(define-gdkglext gdk_gl_drawable_gl_begin (_fun _GdkGLDrawable
_GdkGLContext
-> _gboolean))
(define-gdkglext gdk_gl_drawable_gl_end (_fun _GdkGLDrawable -> _void))
(define-gdkglext gdk_gl_drawable_swap_buffers (_fun _GdkGLDrawable -> _void))
(define-gdkglext gdk_gl_pixmap_destroy (_fun _GdkGLPixmap -> _void)
#:wrap (deallocator))
(define-gdkglext gdk_gl_pixmap_new (_fun _GdkGLConfig _GdkPixmap _pointer -> _GdkGLPixmap)
#:wrap (allocator gdk_gl_pixmap_destroy))
(define GDK_GL_RGBA_TYPE 0)
(define GDK_GL_USE_GL 1)
(define GDK_GL_BUFFER_SIZE 2)
(define GDK_GL_LEVEL 3)
@ -74,10 +95,12 @@
;; ----------------------------------------
(define (config->GdkGLConfig d conf)
(define (config->GdkGLConfig d conf can-double?)
(gdk_gl_config_new (append
(list GDK_GL_RGBA)
(if (send conf get-double-buffered) (list GDK_GL_DOUBLEBUFFER) null)
(if can-double?
(if (send conf get-double-buffered) (list GDK_GL_DOUBLEBUFFER) null)
null)
(if (send conf get-stereo) (list GDK_GL_STEREO) null)
(list
GDK_GL_DEPTH_SIZE (send conf get-depth-size)
@ -122,7 +145,8 @@
(init!)
(let ([config (config->GdkGLConfig #f ; (gtk_widget_get_screen gtk)
(or config
(new gl-config%)))])
(new gl-config%))
#t)])
(when config
(gtk_widget_set_gl_capability gtk
config
@ -138,3 +162,21 @@
[gl gl]
[drawable (gtk_widget_get_gl_window gtk)]))))
(define-local-member-name
get-gdk-pixmap
install-gl-context)
(define (create-and-install-gl-context bm config)
(init!)
(let ([config (config->GdkGLConfig #f config #f)])
(when config
(let ([gdkpx (send bm get-gdk-pixmap)])
(let ([glpx (gdk_gl_pixmap_new config gdkpx #f)])
(and glpx
(let ([gl (gdk_gl_context_new glpx #f #t GDK_GL_RGBA_TYPE)])
(and gl
(new gl-context%
[gl gl]
[drawable glpx])))))))))

1
collects/mred/private/wx/gtk/platform.rkt
View File

@ -85,4 +85,5 @@
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break))

9
collects/mred/private/wx/gtk/procs.rkt
View File

@ -11,6 +11,7 @@
"widget.rkt"
"window.rkt"
"dc.rkt"
"gl-context.rkt"
"../common/handlers.rkt")
(provide
@ -50,6 +51,7 @@
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break)
(define-unimplemented special-control-key)
@ -118,4 +120,11 @@
(make-object x11-bitmap% w h #f)
(make-object bitmap% w h #f #t)))
(define/top (make-gl-bitmap [exact-positive-integer? w]
[exact-positive-integer? h]
[gl-config% c])
(let ([bm (make-object x11-bitmap% w h #f)])
(create-and-install-gl-context bm c)
bm))
(define (check-for-break) #f)

1
collects/mred/private/wx/platform.rkt
View File

@ -70,5 +70,6 @@
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break)
((dynamic-require platform-lib 'platform-values)))

1
collects/mred/private/wx/win32/platform.rkt
View File

@ -86,4 +86,5 @@
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break))

6
collects/mred/private/wx/win32/procs.rkt
View File

@ -48,6 +48,7 @@
get-highlight-background-color
get-highlight-text-color
make-screen-bitmap
make-gl-bitmap
check-for-break)
(define-unimplemented special-control-key)
@ -102,4 +103,9 @@
[exact-positive-integer? h])
(make-object win32-bitmap% w h #f))
(define/top (make-gl-bitmap [exact-positive-integer? w]
[exact-positive-integer? h]
[gl-config% c])
(make-object win32-bitmap% w h #f))
(define (check-for-break) #f)

9
collects/scribblings/gui/canvas-class.scrbl
View File

@ -45,10 +45,11 @@ The @scheme[style] argument indicates one or more of the following styles:
@item{@scheme['resize-corner] --- leaves room for a resize control at the canvas's
bottom right when only one scrollbar is visible}
@item{@scheme['gl] --- enables OpenGL drawing to the canvas, and usually
combined with @racket['no-autoclear]; call the @method[dc<%>
get-gl-context] method of the canvas's drawing context as
produced by @method[canvas<%> get-dc]}
@item{@scheme['gl] --- creates a canvas for OpenGL drawing instead of
normal @racket[dc<%>] drawing; call the @method[dc<%>
get-gl-context] method on the result of @method[canvas<%>
get-dc]; this style is usually combined with
@racket['no-autoclear]}
@item{@scheme['no-autoclear] --- prevents automatic erasing of the
canvas before calls to @method[canvas% on-paint]}

14
collects/scribblings/gui/miscwin-funcs.scrbl
View File

@ -276,6 +276,20 @@ Strips shortcut ampersands from @racket[label], removes parenthesized
}
@defproc[(make-gl-bitmap [width exact-positive-integer?]
[height exact-positive-integer?]
[config (is-a?/c gl-config%)])
(is-a/c? bitmap%)]{
Creates a bitmap that supports both normal @racket[dc<%>] drawing an
OpenGL drawing through a context returned by @xmethod[dc<%> get-gl-context].
For @racket[dc<%>] drawing, an OpenGL-supporting bitmap draws like a
bitmap frmo @racket[make-screen-bitmap] on some platforms, while it
draws like a bitmap instantiated directly from @racket[bitmap%] on
other platforms.}
@defproc[(make-gui-empty-namespace) namespace?]{
Like @racket[make-base-empty-namespace], but with

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

@ -1,4 +1,4 @@
Changes to the drawing toolbox:
Changes:
* The drawing portion of the old GUI toolbox is now available as a
separate layer: `racket/draw'. This layer can be used from plain
@ -15,7 +15,7 @@ Changes to the drawing toolbox:
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-fluah' methods of `canvas%' provide
`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.
@ -85,8 +85,9 @@ Changes to the drawing toolbox:
`get-highlight-text-color', if any.
* OpenGL drawing in a canvas requires supplying 'gl as a style when
creating the `canvas%' instance.
creating the `canvas%' instance. OpenGL and normal dc<%> drawing no
longer mix reliably in a canvas.
Changes to the GUI toolbox:
OpenG drawing to a bitmap requires a bitmap created with
`make-gl-bitmap'.
[Nothing to report, yet.]