diff --git a/collects/mred/private/wx/cocoa/canvas.rkt b/collects/mred/private/wx/cocoa/canvas.rkt index b691eb25cd..34b8853b46 100644 --- a/collects/mred/private/wx/cocoa/canvas.rkt +++ b/collects/mred/private/wx/cocoa/canvas.rkt @@ -3,6 +3,7 @@ ffi/unsafe racket/class racket/draw + racket/draw/gl-context racket/draw/color "pool.rkt" "utils.rkt" @@ -28,7 +29,8 @@ ;; ---------------------------------------- (import-class NSView NSGraphicsContext NSScroller NSComboBox NSWindow - NSImageView NSTextFieldCell) + NSImageView NSTextFieldCell + NSOpenGLView NSOpenGLPixelFormat) (import-protocol NSComboBoxDelegate) @@ -55,7 +57,7 @@ (make-NSSize 32000 32000)))) (tellv ctx restoreGraphicsState))))))) -(define-objc-class MyView NSView +(define-objc-mixin (MyViewMixin Superclass) #:mixins (FocusResponder KeyMouseTextResponder CursorDisplayer) [wxb] (-a _void (drawRect: [_NSRect r]) @@ -80,6 +82,14 @@ (let ([wx (->wx wxb)]) (when wx (send wx do-scroll 'vertical scroller)))))) +(define-objc-class MyView NSView + #:mixins (MyViewMixin) + [wxb]) + +(define-objc-class MyGLView NSOpenGLView + #:mixins (MyViewMixin) + [wxb]) + (define-objc-class FrameView NSView [] (-a _void (drawRect: [_NSRect r]) @@ -172,6 +182,39 @@ (let ([wx (->wx wxb)]) (when wx (queue-window-event wx (lambda () (send wx fix-dc)))))))) + +(define NSOpenGLPFADoubleBuffer 5) +(define NSOpenGLPFAStereo 6) +(define NSOpenGLPFAColorSize 8) +(define NSOpenGLPFAAlphaSize 11) +(define NSOpenGLPFADepthSize 12) +(define NSOpenGLPFAStencilSize 13) +(define NSOpenGLPFAAccumSize 14) +(define NSOpenGLPFAOffScreen 53) +(define NSOpenGLPFASampleBuffers 55) +(define NSOpenGLPFASamples 56) +(define NSOpenGLPFAMultisample 59) + +(define (gl-config->pixel-format conf) + (let ([conf (or conf (new gl-config%))]) + (tell (tell NSOpenGLPixelFormat alloc) + initWithAttributes: #:type (_list i _int) + (append + (if (send conf get-double-buffered) (list NSOpenGLPFADoubleBuffer) null) + (if (send conf get-stereo) (list NSOpenGLPFAStereo) null) + (list + 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 + NSOpenGLPFASamples ms))) + (list 0))))) + (define-struct scroller (cocoa [range #:mutable] [page #:mutable])) (define scroll-width (tell #:type _CGFloat NSScroller scrollerWidth)) @@ -259,6 +302,9 @@ (define/override (get-cocoa-content) content-cocoa) + (define is-gl? (and (not is-combo?) (memq 'gl style))) + (define/public (can-gl?) is-gl?) + (super-new [parent parent] [cocoa @@ -283,8 +329,12 @@ (make-NSSize (max 0 (- w (* 2 x-margin))) (max 0 (- h (* 2 y-margin)))))]) (as-objc-allocation - (tell (tell (if is-combo? MyComboBox MyView) alloc) - initWithFrame: #:type _NSRect r)))) + (if (or is-combo? (not (memq 'gl style))) + (tell (tell (if is-combo? MyComboBox MyView) alloc) + initWithFrame: #:type _NSRect r) + (tell (tell MyGLView alloc) + initWithFrame: #:type _NSRect r + pixelFormat: (gl-config->pixel-format gl-config)))))) (tell #:type _void cocoa addSubview: content-cocoa) (set-ivar! content-cocoa wxb (->wxb this)) diff --git a/collects/mred/private/wx/cocoa/dc.rkt b/collects/mred/private/wx/cocoa/dc.rkt index 2ecb3f477e..72e77eaa59 100644 --- a/collects/mred/private/wx/cocoa/dc.rkt +++ b/collects/mred/private/wx/cocoa/dc.rkt @@ -5,6 +5,7 @@ racket/draw/cairo racket/draw/bitmap racket/draw/local + racket/draw/gl-context "types.rkt" "utils.rkt" "window.rkt" @@ -17,6 +18,8 @@ quartz-bitmap% do-backing-flush) +(import-class NSOpenGLContext) + (define quartz-bitmap% (class bitmap% (init w h) @@ -46,6 +49,23 @@ (super-new) + (define gl #f) + (define/override (get-gl-context) + (and (send canvas can-gl?) + (let ([gl-ctx (tell (send canvas get-cocoa-content) openGLContext)]) + (or gl + (let ([g (new (class gl-context% + (define/override (do-call-as-current t) + (dynamic-wind + (lambda () (tellv gl-ctx makeCurrentContext)) + t + (lambda () (tellv NSOpenGLContext clearCurrentContext)))) + (define/override (do-swap-buffers) + (tellv gl-ctx flushBuffer)) + (super-new)))]) + (set! gl g) + g))))) + ;; Use a quartz bitmap so that text looks good: (define/override (make-backing-bitmap w h) (make-object quartz-bitmap% w h)) (define/override (can-combine-text? sz) #t) diff --git a/collects/mred/private/wx/cocoa/gl-context.rkt b/collects/mred/private/wx/cocoa/gl-context.rkt deleted file mode 100644 index ba5d78e00f..0000000000 --- a/collects/mred/private/wx/cocoa/gl-context.rkt +++ /dev/null @@ -1,11 +0,0 @@ -#lang scheme/base -(require scheme/class - "../../syntax.rkt") - -(provide gl-context%) - -(defclass gl-context% object% - (def/public-unimplemented call-as-current) - (def/public-unimplemented swap-buffers) - (def/public-unimplemented ok?) - (super-new)) diff --git a/collects/mred/private/wx/cocoa/platform.rkt b/collects/mred/private/wx/cocoa/platform.rkt index 60e8507e2f..b51b20f6b6 100644 --- a/collects/mred/private/wx/cocoa/platform.rkt +++ b/collects/mred/private/wx/cocoa/platform.rkt @@ -9,7 +9,6 @@ "dialog.rkt" "frame.rkt" "gauge.rkt" - "gl-context.rkt" "group-panel.rkt" "item.rkt" "list-box.rkt" diff --git a/collects/scribblings/gui/canvas-class.scrbl b/collects/scribblings/gui/canvas-class.scrbl index 992c8e9cfa..3159774afb 100644 --- a/collects/scribblings/gui/canvas-class.scrbl +++ b/collects/scribblings/gui/canvas-class.scrbl @@ -45,11 +45,14 @@ 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] --- @italic{obsolete} (every canvas is an OpenGL context where supported)} + @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['no-autoclear] --- prevents automatic erasing of the - canvas before calls to -@method[canvas% on-paint]} + canvas before calls to @method[canvas% on-paint]} + @item{@scheme['transparent] --- the canvas is automatically ``erased'' before an update using it's parent window's background; the result is undefined if this flag is combined with @scheme['no-autoclear]} diff --git a/doc/release-notes/racket/Draw_and_GUI_5_5.txt b/doc/release-notes/racket/Draw_and_GUI_5_5.txt index b56ac8d673..6c50f8a480 100644 --- a/doc/release-notes/racket/Draw_and_GUI_5_5.txt +++ b/doc/release-notes/racket/Draw_and_GUI_5_5.txt @@ -84,6 +84,9 @@ Changes to the drawing toolbox: 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. + Changes to the GUI toolbox: [Nothing to report, yet.]